[tapx-dev] [commit][213] make test is now clean on 5.0.5.

andy at hexten.net andy at hexten.net
Thu Aug 9 19:26:18 BST 2007


Revision: 213
Author:   andy
Date:     2007-08-09 19:26:18 +0100 (Thu, 09 Aug 2007)

Log Message:
-----------
make test is now clean on 5.0.5.

Modified Paths:
--------------
    trunk/Changes
    trunk/lib/TAP/Parser/Iterator/Process.pm
    trunk/t/120-harness.t
    trunk/t/130-source.t
    trunk/t/140-results.t
    trunk/t/150-yamlish.t
    trunk/t/160-yamlish-writer.t
    trunk/t/170-yamlish-output.t
    trunk/t/compat/test-harness-compat.t
    trunk/t/sample-tests/out_err_mix

Modified: trunk/Changes
===================================================================
--- trunk/Changes	2007-08-08 23:47:52 UTC (rev 212)
+++ trunk/Changes	2007-08-09 18:26:18 UTC (rev 213)
@@ -12,6 +12,7 @@
       T::P.
     - Merged Leif Eriksen's coverage enhancing changes to 
       t/080-aggregator.t, t/030-grammar.t
+    - Made various changes so that we test cleanly on 5.0.5.
 
 0.52  14 July 2007
     - Incorporate Schwern's investigations into TAP versions.

Modified: trunk/lib/TAP/Parser/Iterator/Process.pm
===================================================================
--- trunk/lib/TAP/Parser/Iterator/Process.pm	2007-08-08 23:47:52 UTC (rev 212)
+++ trunk/lib/TAP/Parser/Iterator/Process.pm	2007-08-09 18:26:18 UTC (rev 213)
@@ -91,20 +91,22 @@
 
     if ($IS_WIN32) {
         eval {
-            $pid
-              = open3( undef, $out, $merge ? undef : '>&STDERR', @command );
+            $pid = open3(
+                \*STDIN, $out,
+                $merge ? '' : '>&STDERR', @command
+            );
         };
         die "Could not execute (@command): $@" if $@;
         if ( $] >= 5.006 ) {
+
             # Kludge to avoid warning under 5.0.5
             my @a = ( $out, ':crlf' );
             binmode @a;
         }
     }
     else {
-        $err = $merge ? undef : IO::Handle->new;
-        my $wtr = IO::Handle->new;
-        eval { $pid = open3( $wtr, $out, $err, @command ); };
+        $err = $merge ? '' : IO::Handle->new;
+        eval { $pid = open3( \*STDIN, $out, $err, @command ); };
         die "Could not execute (@command): $@" if $@;
         $sel = $merge ? undef : IO::Select->new( $out, $err );
     }

Modified: trunk/t/120-harness.t
===================================================================
--- trunk/t/120-harness.t	2007-08-08 23:47:52 UTC (rev 212)
+++ trunk/t/120-harness.t	2007-08-09 18:26:18 UTC (rev 213)
@@ -19,8 +19,9 @@
       '... and loading it on windows should succeed';
     isa_ok $harness, 'TAP::Harness', '... but the object it returns';
 
-    ok grep( {qr/^Color test output disabled on Windows/} @warnings ),
-      'Using TAP::Harness::Color on Windows should disable colored output';
+    ok( grep( qr/^Color test output disabled on Windows/, @warnings ),
+        'Using TAP::Harness::Color on Windows should disable colored output'
+    );
 
 }
 
