[tapx-dev] [commit][218] Run tests again against the version of TAP:: Parser being tested.

andy at hexten.net andy at hexten.net
Fri Aug 10 13:59:48 BST 2007


Revision: 218
Author:   andy
Date:     2007-08-10 13:59:48 +0100 (Fri, 10 Aug 2007)

Log Message:
-----------
Run tests again against the version of TAP::Parser being tested.

Modified Paths:
--------------
    trunk/smoke/smoke.pl

Modified: trunk/smoke/smoke.pl
===================================================================
--- trunk/smoke/smoke.pl	2007-08-10 02:50:43 UTC (rev 217)
+++ trunk/smoke/smoke.pl	2007-08-10 12:59:48 UTC (rev 218)
@@ -30,9 +30,11 @@
         svn    => 'http://svn.hexten.net/tapx/trunk',
         subdir => 'trunk',
         script => [
-            'yes | %PERL% Makefile.PL',
+            'yes n | %PERL% Makefile.PL',
             'make',
             [ 'make test', \&check_test ],
+            # Dogfood
+            [ '%PERL% -Ilib bin/runtests t/*.t t/compat/*.t', \&check_test ],
         ],
         mailto => 'tapx-dev at hexten.net',
     }
@@ -142,11 +144,10 @@
 
     my $bind = { PERL => $interp };
 
+    # Doesn't work in 5.0.5
     local $ENV{PERL_MM_USE_DEFAULT} = 1;
 
-    my $failed = 0;
-
-    run_commands(
+    my $ok = run_commands(
         $repo->{script},
         $bind,
         sub {
@@ -155,12 +156,13 @@
             unless ( $type eq 'passed' ) {
                 push @out, @{ $results->{output} };
                 push @out, "Exit status: $results->{status}", '';
-                $failed++;
+                return 0;
             }
+            return 1;
         }
     );
 
-    if ($failed) {
+    unless ($ok) {
         push @out, '' if $out[-1];
         for my $cmd ( 'uname -a', '%PERL% -V' ) {
             my $cooked = expand( $cmd, $bind );
@@ -177,22 +179,24 @@
 sub run_commands {
     my ( $commands, $bind, $feedback ) = @_;
     for my $step (@$commands) {
+
         my ( $cmd, $check )
           = 'ARRAY' eq ref $step
           ? @$step
           : ( $step, sub {1} );
+
         my $cooked = expand( $cmd, $bind );
         my $results = capture_command($cooked);
-        if ( !$check->($results) ) {
-            $feedback->( 'failed', $cooked, $results );
-        }
-        elsif ( $results->{status} ) {
-            $feedback->( 'died', $cooked, $results );
-        }
-        else {
-            $feedback->( 'passed', $cooked, $results );
-        }
+
+        my $status
+          = $check->{$results}
+          ? ( $results->{status} ? 'died' : 'passed' )
+          : 'failed';
+
+        return unless $feedback->( $status, $cooked, $results );
     }
+
+    return 1;
 }
 
 sub capture_command {
@@ -227,13 +231,13 @@
         }
     }
 
-    my $Status = undef;
+    my $status = undef;
     if ( $pid == waitpid( $pid, 0 ) ) {
-        $Status = $?;
+        $status = $?;
     }
 
     return {
-        status => $Status,
+        status => $status,
         output => \@lines,
     };
 }




More information about the tapx-dev mailing list