4 if( $ENV{PERL_CORE} ) {
6 @INC = ('../lib', 'lib');
17 my $Curdir = File::Spec->curdir;
18 my $SAMPLE_TESTS = $ENV{PERL_CORE}
19 ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
20 : File::Spec->catdir($Curdir, 't', 'sample-tests');
23 my $IsMacPerl = $^O eq 'MacOS';
24 my $IsVMS = $^O eq 'VMS';
26 # VMS uses native, not POSIX, exit codes.
27 my $die_exit = $IsVMS ? 44 : 1;
29 # We can only predict that the wait status should be zero or not.
30 my $wait_non_zero = 1;
63 name => "basset hounds got long ears",
68 name => "all hell broke lose",
87 reason => "contract negociations",
118 name => "Interlock activated",
123 name => "Megathrusters are go",
128 name => "Head formed",
133 name => "Blazing sword formed",
138 name => "Robeast destroyed",
161 'wait' => $wait_non_zero
178 'wait' => $wait_non_zero
195 'wait' => $wait_non_zero
223 diagnostics => "comment\nmore ignored stuff\nand yet more\n",
253 diagnostics => "comment\nmore ignored stuff\nand yet more\n",
372 reason => "rain delay",
439 name => "-T honored",
509 diagnostics => "Failed test 1 in t/todo.t at line 9 *TODO*\n",
516 reason => "at line 10 TODO?!)",
525 diagnostics => "Test 4 got: '0' (t/todo.t at line 12 *TODO*)\n Expected: '1' (need more tuits)\n",
531 diagnostics => "woo\n",
533 reason => "at line 13 TODO?!)",
547 plan tests => (keys(%samples) * 5) + 3;
549 use Test::Harness::Straps;
551 $SIG{__WARN__} = sub {
552 warn @_ unless $_[0] =~ /^Enormous test number/ ||
553 $_[0] =~ /^Can't detailize/
556 for my $test ( sort keys %samples ) {
557 print "# Working on $test\n";
558 my $expect = $samples{$test};
560 for my $n ( 0..$#{$expect->{details}} ) {
561 for my $field ( qw( type name reason ) ) {
562 $expect->{details}[$n]{$field} = '' unless exists $expect->{details}[$n]{$field};
566 my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
567 my $strap = Test::Harness::Straps->new;
568 isa_ok( $strap, 'Test::Harness::Straps' );
569 my %results = $strap->analyze_file($test_path);
571 is_deeply($results{details}, $expect->{details}, qq{details of "$test"} );
573 delete $expect->{details};
574 delete $results{details};
577 skip '$? unreliable in MacPerl', 2 if $IsMacPerl;
579 # We can only check if it's zero or non-zero.
580 is( !!$results{'wait'}, !!$expect->{'wait'}, 'wait status' );
581 delete $results{'wait'};
582 delete $expect->{'wait'};
584 # Have to check the exit status seperately so we can skip it
586 is( $results{'exit'}, $expect->{'exit'} );
587 delete $results{'exit'};
588 delete $expect->{'exit'};
591 is_deeply(\%results, $expect, qq{ the rest of "$test"} );
595 my $strap = Test::Harness::Straps->new;
596 isa_ok( $strap, 'Test::Harness::Straps' );
597 ok( !$strap->analyze_file('I_dont_exist') );
598 is( $strap->{error}, "I_dont_exist does not exist" );