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

#!/usr/bin/perl -w

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

use File::Spec::Functions;

my $SAMPLE_TESTS = $ENV{PERL_CORE}
    ? catdir(curdir(), 'lib', 'sample-tests')
    : catdir(curdir(), '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;

use Test::More;

my $IsVMS = $^O eq 'VMS';
my $IsMacOS = $^O eq 'MacOS';

# VMS uses native, not POSIX, exit codes.
my $die_estat = $IsVMS ? 44 : $IsMacOS ? 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,
                                 },
            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,
                                 },

            '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,
                                 },
            '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,
                                 },
           );

plan tests => (keys(%samples) * 7) + 1;

use Test::Harness;
use_ok('Test::Harness');


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);
    my $warning;
    eval {
        select NULL;    # _run_all_tests() isn't as quiet as it should be.
        local $SIG{__WARN__} = sub { $warning .= join '', @_; };
        ($totals, $failed) = 
          Test::Harness::_run_all_tests(catfile($SAMPLE_TESTS, $test));
    };
    select STDOUT;

    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", 5 if $test eq 'bailout';
        is( $@, '' );
        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->{catfile($SAMPLE_TESTS, $test)}{$_} }
                    keys %{$expect->{failed}}},
                   $expect->{failed},
                                                  "$test - failed" );
    }

    SKIP: {
        skip "special tests for bignum", 1 unless $test eq 'bignum';
        is( $warning, <<WARN );
Enourmous test number seen [test 100001]
Can't detailize, too big.
Enourmous test number seen [test 136211425]
Can't detailize, too big.
WARN

    }

}
Commit	Line	Data
356733da	1	#!/usr/bin/perl -w
2fe373ce	2
2fe373ce	3	BEGIN {
13287dd5	4	if( $ENV{PERL_CORE} ) {
13287dd5	5	chdir 't';
356733da	6	@INC = ('../lib', 'lib');
	7	}
	8	else {
	9	unshift @INC, 't/lib';
13287dd5	10	}
2fe373ce	11	}
2fe373ce	12
e69a2255	13	use File::Spec::Functions;
	14
	15	my $SAMPLE_TESTS = $ENV{PERL_CORE}
	16	? catdir(curdir(), 'lib', 'sample-tests')
	17	: catdir(curdir(), 't', 'sample-tests');
13287dd5	18
2fe373ce	19	use strict;
	20
	21	# For shutting up Test::Harness.
13287dd5	22	# Has to work on 5.004 which doesn't have Tie::StdHandle.
2fe373ce	23	package My::Dev::Null;
	24
	25	sub WRITE {}
	26	sub PRINT {}
	27	sub PRINTF {}
	28	sub TIEHANDLE {
	29	my $class = shift;
	30	my $fh = do { local HANDLE; \HANDLE };
	31	return bless $fh, $class;
	32	}
	33	sub READ {}
	34	sub READLINE {}
	35	sub GETC {}
	36
	37
	38	package main;
	39