@@ -76,7 +77,7 @@
         while ( my ( $property, $test ) = each %$test_args ) {
             my $value = $test->{out};
             can_ok $harness, $property;
-            is_deeply scalar $harness->$property, $value, $test->{test_name};
+            is_deeply scalar $harness->$property(), $value, $test->{test_name};
         }
     }
     foreach my $method_data ( harness_methods() ) {
@@ -301,31 +302,31 @@
 SKIP: {
 
     my $cat = '/bin/cat';
-    unless(-e $cat) {
+    unless ( -e $cat ) {
         skip "no '$cat'", 1;
     }
 
-    my $output = '';
+    my $output  = '';
     my $harness = TAP::Harness->new(
-        {   verbose => 1,
+        {   verbose      => 1,
             really_quiet => 1,
             really_quiet => 1,
             stdout       => \$output,
-            exec    => [$cat],
+            exec         => [$cat],
         }
     );
 
-    eval { $harness->runtests( 't/data/catme.1' ) };
+    eval { $harness->runtests('t/data/catme.1') };
 
-    my @output = split(/\n/, $output);
-    pop @output;                              # get rid of summary line
+    my @output = split( /\n/, $output );
+    pop @output;    # get rid of summary line
     my $answer = pop @output;
     is( $answer, 'All tests successful.', 'cat meows' );
 }
 
 # catches "exec accumulates arguments" issue (r77)
 {
-    my $output = '';
+    my $output  = '';
     my $harness = TAP::Harness->new(
         {   verbose      => 1,
             really_quiet => 1,
@@ -339,7 +340,7 @@
         't/source_tests/harness',
     );
 
-    my @output = split(/\n/, $output);
+    my @output = split( /\n/, $output );
     pop @output;                              # get rid of summary line
     is( $output[-1], 'All tests successful.', 'No exec accumulation' );
 }

Modified: trunk/t/130-source.t
===================================================================
--- trunk/t/130-source.t	2007-08-08 23:47:52 UTC (rev 212)
+++ trunk/t/130-source.t	2007-08-09 18:26:18 UTC (rev 213)
@@ -14,8 +14,7 @@
 my $perl = $^X;
 
 can_ok 'TAP::Parser::Source', 'new';
-ok my $source = TAP::Parser::Source->new,
-  '... and calling it should succeed';
+ok my $source = TAP::Parser::Source->new, '... and calling it should succeed';
 isa_ok $source, 'TAP::Parser::Source', '... and the object it returns';
 
 can_ok $source, 'source';
@@ -29,7 +28,8 @@
 can_ok $source, 'get_stream';
 ok my $stream = $source->get_stream, '... and calling it should succeed';
 
-isa_ok $stream, 'TAP::Parser::Iterator::Process', '... and the object it returns';
+isa_ok $stream, 'TAP::Parser::Iterator::Process',
+  '... and the object it returns';
 can_ok $stream, 'next';
 is $stream->next, '1..1', '... and the first line should be correct';
 is $stream->next, 'ok 1', '... as should the second';
@@ -47,7 +47,8 @@
 can_ok $source, 'get_stream';
 ok $stream = $source->get_stream, '... and calling it should succeed';
 
-isa_ok $stream, 'TAP::Parser::Iterator::Process', '... and the object it returns';
+isa_ok $stream, 'TAP::Parser::Iterator::Process',
+  '... and the object it returns';
 can_ok $stream, 'next';
 is $stream->next, '1..1', '... and the first line should be correct';
 is $stream->next, 'ok 1', '... as should the second';
@@ -56,5 +57,5 @@
 # internals tests!
 
 can_ok $source, '_switches';
-ok grep( { $_ eq '-T' } $source->_switches ),
-  '... and it should find the taint switch';
+ok( grep( $_ eq '-T', $source->_switches ),
+    '... and it should find the taint switch' );

Modified: trunk/t/140-results.t
===================================================================
--- trunk/t/140-results.t	2007-08-08 23:47:52 UTC (rev 212)
+++ trunk/t/140-results.t	2007-08-09 18:26:18 UTC (rev 213)
@@ -256,15 +256,15 @@
     while ( my ( $method, $default ) = each %inherited_methods ) {
         can_ok $result, $method;
         if ( defined( my $value = delete $value_for->{$method} ) ) {
-            is $result->$method, $value, "... and $method should be correct";
+            is $result->$method(), $value, "... and $method should be correct";
         }
         else {
-            is $result->$method, $default,
+            is $result->$method(), $default,
               "... and $method default should be correct";
         }
     }
     while ( my ( $method, $value ) = each %$value_for ) {
         can_ok $result, $method;
-        is $result->$method, $value, "... and $method should be correct";
+        is $result->$method(), $value, "... and $method should be correct";
     }
 }

Modified: trunk/t/150-yamlish.t
===================================================================
--- trunk/t/150-yamlish.t	2007-08-08 23:47:52 UTC (rev 212)
+++ trunk/t/150-yamlish.t	2007-08-09 18:26:18 UTC (rev 213)
@@ -1,5 +1,4 @@
 use strict;
-use warnings;
 use Test::More;
 use Data::Dumper;
 

Modified: trunk/t/160-yamlish-writer.t
===================================================================
--- trunk/t/160-yamlish-writer.t	2007-08-08 23:47:52 UTC (rev 212)
+++ trunk/t/160-yamlish-writer.t	2007-08-09 18:26:18 UTC (rev 213)
@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
 use strict;
-use warnings;
 use Test::More;
 use Data::Dumper;
 use TAP::Parser::YAMLish::Reader;

Modified: trunk/t/170-yamlish-output.t
===================================================================
--- trunk/t/170-yamlish-output.t	2007-08-08 23:47:52 UTC (rev 212)
+++ trunk/t/170-yamlish-output.t	2007-08-09 18:26:18 UTC (rev 213)
@@ -1,5 +1,4 @@
 use strict;
-use warnings;
 use Test::More tests => 9;
 use Data::Dumper;
 

Modified: trunk/t/compat/test-harness-compat.t
===================================================================
--- trunk/t/compat/test-harness-compat.t	2007-08-08 23:47:52 UTC (rev 212)
+++ trunk/t/compat/test-harness-compat.t	2007-08-09 18:26:18 UTC (rev 213)
@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
 use strict;
-use warnings;
 use Test::More;
 use TAP::Harness;
 use TAP::Harness::Compatible qw(execute_tests);
@@ -769,16 +768,14 @@
         if ( exists $want->{name} ) {
             $want->{name} = local_name( $want->{name} );
         }
-        $new->{ local_name( $file ) } = $want;
+        $new->{ local_name($file) } = $want;
     }
     return $new;
 }
 
 {
+    local $^W = 0;
 
-    # Suppress subroutine redefined warning
-    no warnings 'redefine';
-
     # Silence harness output
     *TAP::Harness::output = sub {
 
@@ -800,7 +797,8 @@
         # results. Should probably capture and analyse it.
         local *OLDERR;
         open OLDERR, '>&STDERR' or die $!;
-        open STDERR, '>', File::Spec->devnull or die $!;
+        my $devnull = File::Spec->devnull;
+        open STDERR, ">$devnull" or die $!;
 
         my ( $tot, $fail, $todo, $harness, $aggregate )
           = execute_tests( tests => \@test_files );
@@ -815,7 +813,8 @@
         my $ltodo   = local_result( $result->{todo} );
 
         is_deeply_dump $tot, $result->{totals}, "totals match for $test_key";
-        is_deeply_dump $fail, $lfailed, "failure summary matches for $test_key";
-        is_deeply_dump $todo, $ltodo,   "todo summary matches for $test_key";
+        is_deeply_dump $fail, $lfailed,
+          "failure summary matches for $test_key";
+        is_deeply_dump $todo, $ltodo, "todo summary matches for $test_key";
     }
 }

Modified: trunk/t/sample-tests/out_err_mix
===================================================================
--- trunk/t/sample-tests/out_err_mix	2007-08-08 23:47:52 UTC (rev 212)
+++ trunk/t/sample-tests/out_err_mix	2007-08-09 18:26:18 UTC (rev 213)
@@ -1,5 +1,4 @@
 use strict;
-use warnings;
 
 sub _autoflush {
     my $flushed = shift;




More information about the tapx-dev mailing list