[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';
    }
}

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;

use Test::More;

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

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