[p5sagit/p5-mst-13.2.git] / lib / Test / Harness / t / test-harness.t

#!/usr/bin/perl

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = '../lib';
    }
}

my $SAMPLE_TESTS = $ENV{PERL_CORE} ? "lib/sample-tests" : "t/sample-tests";

use strict;

# For shutting up Test::Harness.
# Has to work on 5.004 which doesn't have Tie::StdHandle.
package My::Dev::Null;

sub WRITE  {}
sub PRINT  {}
sub PRINTF {}
sub TIEHANDLE {
    my $class = shift;
    my $fh    = do { local *HANDLE;  \*HANDLE };
    return bless $fh, $class;
}
sub READ {}
sub READLINE {}
sub GETC {}


package main;

# Utility testing functions.
my $test_num = 1;
sub ok ($;$) {
    my($test, $name) = @_;
    my $okstring = '';
    $okstring = "not " unless $test;
    $okstring .= "ok $test_num";
    $okstring .= " - $name" if defined $name;
    print "$okstring\n";
    $test_num++;
}

sub eqhash {
    my($a1, $a2) = @_;
    return 0 unless keys %$a1 == keys %$a2;

    my $ok = 1;
    foreach my $k (keys %$a1) {
        $ok = $a1->{$k} eq $a2->{$k};
        last unless $ok;
    }

    return $ok;
}

use vars qw($Total_tests %samples);

my $loaded;
BEGIN { $| = 1; $^W = 1; }
END {print "not ok $test_num\n" unless $loaded;}
print "1..$Total_tests\n";
use Test::Harness;
$loaded = 1;
ok(1, 'compile');
######################### End of black magic.

BEGIN {
    %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,
                                     },
                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,
                                     },
                skip_all          => {
                                      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,
                                     },
               );

    $Total_tests = (keys(%samples) * 4);
}

tie *NULL, 'My::Dev::Null' or die $!;

while (my($test, $expect) = each %samples) {
    # _run_all_tests() runs the tests but skips the formatting.
    my($totals, $failed);
    eval {
        select NULL;    # _run_all_tests() isn't as quiet as it should be.
        ($totals, $failed) = 
          Test::Harness::_run_all_tests("$SAMPLE_TESTS/$test");
    };
    select STDOUT;

    unless( $@ ) {
        ok( Test::Harness::_all_ok($totals) == $expect->{all_ok},    
                                                      "$test - all ok" );
        ok( defined $expect->{total},                 "$test - has total" );
        ok( eqhash( $expect->{total}, 
                    {map { $_=>$totals->{$_} } keys %{$expect->{total}}} ),
                                                         "$test - totals" );
        ok( eqhash( $expect->{failed}, 
                    {map { $_=>$failed->{"$SAMPLE_TESTS/$test"}{$_} }
                              keys %{$expect->{failed}}} ),
                                                         "$test - failed" );
    }
    else {      # special case for bailout
        ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i),
            $test );
        ok( 1,  'skipping for bailout' );
        ok( 1,  'skipping for bailout' );
    }
}
Commit	Line	Data
13287dd5	1	#!/usr/bin/perl
2fe373ce	2
2fe373ce	3	BEGIN {
13287dd5	4	if( $ENV{PERL_CORE} ) {
	5	chdir 't';
	6	@INC = '../lib';
	7	}
2fe373ce	8	}
2fe373ce	9
13287dd5	10	my $SAMPLE_TESTS = $ENV{PERL_CORE} ? "lib/sample-tests" : "t/sample-tests";
13287dd5	11
2fe373ce	12	use strict;
	13
	14	# For shutting up Test::Harness.