356733da	40	use Test::More;
2fe373ce	41
f0008e52	42	my $IsVMS = $^O eq 'VMS';
e69a2255	43	my $IsMacOS = $^O eq 'MacOS';
2fe373ce	44
f0008e52	45	# VMS uses native, not POSIX, exit codes.
e69a2255	46	my $die_estat = $IsVMS ? 44 : $IsMacOS ? 0 : 1;
356733da	47
f0008e52	48	my %samples = (
	49	simple => {
	50	total => {
	51	bonus => 0,
	52	max => 5,
	53	'ok' => 5,
	54	files => 1,
	55	bad => 0,
	56	good => 1,
	57	tests => 1,
	58	sub_skipped=> 0,
	59	'todo' => 0,
	60	skipped => 0,
	61	},
	62	failed => { },
	63	all_ok => 1,
	64	},
	65	simple_fail => {
	66	total => {
	67	bonus => 0,
	68	max => 5,
	69	'ok' => 3,
	70	files => 1,
	71	bad => 1,
	72	good => 0,
	73	tests => 1,
	74	sub_skipped => 0,
	75	'todo' => 0,
	76	skipped => 0,
	77	},
	78	failed => {
	79	canon => '2 5',
	80	},
	81	all_ok => 0,
	82	},
	83	descriptive => {
	84	total => {
	85	bonus => 0,
	86	max => 5,
	87	'ok' => 5,
	88	files => 1,
	89	bad => 0,
	90	good => 1,
	91	tests => 1,
	92	sub_skipped=> 0,
	93	'todo' => 0,
	94	skipped => 0,
	95	},
	96	failed => { },
	97	all_ok => 1,
	98	},
	99	no_nums => {
	100	total => {
	101	bonus => 0,
	102	max => 5,
	103	'ok' => 4,
	104	files => 1,
	105	bad => 1,
	106	good => 0,
	107	tests => 1,
	108	sub_skipped=> 0,
	109	'todo' => 0,
	110	skipped => 0,
	111	},
112	failed => {
113	canon => '3',
114	},
115	all_ok => 0,
116	},
117	'todo' => {
118	total => {
119	bonus => 1,
120	max => 5,
121	'ok' => 5,
122	files => 1,
123	bad => 0,
124	good => 1,
125	tests => 1,
126	sub_skipped=> 0,
127	'todo' => 2,
128	skipped => 0,
129	},
130	failed => { },
131	all_ok => 1,
132	},
133	todo_inline => {
134	total => {
135	bonus => 1,
136	max => 3,
137	'ok' => 3,
138	files => 1,
139	bad => 0,
140	good => 1,
141	tests => 1,
142	sub_skipped => 0,
143	'todo' => 2,
144	skipped => 0,
145	},
146	failed => { },
147	all_ok => 1,
148	},
149	'skip' => {
150	total => {
151	bonus => 0,
152	max => 5,
153	'ok' => 5,
154	files => 1,
155	bad => 0,
156	good => 1,
157	tests => 1,
158	sub_skipped=> 1,
159	'todo' => 0,
160	skipped => 0,
161	},
162	failed => { },
163	all_ok => 1,
164	},
165	bailout => 0,
166	combined => {
167	total => {
168	bonus => 1,
169	max => 10,
170	'ok' => 8,
171	files => 1,
172	bad => 1,
173	good => 0,
174	tests => 1,
175	sub_skipped=> 1,
176	'todo' => 2,
177	skipped => 0
178	},
179	failed => {
180	canon => '3 9',
181	},
182	all_ok => 0,
183	},
184	duplicates => {
185	total => {
186	bonus => 0,
187	max => 10,
188	'ok' => 11,
189	files => 1,
190	bad => 1,
191	good => 0,
192	tests => 1,
193	sub_skipped=> 0,
194	'todo' => 0,
195	skipped => 0,
196	},
197	failed => {
198	canon => '??',
199	},
200	all_ok => 0,
201	},
202	head_end => {
203	total => {
204	bonus => 0,
205	max => 4,
206	'ok' => 4,
207	files => 1,
208	bad => 0,
209	good => 1,
210	tests => 1,
211	sub_skipped=> 0,
212	'todo' => 0,
213	skipped => 0,
214	},
215	failed => { },
216	all_ok => 1,
217	},
218	head_fail => {
219	total => {
220	bonus => 0,
221	max => 4,
222	'ok' => 3,
223	files => 1,
224	bad => 1,
225	good => 0,
226	tests => 1,
227	sub_skipped=> 0,
228	'todo' => 0,
229	skipped => 0,
230	},
231	failed => {
232	canon => '2',
233	},
234	all_ok => 0,
235	},
236	skip_all => {
237	total => {
238	bonus => 0,
239	max => 0,
240	'ok' => 0,
241	files => 1,
242	bad => 0,
243	good => 1,
244	tests => 1,
245	sub_skipped=> 0,
246	'todo' => 0,
247	skipped => 1,
248	},
249	failed => { },
250	all_ok => 1,
251	},
252	with_comments => {
253	total => {
254	bonus => 2,
255	max => 5,
256	'ok' => 5,
257	files => 1,
258	bad => 0,
259	good => 1,
260	tests => 1,
261	sub_skipped=> 0,
262	'todo' => 4,
263	skipped => 0,
264	},
265	failed => { },
266	all_ok => 1,
267	},
268	taint => {
269	total => {
270	bonus => 0,
271	max => 1,
272	'ok' => 1,
273	files => 1,
274	bad => 0,
275	good => 1,
276	tests => 1,
277	sub_skipped=> 0,
278	'todo' => 0,
279	skipped => 0,
280	},
281	failed => { },
282	all_ok => 1,
283	},
2fe373ce	284
f0008e52	285	'die' => {
	286	total => {
	287	bonus => 0,
	288	max => 0,
	289	'ok' => 0,
	290	files => 1,
	291	bad => 1,
	292	good => 0,
	293	tests => 1,
	294	sub_skipped=> 0,
	295	'todo' => 0,
	296	skipped => 0,
	297	},
	298	failed => {
	299	estat => $die_estat,
f0008e52	300	max => '??',
	301	failed => '??',
	302	canon => '??',
	303	},
	304	all_ok => 0,
	305	},
356733da	306
f0008e52	307	die_head_end => {
	308	total => {
	309	bonus => 0,
	310	max => 0,
	311	'ok' => 4,
	312	files => 1,
	313	bad => 1,
	314	good => 0,
	315	tests => 1,
	316	sub_skipped=> 0,
	317	'todo' => 0,
	318	skipped => 0,
	319	},
	320	failed => {
	321	estat => $die_estat,
f0008e52	322	max => '??',
	323	failed => '??',
	324	canon => '??',
	325	},
	326	all_ok => 0,
	327	},
356733da	328
f0008e52	329	die_last_minute => {
	330	total => {
	331	bonus => 0,
	332	max => 4,
	333	'ok' => 4,
	334	files => 1,
	335	bad => 1,
	336	good => 0,
	337	tests => 1,
	338	sub_skipped=> 0,
	339	'todo' => 0,
	340	skipped => 0,
	341	},
	342	failed => {
	343	estat => $die_estat,
f0008e52	344	max => 4,
	345	failed => 0,
	346	canon => '??',
	347	},
	348	all_ok => 0,
	349	},
	350	bignum => {
	351	total => {
	352	bonus => 0,
	353	max => 2,
	354	'ok' => 4,
	355	files => 1,
	356	bad => 1,
	357	good => 0,
	358	tests => 1,
	359	sub_skipped=> 0,
	360	'todo' => 0,
	361	skipped => 0,
	362	},
	363	failed => {
	364	canon => '??',
	365	},
	366	all_ok => 0,
	367	},
6e5a998b	368	'shbang_misparse' => {
	369	total => {
	370	bonus => 0,
	371	max => 2,
	372	'ok' => 2,
	373	files => 1,
	374	bad => 0,
	375	good => 1,
	376	tests => 1,
	377	sub_skipped=> 0,
	378	'todo' => 0,
	379	skipped => 0,
	380	},
	381	failed => { },
	382	all_ok => 1,
	383	},
f0008e52	384	);
356733da	385
308957f5	386	plan tests => (keys(%samples) * 7) + 1;
f0008e52	387
	388	use Test::Harness;
	389	use_ok('Test::Harness');
