[Bps-public-commit] r12210 - in Prophet/trunk: .

sartak at bestpractical.com sartak at bestpractical.com
Fri May 9 22:36:54 EDT 2008


Author: sartak
Date: Fri May  9 22:36:53 2008
New Revision: 12210

Modified:
   Prophet/trunk/   (props changed)
   Prophet/trunk/lib/Prophet/Test.pm

Log:
 r55514 at onn:  sartak | 2008-05-09 22:36:38 -0400
 Adjust $Test::Builder::Level so test failures are reported from the right spot


Modified: Prophet/trunk/lib/Prophet/Test.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Test.pm	(original)
+++ Prophet/trunk/lib/Prophet/Test.pm	Fri May  9 22:36:53 2008
@@ -44,6 +44,7 @@
 
 sub in_gladiator (&) {
     my $code = shift;
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
     my $types;
     require "Devel::Gladiator"
@@ -95,7 +96,10 @@
     my $args   = shift if ( ref $_[0] eq 'ARRAY' );
     my $msg    = shift if (@_);
 
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     lives_and {
+        local $Test::Builder::Level = $Test::Builder::Level + 1;
         my ( $ret, $stdout, $stderr ) = ( run_script( $script, $args ), $msg );
 
         #diag("STDOUT: " . $stdout) if ($stdout);
@@ -149,6 +153,9 @@
 
 sub is_script_output {
     my ( $script, $arg, $exp_stdout, $exp_stderr, $msg ) = @_;
+
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my $stdout_err = [];
     $exp_stderr ||= [];
     my @cmd = _get_perl_cmd($script);
@@ -157,7 +164,7 @@
         _mk_cmp_closure( $exp_stderr, $stdout_err );                                       # stderr
 
     my $test_name = join( ' ', $msg ? "$msg:" : '', $script, @$arg );
-    ok(!@$stdout_err, $test_name);
+    is(scalar(@$stdout_err), 0, $test_name);
     if (@$stdout_err) {
         diag( "Different in line: " . join( ',', @$stdout_err ) );
     }
@@ -165,7 +172,9 @@
 
 sub run_output_matches {
     my ( $script, $args, $expected, $stderr, $msg ) = @_;
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
     lives_and {
+        local $Test::Builder::Level = $Test::Builder::Level + 3;
         is_script_output($script, $args, $expected, $stderr, $msg);
     };
 }
@@ -276,6 +285,7 @@
 
 sub ok_added_revisions (&$$) {
     my ( $code, $num, $msg ) = @_;
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
     my $last_rev = replica_last_rev();
     $code->();
     is( replica_last_rev(), $last_rev + $num, $msg );



More information about the Bps-public-commit mailing list