13287dd5	15	# Has to work on 5.004 which doesn't have Tie::StdHandle.
2fe373ce	16	package My::Dev::Null;
	17
	18	sub WRITE {}
	19	sub PRINT {}
	20	sub PRINTF {}
	21	sub TIEHANDLE {
	22	my $class = shift;
	23	my $fh = do { local HANDLE; \HANDLE };
	24	return bless $fh, $class;
	25	}
	26	sub READ {}
	27	sub READLINE {}
	28	sub GETC {}
	29
	30
	31	package main;
	32
	33	# Utility testing functions.
	34	my $test_num = 1;
	35	sub ok ($;$) {
	36	my($test, $name) = @_;
	37	my $okstring = '';
	38	$okstring = "not " unless $test;
	39	$okstring .= "ok $test_num";
	40	$okstring .= " - $name" if defined $name;
	41	print "$okstring\n";
	42	$test_num++;
	43	}
	44
	45	sub eqhash {
	46	my($a1, $a2) = @_;
	47	return 0 unless keys %$a1 == keys %$a2;
	48
	49	my $ok = 1;
	50	foreach my $k (keys %$a1) {
	51	$ok = $a1->{$k} eq $a2->{$k};
	52	last unless $ok;
	53	}
	54
	55	return $ok;
	56	}
	57
	58	use vars qw($Total_tests %samples);
	59
	60	my $loaded;
	61	BEGIN { $\| = 1; $^W = 1; }
	62	END {print "not ok $test_num\n" unless $loaded;}
	63	print "1..$Total_tests\n";
	64	use Test::Harness;
	65	$loaded = 1;
	66	ok(1, 'compile');
	67	######################### End of black magic.
	68
	69	BEGIN {
	70	%samples = (
	71	simple => {
	72	total => {
	73	bonus => 0,
	74	max => 5,
	75	'ok' => 5,
	76	files => 1,
	77	bad => 0,
	78	good => 1,
	79	tests => 1,
80	sub_skipped=> 0,
81	todo => 0,
82	skipped => 0,
83	},
84	failed => { },
85	all_ok => 1,
86	},
87	simple_fail => {
88	total => {
89	bonus => 0,
90	max => 5,
91	'ok' => 3,
92	files => 1,
93	bad => 1,
94	good => 0,
95	tests => 1,
96	sub_skipped => 0,
97	todo => 0,
98	skipped => 0,
99	},
100	failed => {
101	canon => '2 5',
102	},
103	all_ok => 0,
104	},
105	descriptive => {
106	total => {
107	bonus => 0,
108	max => 5,
109	'ok' => 5,
110	files => 1,
111	bad => 0,
112	good => 1,
113	tests => 1,
114	sub_skipped=> 0,
115	todo => 0,
116	skipped => 0,
117	},
118	failed => { },
119	all_ok => 1,
120	},
121	no_nums => {
122	total => {
123	bonus => 0,
124	max => 5,
125	'ok' => 4,
126	files => 1,
127	bad => 1,
128	good => 0,
129	tests => 1,
130	sub_skipped=> 0,
131	todo => 0,
132	skipped => 0,
133	},
134	failed => {
135	canon => '3',
136	},
137	all_ok => 0,
138	},
139	todo => {
140	total => {
141	bonus => 1,
142	max => 5,
143	'ok' => 5,
144	files => 1,
145	bad => 0,
146	good => 1,
147	tests => 1,
148	sub_skipped=> 0,
149	todo => 2,
150	skipped => 0,
151	},
152	failed => { },
153	all_ok => 1,
154	},
155	todo_inline => {
156	total => {
157	bonus => 1,
158	max => 3,
159	'ok' => 3,
160	files => 1,
161	bad => 0,
162	good => 1,
163	tests => 1,
164	sub_skipped => 0,
165	todo => 2,
166	skipped => 0,
167	},
168	failed => { },
169	all_ok => 1,
170	},
171	skip => {
172	total => {
173	bonus => 0,
174	max => 5,
175	'ok' => 5,
176	files => 1,
177	bad => 0,
178	good => 1,
179	tests => 1,
180	sub_skipped=> 1,
181	todo => 0,
182	skipped => 0,
183	},
184	failed => { },
185	all_ok => 1,
186	},
187	bailout => 0,
188	combined => {
189	total => {
190	bonus => 1,
191	max => 10,
192	'ok' => 8,
193	files => 1,
194	bad => 1,
195	good => 0,
196	tests => 1,
197	sub_skipped=> 1,
198	todo => 2,
199	skipped => 0
200	},
201	failed => {
202	canon => '3 9',
203	},
204	all_ok => 0,
205	},
206	duplicates => {
207	total => {
208	bonus => 0,
209	max => 10,
210	'ok' => 11,
211	files => 1,
212	bad => 1,
213	good => 0,
214	tests => 1,
215	sub_skipped=> 0,
216	todo => 0,
217	skipped => 0,
218	},
219	failed => {
220	canon => '??',
221	},
222	all_ok => 0,
223	},
879ba010	224	head_end => {
2fe373ce	225	total => {
	226	bonus => 0,
	227	max => 4,
	228	'ok' => 4,
	229	files => 1,
	230	bad => 0,
	231	good => 1,
	232	tests => 1,
	233	sub_skipped=> 0,
	234	todo => 0,
	235	skipped => 0,
	236	},
	237	failed => { },
	238	all_ok => 1,
	239	},
879ba010	240	head_fail => {
2fe373ce	241	total => {
	242	bonus => 0,
	243	max => 4,
	244	'ok' => 3,
	245	files => 1,
	246	bad => 1,
	247	good => 0,
	248	tests => 1,
	249	sub_skipped=> 0,
	250	todo => 0,
	251	skipped => 0,
	252	},
	253	failed => {
	254	canon => '2',
	255	},
	256	all_ok => 0,
	257	},
	258	skip_all => {
	259	total => {
	260	bonus => 0,
	261	max => 0,
	262	'ok' => 0,
	263	files => 1,
	264	bad => 0,
	265	good => 1,
	266	tests => 1,
	267	sub_skipped=> 0,
	268	todo => 0,
	269	skipped => 1,
	270	},
	271	failed => { },
	272	all_ok => 1,
	273	},
	274	with_comments => {
	275	total => {
	276	bonus => 2,
	277	max => 5,
	278	'ok' => 5,
	279	files => 1,
	280	bad => 0,
	281	good => 1,
	282	tests => 1,
	283	sub_skipped=> 0,
	284	todo => 4,
	285	skipped => 0,
	286	},
	287	failed => { },
	288	all_ok => 1,
	289	},
13287dd5	290	taint => {
	291	total => {
	292	bonus => 0,
	293	max => 1,
	294	'ok' => 1,
	295	files => 1,
	296	bad => 0,
	297	good => 1,
	298	tests => 1,
	299	sub_skipped=> 0,
	300	todo => 0,
	301	skipped => 0,
	302	},
	303	failed => { },
	304	all_ok => 1,
	305	},
2fe373ce	306	);
	307
	308	$Total_tests = (keys(%samples) * 4);
	309	}
	310
	311	tie *NULL, 'My::Dev::Null' or die $!;
	312
	313	while (my($test, $expect) = each %samples) {
	314	# _run_all_tests() runs the tests but skips the formatting.
	315	my($totals, $failed);
	316	eval {
	317	select NULL; # _run_all_tests() isn't as quiet as it should be.
	318	($totals, $failed) =
13287dd5	319	Test::Harness::_run_all_tests("$SAMPLE_TESTS/$test");
2fe373ce	320	};
	321	select STDOUT;
	322
	323	unless( $@ ) {
	324	ok( Test::Harness::_all_ok($totals) == $expect->{all_ok},
	325	"$test - all ok" );
	326	ok( defined $expect->{total}, "$test - has total" );
	327	ok( eqhash( $expect->{total},
	328	{map { $_=>$totals->{$_} } keys %{$expect->{total}}} ),
	329	"$test - totals" );
	330	ok( eqhash( $expect->{failed},
13287dd5	331	{map { $_=>$failed->{"$SAMPLE_TESTS/$test"}{$_} }
2fe373ce	332	keys %{$expect->{failed}}} ),
	333	"$test - failed" );
	334	}
	335	else { # special case for bailout
	336	ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i),
	337	$test );
	338	ok( 1, 'skipping for bailout' );
	339	ok( 1, 'skipping for bailout' );
	340	}
	341	}