+++ /dev/null
-#!/usr/bin/perl -w
-
-BEGIN {
- if($ENV{PERL_CORE}) {
- chdir 't';
- @INC = '../lib';
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use Test::More tests => 8;
-
-BEGIN { use_ok 'Test::Harness' }
-BEGIN { diag( "Testing Test::Harness $Test::Harness::VERSION under Perl $] and Test::More $Test::More::VERSION" ) unless $ENV{PERL_CORE}}
-
-BEGIN { use_ok 'Test::Harness::Straps' }
-
-BEGIN { use_ok 'Test::Harness::Iterator' }
-
-BEGIN { use_ok 'Test::Harness::Assert' }
-
-BEGIN { use_ok 'Test::Harness::Point' }
-
-BEGIN { use_ok 'Test::Harness::Results' }
-
-BEGIN { use_ok 'Test::Harness::Util' }
-
-# If the $VERSION is set improperly, this will spew big warnings.
-BEGIN { use_ok 'Test::Harness', 1.1601 }
-
+++ /dev/null
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-
-use Test::More tests => 7;
-
-BEGIN { use_ok( 'Test::Harness::Assert' ); }
-
-
-ok( defined &assert, 'assert() exported' );
-
-ok( !eval { assert( 0 ); 1 }, 'assert( FALSE ) causes death' );
-like( $@, '/Assert failed/', ' with the right message' );
-
-ok( eval { assert( 1 ); 1 }, 'assert( TRUE ) does nothing' );
-
-ok( !eval { assert( 0, 'some name' ); 1 }, 'assert( FALSE, NAME )' );
-like( $@, '/some name/', ' has the name' );
+++ /dev/null
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use Test::More;
-use File::Spec;
-
-BEGIN {
- use vars qw( %samples );
-
- %samples = (
- bailout => [qw( header test test test bailout )],
- combined => ['header', ('test') x 10],
- descriptive => ['header', ('test') x 5 ],
- duplicates => ['header', ('test') x 11 ],
- head_end => [qw( other test test test test
- other header other other )],
- head_fail => [qw( other test test test test
- other header other other )],
- no_nums => ['header', ('test') x 5 ],
- out_of_order=> [('test') x 10, 'header', ('test') x 5],
- simple => [qw( header test test test test test )],
- simple_fail => [qw( header test test test test test )],
- 'skip' => [qw( header test test test test test )],
- skipall => [qw( header )],
- skipall_nomsg => [qw( header )],
- skip_nomsg => [qw( header test )],
- taint => [qw( header test )],
- 'todo' => [qw( header test test test test test )],
- todo_inline => [qw( header test test test )],
- vms_nit => [qw( header other test test )],
- with_comments => [qw( other header other test other test test
- test other other test other )],
- );
- plan tests => 2 + scalar keys %samples;
-}
-
-BEGIN { use_ok( 'Test::Harness::Straps' ); }
-
-my $Curdir = File::Spec->curdir;
-my $SAMPLE_TESTS = $ENV{PERL_CORE}
- ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
- : File::Spec->catdir($Curdir, 't', 'sample-tests');
-
-my $strap = Test::Harness::Straps->new;
-isa_ok( $strap, 'Test::Harness::Straps' );
-$strap->set_callback(
- sub {
- my($self, $line, $type, $totals) = @_;
- push @out, $type;
- }
-);
-
-for my $test ( sort keys %samples ) {
- my $expect = $samples{$test};
-
- local @out = ();
- $strap->analyze_file(File::Spec->catfile($SAMPLE_TESTS, $test));
-
- is_deeply(\@out, $expect, "$test callback");
-}
+++ /dev/null
-#!/usr/bin/perl -w
-
-BEGIN {
- if ($^O eq 'VMS') {
- print '1..0 # Child test output confuses parent test counter';
- exit;
- }
-}
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-
-use Test::More tests => 6;
-use File::Spec;
-
-BEGIN {
- use_ok( 'Test::Harness' );
-}
-
-my $died;
-sub prepare_for_death { $died = 0; }
-sub signal_death { $died = 1; }
-
-my $Curdir = File::Spec->curdir;
-my $SAMPLE_TESTS = $ENV{PERL_CORE}
- ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
- : File::Spec->catdir($Curdir, 't', 'sample-tests');
-
-PASSING: {
- local $SIG{__DIE__} = \&signal_death;
- prepare_for_death();
- eval { runtests( File::Spec->catfile( $SAMPLE_TESTS, "simple" ) ) };
- ok( !$@, "simple lives" );
- is( $died, 0, "Death never happened" );
-}
-
-FAILING: {
- local $SIG{__DIE__} = \&signal_death;
- prepare_for_death();
- eval { runtests( File::Spec->catfile( $SAMPLE_TESTS, "too_many" ) ) };
- ok( $@, "$@" );
- ok( $@ =~ m[Failed 1/1], "too_many dies" );
- is( $died, 1, "Death happened" );
-}
+++ /dev/null
-#!perl -Tw
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = '../lib';
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use Test::More tests => 23;
-
-BEGIN {
- use_ok( 'Test::Harness::Point' );
-}
-
-BASIC_OK: {
- my $line = "ok 14 - Blah blah";
- my $point = Test::Harness::Point->from_test_line( $line );
- isa_ok( $point, 'Test::Harness::Point', 'BASIC_OK' );
- is( $point->number, 14 );
- ok( $point->ok );
- is( $point->description, 'Blah blah' );
-}
-
-BASIC_NOT_OK: {
- my $line = "not ok 267 Yada";
- my $point = Test::Harness::Point->from_test_line( $line );
- isa_ok( $point, 'Test::Harness::Point', 'BASIC_NOT_OK' );
- is( $point->number, 267 );
- ok( !$point->ok );
- is( $point->description, 'Yada' );
-}
-
-CRAP: {
- my $point = Test::Harness::Point->from_test_line( 'ok14 - Blah' );
- ok( !defined $point, 'CRAP 1' );
-
- $point = Test::Harness::Point->from_test_line( 'notok 14' );
- ok( !defined $point, 'CRAP 2' );
-}
-
-PARSE_TODO: {
- my $point = Test::Harness::Point->from_test_line( 'not ok 14 - Calculate sqrt(-1) # TODO Still too rational' );
- isa_ok( $point, 'Test::Harness::Point', 'PARSE_TODO' );
- is( $point->description, 'Calculate sqrt(-1)' );
- is( $point->directive_type, 'todo' );
- is( $point->directive_reason, 'Still too rational' );
- ok( !$point->is_skip );
- ok( $point->is_todo );
-}
-
-PARSE_SKIP: {
- my $point = Test::Harness::Point->from_test_line( 'ok 14 # skip Not on bucket #6' );
- isa_ok( $point, 'Test::Harness::Point', 'PARSE_SKIP' );
- is( $point->description, '' );
- is( $point->directive_type, 'skip' );
- is( $point->directive_reason, 'Not on bucket #6' );
- ok( $point->is_skip );
- ok( !$point->is_todo );
-}
+++ /dev/null
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use Test::Harness;
-use Test::More tests => 1;
-use Dev::Null;
-
-push @INC, 'we_added_this_lib';
-
-tie *NULL, 'Dev::Null' or die $!;
-select NULL;
-my($tot, $failed) = Test::Harness::execute_tests(
- tests => [ $ENV{PERL_CORE} ? 'lib/sample-tests/inc_taint' : 't/sample-tests/inc_taint' ]
-);
-select STDOUT;
-
-ok( Test::Harness::_all_ok($tot), 'tests with taint on preserve @INC' );
+++ /dev/null
-if( $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE} ) {
- print "1..0 # Skip: t/TEST needs numbers\n";
- exit;
-}
-
-print <<END;
-1..6
-ok
-ok
-ok
-ok
-ok
-ok
-END
+++ /dev/null
--f "core" and unlink "core";
-print <<END;
-1..4
-ok 1
-ok 2
-ok 3
-ok 4
-END
+++ /dev/null
-#!/usr/bin/perl -w
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-
-use Test::More tests => 52;
-
-BEGIN {
- use_ok( 'Test::Harness::Point' );
- use_ok( 'Test::Harness::Straps' );
-}
-
-my $strap = Test::Harness::Straps->new;
-isa_ok( $strap, 'Test::Harness::Straps', 'new()' );
-
-
-my $testlines = {
- 'not ok' => {
- ok => 0
- },
- 'not ok # TODO' => {
- ok => 0,
- reason => '',
- type => 'todo'
- },
- 'not ok 1' => {
- number => 1,
- ok => 0
- },
- 'not ok 11 - this is \\# all the name # skip this is not' => {
- description => 'this is \\# all the name',
- number => 11,
- ok => 0,
- reason => 'this is not',
- type => 'skip'
- },
- 'not ok 23 # TODO world peace' => {
- number => 23,
- ok => 0,
- reason => 'world peace',
- type => 'todo'
- },
- 'not ok 42 - universal constant' => {
- description => 'universal constant',
- number => 42,
- ok => 0
- },
- ok => {
- ok => 1
- },
- 'ok # skip' => {
- ok => 1,
- type => 'skip'
- },
- 'ok 1' => {
- number => 1,
- ok => 1
- },
- 'ok 1066 - and all that' => {
- description => 'and all that',
- number => 1066,
- ok => 1
- },
- 'ok 11 - have life # TODO get a life' => {
- description => 'have life',
- number => 11,
- ok => 1,
- reason => 'get a life',
- type => 'todo'
- },
- 'ok 2938' => {
- number => 2938,
- ok => 1
- },
- 'ok 42 - _is_header() is a header \'1..192 todo 4 2 13 192 \\# Skip skip skip because' => {
- description => '_is_header() is a header \'1..192 todo 4 2 13 192 \\# Skip skip skip because',
- number => 42,
- ok => 1
- }
-};
-my @untests = (
- ' ok',
- 'not',
- 'okay 23',
- );
-
-for my $line ( sort keys %$testlines ) {
- my $point = Test::Harness::Point->from_test_line( $line );
- isa_ok( $point, 'Test::Harness::Point' );
-
- my $fields = $testlines->{$line};
- for my $property ( sort keys %$fields ) {
- my $value = $fields->{$property};
- is( eval "\$point->$property", $value, "$property on $line" );
- # Perls pre-5.6 can't handle $point->$property, and must be eval()d
- }
-}
+++ /dev/null
-#!perl -Tw
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use Test::More tests => 11;
-
-BEGIN {
- use_ok( 'Test::Harness::Point' );
-}
-
-my $point = Test::Harness::Point->new;
-isa_ok( $point, 'Test::Harness::Point' );
-ok( !$point->ok, "Should start out not OK" );
-
-$point->set_ok( 1 );
-ok( $point->ok, "should have turned to true" );
-
-$point->set_ok( 0 );
-ok( !$point->ok, "should have turned false" );
-
-$point->set_number( 2112 );
-is( $point->number, 2112, "Number is set" );
-
-$point->set_description( "Blah blah" );
-is( $point->description, "Blah blah", "Description set" );
-
-$point->set_directive( "Go now" );
-is( $point->directive, "Go now", "Directive set" );
-
-$point->add_diagnostic( "# Line 1" );
-$point->add_diagnostic( "# Line two" );
-$point->add_diagnostic( "# Third line" );
-my @diags = $point->diagnostics;
-is( @diags, 3, "Three lines" );
-is_deeply(
- \@diags,
- [ "# Line 1", "# Line two", "# Third line" ],
- "Diagnostics in list context"
-);
-
-my $diagstr = <<EOF;
-# Line 1
-# Line two
-# Third line
-EOF
-
-chomp $diagstr;
-my $string_diagnostics = $point->diagnostics;
-is( $string_diagnostics, $diagstr, "Diagnostics in scalar context" );
+++ /dev/null
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use File::Spec;
-use Test::More;
-plan skip_all => "Not adapted to perl core" if $ENV{PERL_CORE};
-plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE";
-
-plan tests => 1;
-
-my $tests = File::Spec->catfile( 't', 'prove*.t' );
-my $prove = File::Spec->catfile( File::Spec->curdir, "blib", "script", "prove" );
-$prove = "$^X $prove";
-
-GLOBBAGE: {
- my @actual = sort qx/$prove --dry $tests/;
- chomp @actual;
-
- my @expected = (
- File::Spec->catfile( "t", "prove-globbing.t" ),
- File::Spec->catfile( "t", "prove-switches.t" ),
- );
- is_deeply( \@actual, \@expected, "Expands the wildcards" );
-}
+++ /dev/null
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use File::Spec;
-use Test::More;
-plan skip_all => "Not adapted to perl core" if $ENV{PERL_CORE};
-plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE";
-
-plan tests => 8;
-
-my $blib = File::Spec->catfile( File::Spec->curdir, "blib" );
-my $blib_lib = File::Spec->catfile( $blib, "lib" );
-my $blib_arch = File::Spec->catfile( $blib, "arch" );
-my $prove = File::Spec->catfile( $blib, "script", "prove" );
-$prove = "$^X $prove";
-
-CAPITAL_TAINT: {
- local $ENV{PROVE_SWITCHES};
-
- my @actual = qx/$prove -Ifirst -D -I second -Ithird -Tvdb/;
- my @expected = ( "# \$Test::Harness::Switches: -T -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" );
- is_deeply( \@actual, \@expected, "Capital taint flags OK" );
-}
-
-LOWERCASE_TAINT: {
- local $ENV{PROVE_SWITCHES};
-
- my @actual = qx/$prove -dD -Ifirst -I second -t -Ithird -vb/;
- my @expected = ( "# \$Test::Harness::Switches: -t -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" );
- is_deeply( \@actual, \@expected, "Lowercase taint OK" );
-}
-
-PROVE_SWITCHES: {
- local $ENV{PROVE_SWITCHES} = "-dvb -I fark";
-
- my @actual = qx/$prove -Ibork -Dd/;
- my @expected = ( "# \$Test::Harness::Switches: -I$blib_arch -I$blib_lib -Ifark -Ibork\n" );
- is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" );
-}
-
-PROVE_SWITCHES_L: {
- my @actual = qx/$prove -l -Ibongo -Dd/;
- my @expected = ( "# \$Test::Harness::Switches: -Ilib -Ibongo\n" );
- is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" );
-}
-
-PROVE_SWITCHES_LB: {
- my @actual = qx/$prove -lb -Dd/;
- my @expected = ( "# \$Test::Harness::Switches: -Ilib -I$blib_arch -I$blib_lib\n" );
- is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" );
-}
-
-PROVE_VERSION: {
- # This also checks that the prove $VERSION is in sync with Test::Harness's $VERSION
- local $/ = undef;
-
- use_ok( 'Test::Harness' );
-
- my $thv = $Test::Harness::VERSION;
- my @actual = qx/$prove --version/;
- is( scalar @actual, 1, 'Only 1 line returned' );
- like( $actual[0], qq{/^\Qprove v$thv, using Test::Harness v$thv and Perl v5\E/} );
-}
+++ /dev/null
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use Test::More tests => 247;
-use File::Spec;
-
-my $Curdir = File::Spec->curdir;
-my $SAMPLE_TESTS = $ENV{PERL_CORE}
- ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
- : File::Spec->catdir($Curdir, 't', 'sample-tests');
-
-
-my $IsMacPerl = $^O eq 'MacOS';
-my $IsVMS = $^O eq 'VMS';
-
-# VMS uses native, not POSIX, exit codes.
-my $die_exit = $IsVMS ? 44 : 1;
-
-# We can only predict that the wait status should be zero or not.
-my $wait_non_zero = 1;
-
-my %samples = (
- bignum => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 2,
- ok => 4,
- passing => 0,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- combined => {
- bonus => 1,
- details => [
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- name => "basset hounds got long ears",
- ok => 1
- },
- {
- actual_ok => 0,
- name => "all hell broke lose",
- ok => 0
- },
- {
- actual_ok => 1,
- ok => 1,
- type => "todo"
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- ok => 1,
- reason => "contract negociations",
- type => "skip"
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 0,
- ok => 0
- },
- {
- actual_ok => 0,
- ok => 1,
- type => "todo"
- }
- ],
- 'exit' => 0,
- max => 10,
- ok => 8,
- passing => 0,
- seen => 10,
- skip => 1,
- todo => 2,
- 'wait' => 0
- },
- descriptive => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- name => "Interlock activated",
- ok => 1
- },
- {
- actual_ok => 1,
- name => "Megathrusters are go",
- ok => 1
- },
- {
- actual_ok => 1,
- name => "Head formed",
- ok => 1
- },
- {
- actual_ok => 1,
- name => "Blazing sword formed",
- ok => 1
- },
- {
- actual_ok => 1,
- name => "Robeast destroyed",
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- 'die' => {
- bonus => 0,
- details => [],
- 'exit' => $die_exit,
- max => 0,
- ok => 0,
- passing => 0,
- seen => 0,
- skip => 0,
- todo => 0,
- 'wait' => $wait_non_zero
- },
- die_head_end => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 4,
- ],
- 'exit' => $die_exit,
- max => 0,
- ok => 4,
- passing => 0,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => $wait_non_zero
- },
- die_last_minute => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 4,
- ],
- 'exit' => $die_exit,
- max => 4,
- ok => 4,
- passing => 0,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => $wait_non_zero
- },
- duplicates => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 10,
- ],
- 'exit' => 0,
- max => 10,
- ok => 11,
- passing => 0,
- seen => 11,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- head_end => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 3,
- {
- actual_ok => 1,
- diagnostics => "comment\nmore ignored stuff\nand yet more\n",
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 4,
- ok => 4,
- passing => 1,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- head_fail => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 0,
- ok => 0
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- diagnostics => "comment\nmore ignored stuff\nand yet more\n",
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 4,
- ok => 3,
- passing => 0,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- lone_not_bug => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 4,
- ],
- 'exit' => 0,
- max => 4,
- ok => 4,
- passing => 1,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- no_output => {
- bonus => 0,
- details => [],
- 'exit' => 0,
- max => 0,
- ok => 0,
- passing => 0,
- seen => 0,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- shbang_misparse => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 2,
- ],
- 'exit' => 0,
- max => 2,
- ok => 2,
- passing => 1,
- seen => 2,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- simple => {
- bonus => 0,
- details => [
- ({
- actual_ok => 1,
- ok => 1
- }) x 5,
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- simple_fail => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 0,
- ok => 0
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 0,
- ok => 0
- }
- ],
- 'exit' => 0,
- max => 5,
- ok => 3,
- passing => 0,
- seen => 5,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- skip => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- ok => 1,
- reason => "rain delay",
- type => "skip"
- },
- ({
- actual_ok => 1,
- ok => 1
- }) x 3,
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 1,
- todo => 0,
- 'wait' => 0
- },
- skip_nomsg => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- ok => 1,
- reason => "",
- type => "skip"
- }
- ],
- 'exit' => 0,
- max => 1,
- ok => 1,
- passing => 1,
- seen => 1,
- skip => 1,
- todo => 0,
- 'wait' => 0
- },
- skipall => {
- bonus => 0,
- details => [],
- 'exit' => 0,
- max => 0,
- ok => 0,
- passing => 1,
- seen => 0,
- skip => 0,
- skip_all => "rope",
- todo => 0,
- 'wait' => 0
- },
- skipall_nomsg => {
- bonus => 0,
- details => [],
- 'exit' => 0,
- max => 0,
- ok => 0,
- passing => 1,
- seen => 0,
- skip => 0,
- skip_all => "",
- todo => 0,
- 'wait' => 0
- },
- taint => {
- bonus => 0,
- details => [
- {
- actual_ok => 1,
- name => "-T honored",
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 1,
- ok => 1,
- passing => 1,
- seen => 1,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- todo => {
- bonus => 1,
- details => [
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 1,
- ok => 1,
- type => "todo"
- },
- {
- actual_ok => 0,
- ok => 1,
- type => "todo"
- },
- ({
- actual_ok => 1,
- ok => 1
- }) x 2,
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 0,
- todo => 2,
- 'wait' => 0
- },
- vms_nit => {
- bonus => 0,
- details => [
- {
- actual_ok => 0,
- ok => 0
- },
- {
- actual_ok => 1,
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 2,
- ok => 1,
- passing => 0,
- seen => 2,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- with_comments => {
- bonus => 2,
- details => [
- {
- actual_ok => 0,
- diagnostics => "Failed test 1 in t/todo.t at line 9 *TODO*\n",
- ok => 1,
- type => "todo"
- },
- {
- actual_ok => 1,
- ok => 1,
- reason => "at line 10 TODO?!)",
- type => "todo"
- },
- {
- actual_ok => 1,
- ok => 1
- },
- {
- actual_ok => 0,
- diagnostics => "Test 4 got: '0' (t/todo.t at line 12 *TODO*)\n Expected: '1' (need more tuits)\n",
- ok => 1,
- type => "todo"
- },
- {
- actual_ok => 1,
- diagnostics => "woo\n",
- ok => 1,
- reason => "at line 13 TODO?!)",
- type => "todo"
- }
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 0,
- todo => 4,
- 'wait' => 0
- },
-);
-
-use Test::Harness::Straps;
-my @_INC = map { qq{"-I$_"} } @INC;
-$Test::Harness::Switches = "@_INC -Mstrict";
-
-$SIG{__WARN__} = sub {
- warn @_ unless $_[0] =~ /^Enormous test number/ ||
- $_[0] =~ /^Can't detailize/
-};
-
-for my $test ( sort keys %samples ) {
- print "# Working on $test\n";
- my $expect = $samples{$test};
-
- for my $n ( 0..$#{$expect->{details}} ) {
- for my $field ( qw( type name reason ) ) {
- $expect->{details}[$n]{$field} = '' unless exists $expect->{details}[$n]{$field};
- }
- }
-
- my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
- my $results = $strap->analyze_file($test_path);
-
- is_deeply($results->details, $expect->{details}, qq{details of "$test"} );
-
- delete $expect->{details};
-
- SKIP: {
- skip '$? unreliable in MacPerl', 2 if $IsMacPerl;
-
- # We can only check if it's zero or non-zero.
- is( !$results->wait, !$expect->{'wait'}, 'wait status' );
- delete $expect->{'wait'};
-
- # Have to check the exit status seperately so we can skip it
- # in MacPerl.
- is( $results->exit, $expect->{'exit'}, 'exit matches' );
- delete $expect->{'exit'};
- }
-
- for my $field ( sort keys %$expect ) {
- is( $results->$field(), $expect->{$field}, "Field $field" );
- }
-} # for %samples
-
-NON_EXISTENT_FILE: {
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
- ok( !$strap->analyze_file('I_dont_exist'), "Can't analyze a non-existant file" );
- is( $strap->{error}, "I_dont_exist does not exist", "And there should be one error" );
-}
+++ /dev/null
-#!/usr/bin/perl -Tw
-
-use strict;
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use Test::More tests => 89;
-
-BEGIN { use_ok('Test::Harness::Straps'); }
-
-my $strap = Test::Harness::Straps->new;
-isa_ok( $strap, 'Test::Harness::Straps', 'new()' );
-
-### Testing _is_diagnostic()
-
-my $comment;
-ok( !$strap->_is_diagnostic("foo", \$comment), '_is_diagnostic(), not a comment' );
-ok( !defined $comment, ' no comment set' );
-
-ok( !$strap->_is_diagnostic("f # oo", \$comment), ' not a comment with #' );
-ok( !defined $comment, ' no comment set' );
-
-my %comments = (
- "# stuff and things # and stuff" =>
- ' stuff and things # and stuff',
- " # more things " => ' more things ',
- "#" => '',
- );
-
-for my $line ( sort keys %comments ) {
- my $line_comment = $comments{$line};
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
-
- my $name = substr($line, 0, 20);
- ok( $strap->_is_diagnostic($line, \$comment), " comment '$name'" );
- is( $comment, $line_comment, ' right comment set' );
-}
-
-
-
-### Testing _is_header()
-
-my @not_headers = (' 1..2',
- '1..M',
- '1..-1',
- '2..2',
- '1..a',
- '',
- );
-
-foreach my $unheader (@not_headers) {
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
-
- ok( !$strap->_is_header($unheader),
- "_is_header(), not a header '$unheader'" );
-
- ok( (!grep { exists $strap->{$_} } qw(max todo skip_all)),
- " max, todo and skip_all are not set" );
-}
-
-
-my @attribs = qw(max skip_all todo);
-my %headers = (
- '1..2' => { max => 2 },
- '1..1' => { max => 1 },
- '1..0' => { max => 0,
- skip_all => '',
- },
- '1..0 # Skipped: no leverage found' => { max => 0,
- skip_all => 'no leverage found',
- },
- '1..4 # Skipped: no leverage found' => { max => 4,
- skip_all => 'no leverage found',
- },
- '1..0 # skip skip skip because' => { max => 0,
- skip_all => 'skip skip because',
- },
- '1..10 todo 2 4 10' => { max => 10,
- 'todo' => { 2 => 1,
- 4 => 1,
- 10 => 1,
- },
- },
- '1..10 todo' => { max => 10 },
- '1..192 todo 4 2 13 192 # Skip skip skip because' =>
- { max => 192,
- 'todo' => { 4 => 1,
- 2 => 1,
- 13 => 1,
- 192 => 1,
- },
- skip_all => 'skip skip because'
- }
-);
-
-for my $header ( sort keys %headers ) {
- my $expect = $headers{$header};
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
-
- ok( $strap->_is_header($header), "_is_header() is a header '$header'" );
-
- is( $strap->{skip_all}, $expect->{skip_all}, ' skip_all set right' )
- if defined $expect->{skip_all};
-
- ok( eq_set( [map $strap->{$_}, grep defined $strap->{$_}, @attribs],
- [map $expect->{$_}, grep defined $expect->{$_}, @attribs] ),
- ' the right attributes are there' );
-}
-
-
-
-### Test _is_bail_out()
-
-my %bails = (
- 'Bail out!' => undef,
- 'Bail out! Wing on fire.' => 'Wing on fire.',
- 'BAIL OUT!' => undef,
- 'bail out! - Out of coffee' => '- Out of coffee',
- );
-
-for my $line ( sort keys %bails ) {
- my $expect = $bails{$line};
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
-
- my $reason;
- ok( $strap->_is_bail_out($line, \$reason), "_is_bail_out() spots '$line'");
- is( $reason, $expect, ' with the right reason' );
-}
-
-my @unbails = (
- ' Bail out!',
- 'BAIL OUT',
- 'frobnitz',
- 'ok 23 - BAIL OUT!',
- );
-
-foreach my $line (@unbails) {
- my $strap = Test::Harness::Straps->new;
- isa_ok( $strap, 'Test::Harness::Straps' );
-
- my $reason;
-
- ok( !$strap->_is_bail_out($line, \$reason),
- "_is_bail_out() ignores '$line'" );
- is( $reason, undef, ' and gives no reason' );
-}
+++ /dev/null
-#!/usr/bin/perl -w
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use File::Spec;
-
-my $Curdir = File::Spec->curdir;
-my $SAMPLE_TESTS = $ENV{PERL_CORE}
- ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
- : File::Spec->catdir($Curdir, 't', 'sample-tests');
-
-
-use Test::More;
-use Dev::Null;
-
-my $IsMacPerl = $^O eq 'MacOS';
-my $IsVMS = $^O eq 'VMS';
-
-# VMS uses native, not POSIX, exit codes.
-# MacPerl's exit codes are broken.
-my $die_estat = $IsVMS ? 44 :
- $IsMacPerl ? 0 :
- 1;
-
-my %samples = (
- simple => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- simple_fail => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 3,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '2 5',
- },
- all_ok => 0,
- },
- descriptive => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- no_nums => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '3',
- },
- all_ok => 0,
- },
- 'todo' => {
- total => {
- bonus => 1,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 2,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- todo_inline => {
- total => {
- bonus => 1,
- max => 3,
- 'ok' => 3,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 2,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- 'skip' => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 1,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- 'skip_nomsg' => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 1,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- bailout => 0,
- combined => {
- total => {
- bonus => 1,
- max => 10,
- 'ok' => 8,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 1,
- 'todo' => 2,
- skipped => 0
- },
- failed => {
- canon => '3 9',
- },
- all_ok => 0,
- },
- duplicates => {
- total => {
- bonus => 0,
- max => 10,
- 'ok' => 11,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '??',
- },
- all_ok => 0,
- },
- head_end => {
- total => {
- bonus => 0,
- max => 4,
- 'ok' => 4,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- head_fail => {
- total => {
- bonus => 0,
- max => 4,
- 'ok' => 3,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '2',
- },
- all_ok => 0,
- },
- no_output => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- },
- all_ok => 0,
- },
- skipall => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 1,
- },
- failed => { },
- all_ok => 1,
- },
- skipall_nomsg => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 1,
- },
- failed => { },
- all_ok => 1,
- },
- with_comments => {
- total => {
- bonus => 2,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 4,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- taint => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
-
- taint_warn => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
-
- 'die' => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- estat => $die_estat,
- max => '??',
- failed => '??',
- canon => '??',
- },
- all_ok => 0,
- },
-
- die_head_end => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- estat => $die_estat,
- max => '??',
- failed => '??',
- canon => '??',
- },
- all_ok => 0,
- },
-
- die_last_minute => {
- total => {
- bonus => 0,
- max => 4,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- estat => $die_estat,
- max => 4,
- failed => 0,
- canon => '??',
- },
- all_ok => 0,
- },
- bignum => {
- total => {
- bonus => 0,
- max => 2,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '??',
- },
- all_ok => 0,
- },
- bignum_many => {
- total => {
- bonus => 0,
- max => 2,
- 'ok' => 11,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '3-100000',
- },
- all_ok => 0,
- },
- 'shbang_misparse' => {
- total => {
- bonus => 0,
- max => 2,
- 'ok' => 2,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- too_many => {
- total => {
- bonus => 0,
- max => 3,
- 'ok' => 7,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '4-7',
- },
- all_ok => 0,
- },
- switches => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- );
-
-my $tests_per_loop = 8;
-plan tests => (keys(%samples) * $tests_per_loop);
-
-use Test::Harness;
-my @_INC = map { qq{"-I$_"} } @INC;
-$Test::Harness::Switches = "@_INC -Mstrict";
-
-tie *NULL, 'Dev::Null' or die $!;
-
-for my $test ( sort keys %samples ) {
-SKIP: {
- skip "-t introduced in 5.8.0", $tests_per_loop
- if ($test eq 'taint_warn') && ($] < 5.008);
-
- my $expect = $samples{$test};
-
- # execute_tests() runs the tests but skips the formatting.
- my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
-
- print STDERR "# $test\n" if $ENV{TEST_VERBOSE};
- my $totals;
- my $failed;
- my $warning = '';
- eval {
- local $SIG{__WARN__} = sub { $warning .= join '', @_; };
- ($totals, $failed) = Test::Harness::execute_tests(tests => [$test_path], out => \*NULL);
- };
-
- # $? is unreliable in MacPerl, so we'll just fudge it.
- $failed->{estat} = $die_estat if $IsMacPerl and $failed;
-
- SKIP: {
- skip "special tests for bailout", 1 unless $test eq 'bailout';
- like( $@, '/Further testing stopped: GERONI/i' );
- }
-
- SKIP: {
- skip "don't apply to a bailout", 6 if $test eq 'bailout';
- is( $@, '', '$@ is empty' );
- is( Test::Harness::_all_ok($totals), $expect->{all_ok},
- "$test - all ok" );
- ok( defined $expect->{total}, "$test - has total" );
- is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}},
- $expect->{total},
- "$test - totals" );
- is_deeply( {map { $_=>$failed->{$test_path}{$_} }
- keys %{$expect->{failed}}},
- $expect->{failed},
- "$test - failed" );
-
- skip "No tests were run", 1 unless $totals->{max};
-
- my $output = Test::Harness::get_results($totals, $failed);
- like( $output, '/All tests successful|List of Failed/', 'Got what looks like a valid summary' );
- }
-
- my $expected_warnings = "";
- if ( $test eq "bignum" ) {
- $expected_warnings = <<WARN;
-Enormous test number seen [test 136211425]
-Can't detailize, too big.
-WARN
- }
- elsif ( $test eq 'bignum_many' ) {
- $expected_warnings = <<WARN;
-Enormous test number seen [test 100001]
-Can't detailize, too big.
-WARN
- }
- my $desc = $expected_warnings ? 'Got proper warnings' : 'No warnings';
- is( $warning, $expected_warnings, "$test - $desc" );
-} # taint SKIP block
-} # for tests
+++ /dev/null
-#!/usr/bin/perl -Tw
-
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-
-use Test::More tests => 3;
-
-BEGIN {
- use_ok('Test::Harness');
-}
-
-my $ver = $ENV{HARNESS_VERSION} or die "HARNESS_VERSION not set";
-ok( $ver =~ /^2.\d\d(_\d\d)?$/, "Version is proper format" );
-is( $ver, $Test::Harness::VERSION );
projects / p5sagit/p5-mst-13.2.git / commitdiff