This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Adapt test.valgrind make target to recent valgrinds (3.x)
[perl5.git] / t / TEST
CommitLineData
8d063cd8
LW
1#!./perl
2
8d063cd8 3# This is written in a peculiar style, since we're trying to avoid
1de9afcd
RGS
4# most of the constructs we'll be testing for. (This comment is
5# probably obsolete on the avoidance side, though still currrent
6# on the peculiarity side.)
8d063cd8 7
a687059c
LW
8$| = 1;
9
80ed0dea
DM
10# for testing TEST only
11#BEGIN { require '../lib/strict.pm'; strict->import() };
12#BEGIN { require '../lib/warnings.pm'; warnings->import() };
13
60e23f2f
MS
14# Let tests know they're running in the perl core. Useful for modules
15# which live dual lives on CPAN.
16$ENV{PERL_CORE} = 1;
17
cc6ae9e5
CB
18# remove empty elements due to insertion of empty symbols via "''p1'" syntax
19@ARGV = grep($_,@ARGV) if $^O eq 'VMS';
551405c4 20our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
cc6ae9e5 21
5d9a6404 22# Cheesy version of Getopt::Std. Maybe we should replace it with that.
80ed0dea
DM
23{
24 my @argv = ();
5d9a6404 25 foreach my $idx (0..$#ARGV) {
b326da91 26 push( @argv, $ARGV[$idx] ), next unless $ARGV[$idx] =~ /^-(\S+)$/;
80ed0dea
DM
27 $::core = 1 if $1 eq 'core';
28 $::verbose = 1 if $1 eq 'v';
29 $::torture = 1 if $1 eq 'torture';
30 $::with_utf8 = 1 if $1 eq 'utf8';
31 $::with_utf16 = 1 if $1 eq 'utf16';
32 $::bytecompile = 1 if $1 eq 'bytecompile';
33 $::compile = 1 if $1 eq 'compile';
34 $::taintwarn = 1 if $1 eq 'taintwarn';
43651d81 35 $ENV{PERL_CORE_MINITEST} = 1 if $1 eq 'minitest';
485988ae 36 if ($1 =~ /^deparse(,.+)?$/) {
80ed0dea
DM
37 $::deparse = 1;
38 $::deparse_opts = $1;
485988ae 39 }
5d9a6404 40 }
80ed0dea 41 @ARGV = @argv;
8d063cd8
LW
42}
43
378cc40b
LW
44chdir 't' if -f 't/TEST';
45
3e6e8be7 46die "You need to run \"make test\" first to set things up.\n"
196918b0 47 unless -e 'perl' or -e 'perl.exe' or -e 'perl.pm';
4633a7c4 48
7a315204 49if ($ENV{PERL_3LOG}) { # Tru64 third(1) tool, see perlhack
09187cb1
JH
50 unless (-x 'perl.third') {
51 unless (-x '../perl.third') {
52 die "You need to run \"make perl.third first.\n";
53 }
54 else {
55 print "Symlinking ../perl.third as perl.third...\n";
56 die "Failed to symlink: $!\n"
57 unless symlink("../perl.third", "perl.third");
58 die "Symlinked but no executable perl.third: $!\n"
59 unless -x 'perl.third';
60 }
61 }
62}
63
3fb91a5e
GS
64# check leakage for embedders
65$ENV{PERL_DESTRUCT_LEVEL} = 2 unless exists $ENV{PERL_DESTRUCT_LEVEL};
66
4633a7c4 67$ENV{EMXSHELL} = 'sh'; # For OS/2
748a9306 68
24c841ba
MS
69# Roll your own File::Find!
70use TestInit;
71use File::Spec;
28ffa55a 72if ($show_elapsed_time) { require Time::HiRes }
24c841ba
MS
73my $curdir = File::Spec->curdir;
74my $updir = File::Spec->updir;
75
76sub _find_tests {
77 my($dir) = @_;
93e325a7 78 opendir DIR, $dir or die "Trouble opening $dir: $!";
a1886d87 79 foreach my $f (sort { $a cmp $b } readdir DIR) {
f458b6e8 80 next if $f eq $curdir or $f eq $updir or
0b834283 81 $f =~ /^(?:CVS|RCS|SCCS|\.svn)$/;
24c841ba 82
f458b6e8 83 my $fullpath = File::Spec->catfile($dir, $f);
24c841ba 84
f458b6e8
MS
85 _find_tests($fullpath) if -d $fullpath;
86 $fullpath = VMS::Filespec::unixify($fullpath) if $^O eq 'VMS';
87 push @ARGV, $fullpath if $f =~ /\.t$/;
24c841ba
MS
88 }
89}
90
cc6ae9e5
CB
91sub _quote_args {
92 my ($args) = @_;
93 my $argstring = '';
94
95 foreach (split(/\s+/,$args)) {
96 # In VMS protect with doublequotes because otherwise
97 # DCL will lowercase -- unless already doublequoted.
98 $_ = q(").$_.q(") if ($^O eq 'VMS') && !/^\"/ && length($_) > 0;
99 $argstring .= ' ' . $_;
100 }
101 return $argstring;
102}
103
6234cb77
NC
104sub _populate_hash {
105 return map {$_, 1} split /\s+/, $_[0];
106}
107
24c841ba 108unless (@ARGV) {
9f3d340b 109 foreach my $dir (qw(base comp cmd run io op uni)) {
f458b6e8 110 _find_tests($dir);
24c841ba 111 }
80ed0dea 112 _find_tests("lib") unless $::core;
6234cb77
NC
113 # Config.pm may be broken for make minitest. And this is only a refinement
114 # for skipping tests on non-default builds, so it is allowed to fail.
115 # What we want to to is make a list of extensions which we did not build.
116 my $configsh = File::Spec->catfile($updir, "config.sh");
117 my %skip;
118 if (-f $configsh) {
119 my (%extensions, %known_extensions);
120 open FH, $configsh or die "Can't open $configsh: $!";
121 while (<FH>) {
122 if (/^extensions=['"](.*)['"]$/) {
123 # Deliberate string interpolation to avoid triggering possible
124 # $1 resetting bugs.
125 %extensions = _populate_hash ("$1");
126 }
127 elsif (/^known_extensions=['"](.*)['"]$/) {
128 %known_extensions = _populate_hash ($1);
129 }
130 }
131 if (%extensions) {
132 if (%known_extensions) {
133 foreach (keys %known_extensions) {
134 $skip{$_}++ unless $extensions{$_};
135 }
136 } else {
137 warn "No known_extensions line found in $configsh";
138 }
139 } else {
140 warn "No extensions line found in $configsh";
141 }
142 }
cc6ae9e5 143 my $mani = File::Spec->catfile($updir, "MANIFEST");
7a315204 144 if (open(MANI, $mani)) {
f458b6e8 145 while (<MANI>) { # similar code in t/harness
6234cb77 146 if (m!^(ext/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) {
80ed0dea
DM
147 my $t = $1;
148 my $extension = $2;
149 if (!$::core || $t =~ m!^lib/[a-z]!)
5a6e071d 150 {
6234cb77
NC
151 if (defined $extension) {
152 $extension =~ s!/t$!!;
153 # XXX Do I want to warn that I'm skipping these?
154 next if $skip{$extension};
155 }
80ed0dea 156 my $path = File::Spec->catfile($updir, $t);
73ddec28 157 push @ARGV, $path;
80ed0dea 158 $::path_to_name{$path} = $t;
5a6e071d 159 }
7a315204
JH
160 }
161 }
35d88760 162 close MANI;
7a315204 163 } else {
f458b6e8 164 warn "$0: cannot open $mani: $!\n";
7a315204 165 }
80ed0dea 166 unless ($::core) {
d44161bf 167 _find_tests('pod');
e018f8be 168 _find_tests('x2p');
80ed0dea 169 _find_tests('japh') if $::torture;
e018f8be 170 }
8d063cd8
LW
171}
172
7a315204 173# Tests known to cause infinite loops for the perlcc tests.
80ed0dea
DM
174# %::infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 );
175%::infinite = ();
6ee623d5 176
80ed0dea 177if ($::deparse) {
f193aa2f
MS
178 _testprogs('deparse', '', @ARGV);
179}
f458b6e8 180elsif( $::compile ) {
1df34986
AE
181 _testprogs('compile', '', @ARGV);
182}
80ed0dea 183elsif( $::bytecompile ) {
1df34986 184 _testprogs('bytecompile', '', @ARGV);
f193aa2f 185}
80ed0dea 186elsif ($::with_utf16) {
1de9afcd
RGS
187 for my $e (0, 1) {
188 for my $b (0, 1) {
189 print STDERR "# ENDIAN $e BOM $b\n";
190 my @UARGV;
191 for my $a (@ARGV) {
192 my $u = $a . "." . ($e ? "l" : "b") . "e" . ($b ? "b" : "");
193 my $f = $e ? "v" : "n";
194 push @UARGV, $u;
195 unlink($u);
196 if (open(A, $a)) {
197 if (open(U, ">$u")) {
90f6ca78 198 print U pack("$f", 0xFEFF) if $b;
1de9afcd
RGS
199 while (<A>) {
200 print U pack("$f*", unpack("C*", $_));
201 }
80ed0dea 202 close(U);
1de9afcd 203 }
80ed0dea 204 close(A);
1de9afcd
RGS
205 }
206 }
207 _testprogs('perl', '', @UARGV);
208 unlink(@UARGV);
209 }
210 }
211}
f193aa2f
MS
212else {
213 _testprogs('compile', '', @ARGV) if -e "../testcompile";
214 _testprogs('perl', '', @ARGV);
485988ae 215}
6ee623d5 216
bb365837 217sub _testprogs {
80ed0dea 218 my ($type, $args, @tests) = @_;
6ee623d5 219
bb365837 220 print <<'EOT' if ($type eq 'compile');
7a315204 221------------------------------------------------------------------------------
6ee623d5 222TESTING COMPILER
7a315204 223------------------------------------------------------------------------------
bb365837
GS
224EOT
225
485988ae 226 print <<'EOT' if ($type eq 'deparse');
7a315204 227------------------------------------------------------------------------------
485988ae 228TESTING DEPARSER
7a315204 229------------------------------------------------------------------------------
485988ae
RH
230EOT
231
566ece03 232 print <<EOT if ($type eq 'bytecompile');
1df34986
AE
233------------------------------------------------------------------------------
234TESTING BYTECODE COMPILER
235------------------------------------------------------------------------------
236EOT
237
595ae481 238 $ENV{PERLCC_TIMEOUT} = 120
f458b6e8 239 if ($type eq 'compile' && !$ENV{PERLCC_TIMEOUT});
ef712cf7 240
80ed0dea 241 $::bad_files = 0;
73ddec28 242
cc6ae9e5 243 foreach my $t (@tests) {
80ed0dea 244 unless (exists $::path_to_name{$t}) {
f458b6e8
MS
245 my $tname = File::Spec->catfile('t',$t);
246 $tname = VMS::Filespec::unixify($tname) if $^O eq 'VMS';
247 $::path_to_name{$t} = $tname;
cc6ae9e5 248 }
73ddec28 249 }
908801fe 250 my $maxlen = 0;
80ed0dea 251 foreach (@::path_to_name{@tests}) {
73ddec28
RB
252 s/\.\w+\z/./;
253 my $len = length ;
254 $maxlen = $len if $len > $maxlen;
088b5126 255 }
908801fe 256 # + 3 : we want three dots between the test name and the "ok"
80ed0dea 257 my $dotdotdot = $maxlen + 3 ;
7a834142 258 my $valgrind = 0;
da51b73c 259 my $valgrind_log = 'current.valgrind';
80ed0dea
DM
260 my $total_files = @tests;
261 my $good_files = 0;
262 my $tested_files = 0;
263 my $totmax = 0;
80ed0dea 264
551405c4 265 while (my $test = shift @tests) {
28ffa55a 266 my $test_start_time = $show_elapsed_time ? Time::HiRes::time() : 0;
bb365837 267
80ed0dea 268 if ( $::infinite{$test} && $type eq 'compile' ) {
595ae481 269 print STDERR "$test creates infinite loop! Skipping.\n";
f458b6e8 270 next;
6ee623d5 271 }
bb365837
GS
272 if ($test =~ /^$/) {
273 next;
6ee623d5 274 }
485988ae
RH
275 if ($type eq 'deparse') {
276 if ($test eq "comp/redef.t") {
277 # Redefinition happens at compile time
278 next;
279 }
7a834142 280 elsif ($test =~ m{lib/Switch/t/}) {
485988ae
RH
281 # B::Deparse doesn't support source filtering
282 next;
283 }
284 }
80ed0dea
DM
285 my $te = $::path_to_name{$test} . '.'
286 x ($dotdotdot - length($::path_to_name{$test}));
cc6ae9e5
CB
287
288 if ($^O ne 'VMS') { # defer printing on VMS due to piping bug
289 print $te;
290 $te = '';
291 }
bb365837 292
80ed0dea
DM
293 # XXX DAPM %OVER not defined anywhere
294 # $test = $OVER{$test} if exists $OVER{$test};
7a315204 295
551405c4 296 open(SCRIPT,"<",$test) or die "Can't run $test.\n";
f458b6e8
MS
297 $_ = <SCRIPT>;
298 close(SCRIPT) unless ($type eq 'deparse');
80ed0dea 299 if ($::with_utf16) {
90f6ca78
RGS
300 $_ =~ tr/\0//d;
301 }
80ed0dea 302 my $switch;
f458b6e8
MS
303 if (/#!.*\bperl.*\s-\w*([tT])/) {
304 $switch = qq{"-$1"};
305 }
306 else {
80ed0dea 307 if ($::taintwarn) {
b26492ee
RGS
308 # not all tests are expected to pass with this option
309 $switch = '"-t"';
310 }
311 else {
312 $switch = '';
313 }
f458b6e8 314 }
6ee623d5 315
f458b6e8 316 my $test_executable; # for 'compile' tests
485988ae
RH
317 my $file_opts = "";
318 if ($type eq 'deparse') {
319 # Look for #line directives which change the filename
320 while (<SCRIPT>) {
321 $file_opts .= ",-f$3$4"
322 if /^#\s*line\s+(\d+)\s+((\w+)|"([^"]+)")/;
323 }
324 close(SCRIPT);
325 }
7a315204 326
80ed0dea 327 my $utf8 = $::with_utf8 ? '-I../lib -Mutf8' : '';
4343e7c3 328 my $testswitch = '-I. -MTestInit'; # -T will strict . from @INC
485988ae 329 if ($type eq 'deparse') {
80ed0dea 330 my $deparse_cmd =
127212b2 331 "./perl $testswitch $switch -I../lib -MO=-qq,Deparse,-sv1.,".
80ed0dea 332 "-l$::deparse_opts$file_opts ".
7a315204
JH
333 "$test > $test.dp ".
334 "&& ./perl $testswitch $switch -I../lib $test.dp |";
80ed0dea
DM
335 open(RESULTS, $deparse_cmd)
336 or print "can't deparse '$deparse_cmd': $!.\n";
485988ae 337 }
1df34986 338 elsif ($type eq 'bytecompile') {
c7e45529 339 my ($pwd, $null);
f458b6e8 340 if( $^O eq 'MSWin32') {
c7e45529
AE
341 $pwd = `cd`;
342 $null = 'nul';
343 } else {
344 $pwd = `pwd`;
345 $null = '/dev/null';
346 }
347 chomp $pwd;
348 my $perl = $ENV{PERL} || "$pwd/perl";
349 my $bswitch = "-MO=Bytecode,-H,-TI,-s$pwd/$test,";
566ece03 350 $bswitch .= "-TF$test.plc,"
1df34986
AE
351 if $test =~ m(chdir|pod/|CGI/t/carp|lib/DB);
352 $bswitch .= "-k,"
353 if $test =~ m(deparse|terse|ext/Storable/t/code);
1df34986
AE
354 $bswitch .= "-b,"
355 if $test =~ m(op/getpid);
80ed0dea 356 my $bytecompile_cmd =
f458b6e8 357 "$perl $testswitch $switch -I../lib $bswitch".
c7e45529 358 "-o$test.plc $test 2>$null &&".
1de9afcd 359 "$perl $testswitch $switch -I../lib $utf8 $test.plc |";
80ed0dea
DM
360 open(RESULTS,$bytecompile_cmd)
361 or print "can't byte-compile '$bytecompile_cmd': $!.\n";
1df34986 362 }
485988ae 363 elsif ($type eq 'perl') {
a7da9a42 364 my $perl = $ENV{PERL} || './perl';
da51b73c 365 my $redir = $^O eq 'VMS' ? '2>&1' : '';
7a834142 366 if ($ENV{PERL_VALGRIND}) {
4f9287d3
NC
367 my $valgrind = $ENV{VALGRIND} // 'valgrind';
368 $perl = "$valgrind --suppressions=perl.supp --leak-check=yes "
369 . "--leak-resolution=high --show-reachable=yes "
d76be4ee 370 . "--num-callers=50 --log-fd=3 $perl";
da51b73c 371 $redir = "3>$valgrind_log";
7a834142 372 }
80ed0dea
DM
373 my $run = "$perl" . _quote_args("$testswitch $switch $utf8")
374 . " $test $redir|";
be24517c 375 open(RESULTS,$run) or print "can't run '$run': $!.\n";
d638aca2
GS
376 }
377 else {
80ed0dea 378 my $compile_cmd;
f458b6e8
MS
379 my $pl2c = "$testswitch -I../lib ../utils/perlcc --testsuite " .
380 # -O9 for good measure, -fcog is broken ATM
381 "$switch -Wb=-O9,-fno-cog -L .. " .
382 "-I \".. ../lib/CORE\" $args $utf8 $test -o ";
383
384 if( $^O eq 'MSWin32' ) {
385 $test_executable = "$test.exe";
386 # hopefully unused name...
387 open HACK, "> xweghyz.pl";
388 print HACK <<EOT;
b326da91
MB
389#!./perl
390
391open HACK, '.\\perl $pl2c $test_executable |';
392# cl.exe prints the name of the .c file on stdout (\%^\$^#)
6d73d07f 393while(<HACK>) {m/^\\w+\\.[cC]\$/ && next;print}
b326da91
MB
394open HACK, '$test_executable |';
395while(<HACK>) {print}
396EOT
f458b6e8
MS
397 close HACK;
398 $compile_cmd = 'xweghyz.pl |';
399 }
400 else {
401 $test_executable = "$test.plc";
402 $compile_cmd
80ed0dea 403 = "./perl $pl2c $test_executable && $test_executable |";
f458b6e8
MS
404 }
405 unlink $test_executable if -f $test_executable;
80ed0dea
DM
406 open(RESULTS, $compile_cmd)
407 or print "can't compile '$compile_cmd': $!.\n";
6ee623d5 408 }
d638aca2 409
f458b6e8
MS
410 my $failure;
411 my $next = 0;
412 my $seen_leader = 0;
413 my $seen_ok = 0;
20f82676 414 my $trailing_leader = 0;
80ed0dea 415 my $max;
43fe0836 416 my %todo;
bb365837 417 while (<RESULTS>) {
cc6ae9e5 418 next if /^\s*$/; # skip blank lines
80ed0dea 419 if ($::verbose) {
bb365837
GS
420 print $_;
421 }
21c74f43 422 unless (/^\#/) {
20f82676
DM
423 if ($trailing_leader) {
424 # shouldn't be anything following a postfix 1..n
a5890677 425 $failure = 'FAILED--extra output after trailing 1..n';
20f82676
DM
426 last;
427 }
809908f7 428 if (/^1\.\.([0-9]+)( todo ([\d ]+))?/) {
20f82676 429 if ($seen_leader) {
a5890677 430 $failure = 'FAILED--seen duplicate leader';
20f82676
DM
431 last;
432 }
bb365837 433 $max = $1;
f458b6e8 434 %todo = map { $_ => 1 } split / /, $3 if $3;
bb365837 435 $totmax += $max;
80ed0dea 436 $tested_files++;
f458b6e8 437 if ($seen_ok) {
20f82676
DM
438 # 1..n appears at end of file
439 $trailing_leader = 1;
440 if ($next != $max) {
a5890677 441 $failure = "FAILED--expected $max tests, saw $next";
20f82676
DM
442 last;
443 }
444 }
445 else {
446 $next = 0;
447 }
f458b6e8 448 $seen_leader = 1;
bb365837
GS
449 }
450 else {
f458b6e8 451 if (/^(not )?ok(?: (\d+))?[^\#]*(\s*\#.*)?/) {
21c74f43
A
452 unless ($seen_leader) {
453 unless ($seen_ok) {
20f82676 454 $next = 0;
21c74f43 455 }
37ce32a7 456 }
21c74f43 457 $seen_ok = 1;
20f82676 458 $next++;
f458b6e8
MS
459 my($not, $num, $extra, $istodo) = ($1, $2, $3, 0);
460 $num = $next unless $num;
461
462 if ($num == $next) {
463
eac7c728
MB
464 # SKIP is essentially the same as TODO for t/TEST
465 # this still conforms to TAP:
466 # http://search.cpan.org/dist/Test-Harness/lib/Test/Harness/TAP.pod
467 $extra and $istodo = $extra =~ /#\s*(?:TODO|SKIP)\b/;
21c74f43
A
468 $istodo = 1 if $todo{$num};
469
470 if( $not && !$istodo ) {
20f82676 471 $failure = "FAILED at test $num";
21c74f43
A
472 last;
473 }
20f82676
DM
474 }
475 else {
f458b6e8 476 $failure ="FAILED--expected test $next, saw test $num";
20f82676 477 last;
37ce32a7 478 }
f458b6e8
MS
479 }
480 elsif (/^Bail out!\s*(.*)/i) { # magic words
481 die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n");
bb365837
GS
482 }
483 else {
dbf51d07
YST
484 # module tests are allowed extra output,
485 # because Test::Harness allows it
486 next if $test =~ /^\W*(ext|lib)\b/;
a5890677 487 $failure = "FAILED--unexpected output at test $next";
20f82676 488 last;
bb365837 489 }
8d063cd8
LW
490 }
491 }
492 }
bb365837 493 close RESULTS;
20f82676
DM
494
495 if (not defined $failure) {
a5890677 496 $failure = 'FAILED--no leader found' unless $seen_leader;
20f82676
DM
497 }
498
7a834142 499 if ($ENV{PERL_VALGRIND}) {
da51b73c
MHM
500 my @valgrind;
501 if (-e $valgrind_log) {
502 if (open(V, $valgrind_log)) {
503 @valgrind = <V>;
504 close V;
505 } else {
506 warn "$0: Failed to open '$valgrind_log': $!\n";
507 }
508 }
7a834142 509 if (@valgrind) {
d44161bf
MHM
510 my $leaks = 0;
511 my $errors = 0;
7a834142
JH
512 for my $i (0..$#valgrind) {
513 local $_ = $valgrind[$i];
d44161bf
MHM
514 if (/^==\d+== ERROR SUMMARY: (\d+) errors? /) {
515 $errors += $1; # there may be multiple error summaries
516 } elsif (/^==\d+== LEAK SUMMARY:/) {
517 for my $off (1 .. 4) {
518 if ($valgrind[$i+$off] =~
519 /(?:lost|reachable):\s+\d+ bytes in (\d+) blocks/) {
520 $leaks += $1;
521 }
522 }
7a834142
JH
523 }
524 }
d44161bf 525 if ($errors or $leaks) {
da51b73c 526 if (rename $valgrind_log, "$test.valgrind") {
d44161bf
MHM
527 $valgrind++;
528 } else {
529 warn "$0: Failed to create '$test.valgrind': $!\n";
7a834142
JH
530 }
531 }
532 } else {
533 warn "No valgrind output?\n";
534 }
da51b73c
MHM
535 if (-e $valgrind_log) {
536 unlink $valgrind_log
537 or warn "$0: Failed to unlink '$valgrind_log': $!\n";
538 }
7a834142 539 }
485988ae
RH
540 if ($type eq 'deparse') {
541 unlink "./$test.dp";
542 }
211f317f
JH
543 if ($ENV{PERL_3LOG}) {
544 my $tpp = $test;
3716a21d 545 $tpp =~ s:^\.\./::;
9c54ecba 546 $tpp =~ s:/:_:g;
3716a21d
JH
547 $tpp =~ s:\.t$:.3log:;
548 rename("perl.3log", $tpp) ||
549 die "rename: perl3.log to $tpp: $!\n";
211f317f 550 }
f458b6e8
MS
551 # test if the compiler compiled something
552 if( $type eq 'compile' && !-e "$test_executable" ) {
553 $failure = "Test did not compile";
554 }
20f82676 555 if (not defined $failure and $next != $max) {
a5890677 556 $failure="FAILED--expected $max tests, saw $next";
20f82676
DM
557 }
558
559 if (defined $failure) {
560 print "${te}$failure\n";
561 $::bad_files++;
562 $_ = $test;
563 if (/^base/) {
564 die "Failed a basic test--cannot continue.\n";
565 }
566 }
567 else {
bb365837 568 if ($max) {
551405c4
AL
569 my $elapsed;
570 if ( $show_elapsed_time ) {
571 $elapsed = sprintf( " %8.0f ms", (Time::HiRes::time() - $test_start_time) * 1000 );
572 }
573 else {
574 $elapsed = "";
575 }
576 print "${te}ok$elapsed\n";
80ed0dea 577 $good_files++;
bb365837
GS
578 }
579 else {
cc6ae9e5 580 print "${te}skipping test on this platform\n";
80ed0dea 581 $tested_files -= 1;
bb365837 582 }
bcce72a7 583 }
551405c4 584 } # while tests
8d063cd8 585
80ed0dea 586 if ($::bad_files == 0) {
20f82676 587 if ($good_files) {
bb365837
GS
588 print "All tests successful.\n";
589 # XXX add mention of 'perlbug -ok' ?
590 }
591 else {
592 die "FAILED--no tests were run for some reason.\n";
593 }
8d063cd8 594 }
bb365837 595 else {
80ed0dea
DM
596 my $pct = $tested_files ? sprintf("%.2f", ($tested_files - $::bad_files) / $tested_files * 100) : "0.00";
597 if ($::bad_files == 1) {
598 warn "Failed 1 test script out of $tested_files, $pct% okay.\n";
bb365837
GS
599 }
600 else {
80ed0dea 601 warn "Failed $::bad_files test scripts out of $tested_files, $pct% okay.\n";
bb365837 602 }
4e4732c1 603 warn <<'SHRDLU_1';
f7d228c6
JH
604### Since not all tests were successful, you may want to run some of
605### them individually and examine any diagnostic messages they produce.
606### See the INSTALL document's section on "make test".
4e4732c1 607SHRDLU_1
80ed0dea 608 warn <<'SHRDLU_2' if $good_files / $total_files > 0.8;
f7d228c6
JH
609### You have a good chance to get more information by running
610### ./perl harness
611### in the 't' directory since most (>=80%) of the tests succeeded.
4e4732c1 612SHRDLU_2
f458b6e8 613 if (eval {require Config; import Config; 1}) {
80ed0dea 614 if ($::Config{usedl} && (my $p = $::Config{ldlibpthname})) {
4e4732c1 615 warn <<SHRDLU_3;
f7d228c6
JH
616### You may have to set your dynamic library search path,
617### $p, to point to the build directory:
4e4732c1 618SHRDLU_3
f458b6e8 619 if (exists $ENV{$p} && $ENV{$p} ne '') {
4e4732c1 620 warn <<SHRDLU_4a;
f7d228c6
JH
621### setenv $p `pwd`:\$$p; cd t; ./perl harness
622### $p=`pwd`:\$$p; export $p; cd t; ./perl harness
623### export $p=`pwd`:\$$p; cd t; ./perl harness
4e4732c1 624SHRDLU_4a
f458b6e8 625 } else {
4e4732c1 626 warn <<SHRDLU_4b;
f7d228c6
JH
627### setenv $p `pwd`; cd t; ./perl harness
628### $p=`pwd`; export $p; cd t; ./perl harness
629### export $p=`pwd`; cd t; ./perl harness
4e4732c1 630SHRDLU_4b
f458b6e8 631 }
4e4732c1 632 warn <<SHRDLU_5;
f7d228c6
JH
633### for csh-style shells, like tcsh; or for traditional/modern
634### Bourne-style shells, like bash, ksh, and zsh, respectively.
4e4732c1 635SHRDLU_5
f458b6e8 636 }
afd33fa9 637 }
bb365837 638 }
80ed0dea 639 my ($user,$sys,$cuser,$csys) = times;
f47304e9 640 print sprintf("u=%.2f s=%.2f cu=%.2f cs=%.2f scripts=%d tests=%d\n",
80ed0dea 641 $user,$sys,$cuser,$csys,$tested_files,$totmax);
7a834142
JH
642 if ($ENV{PERL_VALGRIND}) {
643 my $s = $valgrind == 1 ? '' : 's';
644 print "$valgrind valgrind report$s created.\n", ;
645 }
6ee623d5 646}
80ed0dea 647exit ($::bad_files != 0);