2fe373ce	390
2fe373ce	391
	392	tie *NULL, 'My::Dev::Null' or die $!;
	393
	394	while (my($test, $expect) = each %samples) {
	395	# _run_all_tests() runs the tests but skips the formatting.
	396	my($totals, $failed);
308957f5	397	my $warning;
2fe373ce	398	eval {
2fe373ce	399	select NULL; # _run_all_tests() isn't as quiet as it should be.
308957f5	400	local $SIG{__WARN__} = sub { $warning .= join '', @_; };
2fe373ce	401	($totals, $failed) =
e69a2255	402	Test::Harness::_run_all_tests(catfile($SAMPLE_TESTS, $test));
2fe373ce	403	};
	404	select STDOUT;
	405
308957f5	406	SKIP: {
	407	skip "special tests for bailout", 1 unless $test eq 'bailout';
	408	like( $@, '/Further testing stopped: GERONI/i' );
	409	}
	410
	411	SKIP: {
	412	skip "don't apply to a bailout", 5 if $test eq 'bailout';
	413	is( $@, '' );
	414	is( Test::Harness::_all_ok($totals), $expect->{all_ok},
	415	"$test - all ok" );
	416	ok( defined $expect->{total}, "$test - has total" );
356733da	417	is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}},
356733da	418	$expect->{total},
308957f5	419	"$test - totals" );
e69a2255	420	is_deeply( {map { $_=>$failed->{catfile($SAMPLE_TESTS, $test)}{$_} }
308957f5	421	keys %{$expect->{failed}}},
356733da	422	$expect->{failed},
308957f5	423	"$test - failed" );
2fe373ce	424	}
308957f5	425
	426	SKIP: {
	427	skip "special tests for bignum", 1 unless $test eq 'bignum';
	428	is( $warning, <<WARN );
	429	Enourmous test number seen [test 100001]
	430	Can't detailize, too big.
	431	Enourmous test number seen [test 136211425]
	432	Can't detailize, too big.
	433	WARN
	434
2fe373ce	435	}
308957f5	436
2fe373ce	437	}