Fix remaining skips for Test::Harness
Andy Armstrong [Thu, 20 Dec 2007 23:16:01 +0000 (23:16 +0000)]
Message-Id: <01A7A7EC-1C9C-40B1-90E8-DC1E5BA54400@hexten.net>

(except for test-harness-compat.t which failed unthreaded under harness
and except for reverting the defined $ENV{PERL_UNICODE})

p4raw-id: //depot/perl@32685

lib/Test/Harness/t/harness.t
lib/Test/Harness/t/nofork.t
lib/Test/Harness/t/prove.t
lib/Test/Harness/t/proverc.t
lib/Test/Harness/t/proverun.t
lib/Test/Harness/t/source.t
lib/Test/Harness/t/spool.t
lib/Test/Harness/t/taint.t
lib/Test/Harness/t/unicode.t
t/lib/source_tests/source

index a073bd6..484f210 100644 (file)
@@ -1,20 +1,12 @@
 #!/usr/bin/perl -w
 
 BEGIN {
-    if( $ENV{PERL_CORE} ) {
+    if ( $ENV{PERL_CORE} ) {
         chdir 't';
-        @INC = ('../lib', 'lib');
+        @INC = ( '../lib', 'lib' );
     }
     else {
-       use lib 't/lib';
-    }
-}
-
-BEGIN {
-    if ($ENV{PERL_CORE}) {
-       # FIXME
-       print "1..0 # Skip pending resolution of a clean way to record the change in location of the sample tests\n";
-       exit 0;
+        unshift @INC, 't/lib';
     }
 }
 
@@ -27,6 +19,9 @@ use TAP::Harness;
 
 my $HARNESS = 'TAP::Harness';
 
+my $source_tests = $ENV{PERL_CORE} ? 'lib/source_tests' : 't/source_tests';
+my $sample_tests = $ENV{PERL_CORE} ? 'lib/sample-tests' : 't/sample-tests';
+
 plan tests => 106;
 
 # note that this test will always pass when run through 'prove'
@@ -108,7 +103,7 @@ foreach my $test_args ( get_arg_sets() ) {
 
     # normal tests in verbose mode
 
-    ok my $aggregate = _runtests( $harness, 't/source_tests/harness' ),
+    ok my $aggregate = _runtests( $harness, "$source_tests/harness" ),
       '... runtests returns the aggregate';
 
     isa_ok $aggregate, 'TAP::Parser::Aggregator';
@@ -116,7 +111,7 @@ foreach my $test_args ( get_arg_sets() ) {
     chomp(@output);
 
     my @expected = (
-        't/source_tests/harness....',
+        "$source_tests/harness....",
         '1..1',
         '[[reset]]',
         'ok 1 - this is a test',
@@ -139,7 +134,7 @@ foreach my $test_args ( get_arg_sets() ) {
 
     @output = ();
     ok $aggregate
-      = _runtests( $harness, [ 't/source_tests/harness', 'My Nice Test' ] ),
+      = _runtests( $harness, [ "$source_tests/harness", 'My Nice Test' ] ),
       '... runtests returns the aggregate';
 
     isa_ok $aggregate, 'TAP::Parser::Aggregator';
@@ -169,9 +164,10 @@ foreach my $test_args ( get_arg_sets() ) {
     # run same test twice
 
     @output = ();
-    ok $aggregate
-      = _runtests( $harness, [ 't/source_tests/harness', 'My Nice Test' ],
-        [ 't/source_tests/harness', 'My Nice Test Again' ] ),
+    ok $aggregate = _runtests(
+        $harness, [ "$source_tests/harness", 'My Nice Test' ],
+        [ "$source_tests/harness", 'My Nice Test Again' ]
+      ),
       '... runtests returns the aggregate';
 
     isa_ok $aggregate, 'TAP::Parser::Aggregator';
@@ -207,11 +203,11 @@ foreach my $test_args ( get_arg_sets() ) {
     # normal tests in quiet mode
 
     @output = ();
-    _runtests( $harness_whisper, 't/source_tests/harness' );
+    _runtests( $harness_whisper, "$source_tests/harness" );
 
     chomp(@output);
     @expected = (
-        't/source_tests/harness....',
+        "$source_tests/harness....",
         'ok',
         'All tests successful.',
     );
@@ -230,7 +226,7 @@ foreach my $test_args ( get_arg_sets() ) {
     # normal tests in really_quiet mode
 
     @output = ();
-    _runtests( $harness_mute, 't/source_tests/harness' );
+    _runtests( $harness_mute, "$source_tests/harness" );
 
     chomp(@output);
     @expected = (
@@ -251,7 +247,7 @@ foreach my $test_args ( get_arg_sets() ) {
     # normal tests with failures
 
     @output = ();
-    _runtests( $harness, 't/source_tests/harness_failure' );
+    _runtests( $harness, "$source_tests/harness_failure" );
 
     $status  = pop @output;
     $summary = pop @output;
@@ -263,7 +259,7 @@ foreach my $test_args ( get_arg_sets() ) {
     @output = @output[ 0 .. 9 ];
 
     @expected = (
-        't/source_tests/harness_failure....',
+        "$source_tests/harness_failure....",
         '1..2',
         '[[reset]]',
         'ok 1 - this is a test',
@@ -283,7 +279,7 @@ foreach my $test_args ( get_arg_sets() ) {
         'Test Summary Report',
         '-------------------',
         '[[red]]',
-        't/source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)',
+        "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)",
         '[[reset]]',
         '[[red]]',
         'Failed test:',
@@ -299,16 +295,16 @@ foreach my $test_args ( get_arg_sets() ) {
     # quiet tests with failures
 
     @output = ();
-    _runtests( $harness_whisper, 't/source_tests/harness_failure' );
+    _runtests( $harness_whisper, "$source_tests/harness_failure" );
 
     $status   = pop @output;
     $summary  = pop @output;
     @expected = (
-        't/source_tests/harness_failure....',
+        "$source_tests/harness_failure....",
         'Failed 1/2 subtests',
         'Test Summary Report',
         '-------------------',
-        't/source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)',
+        "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)",
         'Failed test:',
         '2',
     );
@@ -322,14 +318,14 @@ foreach my $test_args ( get_arg_sets() ) {
     # really quiet tests with failures
 
     @output = ();
-    _runtests( $harness_mute, 't/source_tests/harness_failure' );
+    _runtests( $harness_mute, "$source_tests/harness_failure" );
 
     $status   = pop @output;
     $summary  = pop @output;
     @expected = (
         'Test Summary Report',
         '-------------------',
-        't/source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)',
+        "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)",
         'Failed test:',
         '2',
     );
@@ -345,13 +341,13 @@ foreach my $test_args ( get_arg_sets() ) {
     @output = ();
     _runtests(
         $harness_directives,
-        't/source_tests/harness_directives'
+        "$source_tests/harness_directives"
     );
 
     chomp(@output);
 
     @expected = (
-        't/source_tests/harness_directives....',
+        "$source_tests/harness_directives....",
         'not ok 2 - we have a something # TODO some output',
         "ok 3 houston, we don't have liftoff # SKIP no funding",
         'ok',
@@ -360,7 +356,7 @@ foreach my $test_args ( get_arg_sets() ) {
         # ~TODO {{{ this should be an option
         #'Test Summary Report',
         #'-------------------',
-        #'t/source_tests/harness_directives (Wstat: 0 Tests: 3 Failed: 0)',
+        #"$source_tests/harness_directives (Wstat: 0 Tests: 3 Failed: 0)",
         #'Tests skipped:',
         #'3',
         # }}}
@@ -401,7 +397,7 @@ foreach my $test_args ( get_arg_sets() ) {
     );
 
     @output = ();
-    _runtests( $harness, 't/source_tests/harness_badtap' );
+    _runtests( $harness, "$source_tests/harness_badtap" );
     chomp(@output);
 
     @output   = map { trim($_) } @output;
@@ -409,7 +405,7 @@ foreach my $test_args ( get_arg_sets() ) {
     @summary  = @output[ 12 .. ( $#output - 1 ) ];
     @output   = @output[ 0 .. 11 ];
     @expected = (
-        't/source_tests/harness_badtap....',
+        "$source_tests/harness_badtap....",
         '1..2',
         '[[reset]]',
         'ok 1 - this is a test',
@@ -431,7 +427,7 @@ foreach my $test_args ( get_arg_sets() ) {
         'Test Summary Report',
         '-------------------',
         '[[red]]',
-        't/source_tests/harness_badtap (Wstat: 0 Tests: 2 Failed: 1)',
+        "$source_tests/harness_badtap (Wstat: 0 Tests: 2 Failed: 1)",
         '[[reset]]',
         '[[red]]',
         'Failed test:',
@@ -458,17 +454,17 @@ foreach my $test_args ( get_arg_sets() ) {
     # only show failures
 
     @output = ();
-    _runtests( $harness_failures, 't/source_tests/harness_failure' );
+    _runtests( $harness_failures, "$source_tests/harness_failure" );
 
     chomp(@output);
 
     @expected = (
-        't/source_tests/harness_failure....',
+        "$source_tests/harness_failure....",
         'not ok 2 - this is another test',
         'Failed 1/2 subtests',
         'Test Summary Report',
         '-------------------',
-        't/source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)',
+        "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)",
         'Failed test:',
         '2',
     );
@@ -484,16 +480,16 @@ foreach my $test_args ( get_arg_sets() ) {
     # check the status output for no tests
 
     @output = ();
-    _runtests( $harness_failures, 't/sample-tests/no_output' );
+    _runtests( $harness_failures, "$sample_tests/no_output" );
 
     chomp(@output);
 
     @expected = (
-        't/sample-tests/no_output....',
+        "$sample_tests/no_output....",
         'No subtests run',
         'Test Summary Report',
         '-------------------',
-        't/sample-tests/no_output (Wstat: 0 Tests: 0 Failed: 0)',
+        "$sample_tests/no_output (Wstat: 0 Tests: 0 Failed: 0)",
         'Parse errors: No plan found in TAP output',
     );
 
@@ -524,7 +520,12 @@ SKIP: {
         }
     );
 
-    eval { _runtests( $harness, 't/data/catme.1' ) };
+    eval {
+        _runtests(
+            $harness,
+            $ENV{PERL_CORE} ? 'lib/data/catme.1' : 't/data/catme.1'
+        );
+    };
 
     my @output = tied($$capture)->dump;
     my $status = pop @output;
@@ -547,9 +548,9 @@ SKIP: {
 
     _runtests(
         $harness,
-        't/source_tests/harness_complain'
+        "$source_tests/harness_complain"
         ,    # will get mad if run with args
-        't/source_tests/harness',
+        "$source_tests/harness",
     );
 
     my @output = tied($$capture)->dump;
@@ -788,7 +789,8 @@ sub _runtests {
 
     # coverage tests for the basically untested T::H::_open_spool
 
-    $ENV{PERL_TEST_HARNESS_DUMP_TAP} = File::Spec->catfile(qw(t spool));
+    my @spool = ( $ENV{PERL_CORE} ? ('spool') : ( 't', 'spool' ) );
+    $ENV{PERL_TEST_HARNESS_DUMP_TAP} = File::Spec->catfile(@spool);
 
 # now given that we're going to be writing stuff to the file system, make sure we have
 # a cleanup hook
@@ -807,14 +809,14 @@ sub _runtests {
 
     # normal tests in verbose mode
 
-    my $parser = $harness->runtests(
-        File::Spec->catfile(qw (t source_tests harness )) );
+    my $parser
+      = $harness->runtests( File::Spec->catfile( $source_tests, 'harness' ) );
 
     isa_ok $parser, 'TAP::Parser::Aggregator',
       '... runtests returns the aggregate';
 
     ok -e File::Spec->catfile(
         $ENV{PERL_TEST_HARNESS_DUMP_TAP},
-        qw( t source_tests harness )
+        $source_tests, 'harness'
     );
 }
index 0184c67..6a45e50 100755 (executable)
@@ -4,20 +4,12 @@
 # NOTE maybe a good candidate for xt/author or something.
 
 BEGIN {
-    if( $ENV{PERL_CORE} ) {
+    if ( $ENV{PERL_CORE} ) {
         chdir 't';
-        @INC = ('../lib', 'lib');
+        @INC = ( '../lib', 'lib' );
     }
     else {
-       use lib 't/lib';
-    }
-}
-
-BEGIN {
-    if ($ENV{PERL_CORE}) {
-       # FIXME
-       print "1..0 # Skip pending resolution of how to set the library with -I\n";
-       exit 0;
+        use lib 't/lib';
     }
 }
 
@@ -39,7 +31,8 @@ sub backticks {
     util::stdout_of( sub { system(@args) and die "error $?" } );
 }
 
-my @perl = ( $^X, '-Ilib', '-It/lib' );
+my @libs = map "-I$_", @INC;
+my @perl = ( $^X, @libs );
 my $mod = 'TAP::Parser::Iterator::Process';
 
 {    # just check the introspective method to start...
@@ -60,14 +53,15 @@ my $mod = 'TAP::Parser::Iterator::Process';
     local *STDERR;
     my $harness = TAP::Harness->new(
         {   verbosity => -2,
-            switches  => [ '-It/lib', "-MNoFork" ],
+            switches  => [ @libs, "-MNoFork" ],
             stdout    => $capture,
         }
     );
-    $harness->runtests(($ENV{PERL_CORE} ? 'lib' : 't') . '/sample-tests/simple');
+    $harness->runtests(
+        ( $ENV{PERL_CORE} ? 'lib' : 't' ) . '/sample-tests/simple' );
     my @output = tied($$capture)->dump;
     is pop @output, "Result: PASS\n", 'status OK';
-    pop @output;                 # get rid of summary line
+    pop @output;    # get rid of summary line
     is( $output[-1], "All tests successful.\n", 'ran with no fork' );
 }
 
index 8d90f4b..02d2e31 100644 (file)
@@ -1,15 +1,16 @@
 #!/usr/bin/perl -w
 
 BEGIN {
-    if ($ENV{PERL_CORE}) {
-       # FIXME
-       print "1..0 # Skip, needs fixing. Probably an -I issue\n";
-       exit 0;
+    if ( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ( '../lib', 'lib' );
+    }
+    else {
+        unshift @INC, 't/lib';
     }
 }
 
 use strict;
-use lib 't/lib';
 
 use Test::More;
 use File::Spec;
index 0e196ec..2577250 100644 (file)
@@ -1,10 +1,12 @@
 #!/usr/bin/perl -w
 
 BEGIN {
-    if ($ENV{PERL_CORE}) {
-       # FIXME
-       print "1..0 # Skip, needs fixing. Probably an -I issue\n";
-       exit 0;
+    if ( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ( '../lib', 'lib' );
+    }
+    else {
+        unshift @INC, 't/lib';
     }
 }
 
@@ -16,10 +18,15 @@ use App::Prove;
 
 my $prove = App::Prove->new;
 
-$prove->add_rc_file( File::Spec->catfile( 't', 'data', 'proverc' ) );
+$prove->add_rc_file(
+    File::Spec->catfile(
+        ( $ENV{PERL_CORE} ? 'lib' : 't' ), 'data', 'proverc'
+    )
+);
 
 is_deeply $prove->{rc_opts},
   [ '--should', 'be', '--split', 'correctly', 'Can', 'quote things',
-    'using single or', 'double quotes', '--this', 'is', 'OK?' ],
+    'using single or', 'double quotes', '--this', 'is', 'OK?'
+  ],
   'options parsed';
 
index e68b6d7..6cda6c4 100644 (file)
@@ -1,17 +1,16 @@
 #!/usr/bin/perl -w
 
 BEGIN {
-    if ($ENV{PERL_CORE}) {
-       # FIXME
-       print "1..0 # Skip, needs fixing. Probably an -I issue\n";
-       exit 0;
+    if ( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ( '../lib', 'lib' );
+    }
+    else {
+        unshift @INC, 't/lib';
     }
 }
 
 use strict;
-
-use lib 't/lib';
-
 use Test::More;
 use File::Spec;
 use App::Prove;
@@ -20,8 +19,10 @@ my @SCHEDULE;
 
 BEGIN {
 
-    my $sample_test
-      = File::Spec->catfile( split /\//, 't/sample-tests/simple' );
+    my $sample_test = File::Spec->catfile(
+        split /\//,
+        ( $ENV{PERL_CORE} ? 'lib' : 't' ) . '/sample-tests/simple'
+    );
 
     @SCHEDULE = (
         {   name   => 'Create empty',
index 1f4ae52..cfdf751 100644 (file)
@@ -1,15 +1,16 @@
 #!/usr/bin/perl -w
 
 BEGIN {
-    if ($ENV{PERL_CORE}) {
-       # FIXME
-       print "1..0 # Skip pending resolution of how to set the library with -I\n";
-       exit 0;
+    if ( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ( '../lib', 'lib' );
+    }
+    else {
+        unshift @INC, 't/lib';
     }
 }
 
 use strict;
-use lib 't/lib';
 
 use Test::More tests => 30;
 
@@ -18,8 +19,10 @@ use File::Spec;
 use TAP::Parser::Source;
 use TAP::Parser::Source::Perl;
 
-my $test = File::Spec->catfile( $ENV{PERL_CORE} ? 'lib' : 't', 'source_tests',
-                               'source' );
+my $test = File::Spec->catfile(
+    ( $ENV{PERL_CORE} ? 'lib' : 't' ), 'source_tests',
+    'source'
+);
 
 my $perl = $^X;
 
index b7b11b8..428423a 100644 (file)
@@ -1,10 +1,12 @@
 #!/usr/bin/perl -w
 
 BEGIN {
-    if ($ENV{PERL_CORE}) {
-       # FIXME
-       print "1..0 # Skip pending resolution of how to avoid creating a directory t in the core\n";
-       exit 0;
+    if ( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ( '../lib', 'lib' );
+    }
+    else {
+        unshift @INC, 't/lib';
     }
 }
 
@@ -13,8 +15,6 @@ BEGIN {
 # nearly everything
 
 use strict;
-use lib 't/lib';
-
 use Test::More;
 
 my $useOrigOpen;
@@ -66,7 +66,8 @@ plan tests => 4;
 
     # coverage tests for the basically untested T::H::_open_spool
 
-    $ENV{PERL_TEST_HARNESS_DUMP_TAP} = File::Spec->catfile(qw(t spool));
+    my @spool = ( $ENV{PERL_CORE} ? ('spool') : ( 't', 'spool' ) );
+    $ENV{PERL_TEST_HARNESS_DUMP_TAP} = File::Spec->catfile(@spool);
 
 # now given that we're going to be writing stuff to the file system, make sure we have
 # a cleanup hook
@@ -98,11 +99,10 @@ plan tests => 4;
 
     is @die, 1, 'open failed, die as expected';
 
-    my $spoolDir
-      = quotemeta( File::Spec->catfile(qw( t spool source_tests harness )) );
+    my $spoolDir = quotemeta(
+        File::Spec->catfile( @spool, qw( source_tests harness ) ) );
 
-    like pop @die, qr/ Can't write $spoolDir [(] /,
-      '...with expected message';
+    like pop @die, qr/ Can't write $spoolDir \( /, '...with expected message';
 
     # now make close fail
 
index 2d3891a..91335ac 100644 (file)
@@ -1,10 +1,12 @@
 #!/usr/bin/perl -w
 
 BEGIN {
-    if ($ENV{PERL_CORE}) {
-       # FIXME
-       print "1..0 # Skip pending resolution of how to set the library with -I\n";
-       exit 0;
+    if ( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ( '../lib', 'lib' );
+    }
+    else {
+        unshift @INC, 't/lib';
     }
 }
 
@@ -12,17 +14,17 @@ BEGIN {
 # tests
 
 use strict;
-use lib 't/lib';
-
 use Test::More ( $^O eq 'VMS' ? ( skip_all => 'VMS' ) : ( tests => 3 ) );
 
 use Config;
 use TAP::Parser;
 
+my $lib_path = join( ', ', map "'$_'", grep !ref, grep defined, @INC );
+
 sub run_test_file {
     my ( $test_template, @args ) = @_;
 
-    my $test_file = 't/temp_test.tmp';
+    my $test_file = 'temp_test.tmp';
 
     open TEST, ">$test_file" or die $!;
     printf TEST $test_template, @args;
@@ -38,13 +40,13 @@ sub run_test_file {
 {
     local $ENV{PERL5LIB} = join $Config{path_sep}, grep defined, 'wibble',
       $ENV{PERL5LIB};
-    run_test_file(<<'END');
+    run_test_file( <<'END', $lib_path );
 #!/usr/bin/perl -T
 
-use lib 't/lib';
+BEGIN { unshift @INC, ( %s ); }
 use Test::More tests => 1;
 
-is( $INC[1], 'wibble' ) or diag join "\n", @INC;
+ok grep(/^wibble$/, @INC) or diag join "\n", @INC;
 END
 }
 
@@ -53,17 +55,18 @@ END
     local $ENV{PERL5LIB};
     local $ENV{PERLLIB} = join $Config{path_sep}, grep defined, 'wibble',
       $perl5lib;
-    run_test_file(<<'END');
+    run_test_file( <<'END', $lib_path );
 #!/usr/bin/perl -T
 
-use lib 't/lib';
+BEGIN { unshift @INC, ( %s ); }
 use Test::More tests => 1;
 
-is( $INC[1], 'wibble' ) or diag join "\n", @INC;
+ok grep(/^wibble$/, @INC) or diag join "\n", @INC;
 END
 }
 
 {
+    local $ENV{PERL5LIB} = join $Config{path_sep}, @INC;
     local $ENV{PERL5OPT} = '-Mstrict';
     run_test_file(<<'END');
 #!/usr/bin/perl -T
index 3a600b6..de52689 100644 (file)
@@ -9,7 +9,8 @@ my @schedule;
 my %make_test;
 
 BEGIN {
-    plan skip_all => "unicode on Perl < 5.8.0"
+    # TODO: Investigate failure on 5.8.0
+    plan skip_all => "unicode on Perl <= 5.8.0"
       unless $] > 5.008;
 
     plan skip_all => "PERL_UNICODE set"
index f634d9c..6d469f4 100644 (file)
@@ -1,6 +1,15 @@
 #!/usr/bin/perl -wT
 
-use lib 't/lib';
+BEGIN {
+    if ( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ( '../lib', 'lib' );
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
 use Test::More tests => 1;
 
 ok 1;