3 # This is written in a peculiar style, since we're trying to avoid
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.)
10 # Let tests know they're running in the perl core. Useful for modules
11 # which live dual lives on CPAN.
14 # remove empty elements due to insertion of empty symbols via "''p1'" syntax
15 @ARGV = grep($_,@ARGV) if $^O eq 'VMS';
17 # Cheesy version of Getopt::Std. Maybe we should replace it with that.
20 foreach my $idx (0..$#ARGV) {
21 push( @argv, $ARGV[$idx] ), next unless $ARGV[$idx] =~ /^-(\S+)$/;
22 $core = 1 if $1 eq 'core';
23 $verbose = 1 if $1 eq 'v';
24 $torture = 1 if $1 eq 'torture';
25 $with_utf8 = 1 if $1 eq 'utf8';
26 $with_utf16 = 1 if $1 eq 'utf16';
27 $bytecompile = 1 if $1 eq 'bytecompile';
28 $compile = 1 if $1 eq 'compile';
29 $taintwarn = 1 if $1 eq 'taintwarn';
30 $ENV{PERL_CORE_MINITEST} = 1 if $1 eq 'minitest';
31 if ($1 =~ /^deparse(,.+)?$/) {
39 chdir 't' if -f 't/TEST';
41 die "You need to run \"make test\" first to set things up.\n"
42 unless -e 'perl' or -e 'perl.exe' or -e 'perl.pm';
44 if ($ENV{PERL_3LOG}) { # Tru64 third(1) tool, see perlhack
45 unless (-x 'perl.third') {
46 unless (-x '../perl.third') {
47 die "You need to run \"make perl.third first.\n";
50 print "Symlinking ../perl.third as perl.third...\n";
51 die "Failed to symlink: $!\n"
52 unless symlink("../perl.third", "perl.third");
53 die "Symlinked but no executable perl.third: $!\n"
54 unless -x 'perl.third';
59 # check leakage for embedders
60 $ENV{PERL_DESTRUCT_LEVEL} = 2 unless exists $ENV{PERL_DESTRUCT_LEVEL};
62 $ENV{EMXSHELL} = 'sh'; # For OS/2
64 # Roll your own File::Find!
67 my $curdir = File::Spec->curdir;
68 my $updir = File::Spec->updir;
72 opendir DIR, $dir or die "Trouble opening $dir: $!";
73 foreach my $f (sort { $a cmp $b } readdir DIR) {
74 next if $f eq $curdir or $f eq $updir or
75 $f =~ /^(?:CVS|RCS|SCCS|\.svn)$/;
77 my $fullpath = File::Spec->catfile($dir, $f);
79 _find_tests($fullpath) if -d $fullpath;
80 $fullpath = VMS::Filespec::unixify($fullpath) if $^O eq 'VMS';
81 push @ARGV, $fullpath if $f =~ /\.t$/;
89 foreach (split(/\s+/,$args)) {
90 # In VMS protect with doublequotes because otherwise
91 # DCL will lowercase -- unless already doublequoted.
92 $_ = q(").$_.q(") if ($^O eq 'VMS') && !/^\"/ && length($_) > 0;
93 $argstring .= ' ' . $_;
99 foreach my $dir (qw(base comp cmd run io op uni)) {
102 _find_tests("lib") unless $core;
103 my $mani = File::Spec->catfile($updir, "MANIFEST");
104 if (open(MANI, $mani)) {
105 while (<MANI>) { # similar code in t/harness
106 if (m!^(ext/\S+/?(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) {
108 if (!$core || $t =~ m!^lib/[a-z]!)
110 $path = File::Spec->catfile($updir, $t);
118 warn "$0: cannot open $mani: $!\n";
123 _find_tests('japh') if $torture;
127 # Tests known to cause infinite loops for the perlcc tests.
128 # %infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 );
132 _testprogs('deparse', '', @ARGV);
135 _testprogs('compile', '', @ARGV);
137 elsif( $bytecompile ) {
138 _testprogs('bytecompile', '', @ARGV);
140 elsif ($with_utf16) {
143 print STDERR "# ENDIAN $e BOM $b\n";
146 my $u = $a . "." . ($e ? "l" : "b") . "e" . ($b ? "b" : "");
147 my $f = $e ? "v" : "n";
151 if (open(U, ">$u")) {
152 print U pack("$f", 0xFEFF) if $b;
154 print U pack("$f*", unpack("C*", $_));
161 _testprogs('perl', '', @UARGV);
167 _testprogs('compile', '', @ARGV) if -e "../testcompile";
168 _testprogs('perl', '', @ARGV);
176 print <<'EOT' if ($type eq 'compile');
177 ------------------------------------------------------------------------------
179 ------------------------------------------------------------------------------
182 print <<'EOT' if ($type eq 'deparse');
183 ------------------------------------------------------------------------------
185 ------------------------------------------------------------------------------
188 print <<EOT if ($type eq 'bytecompile');
189 ------------------------------------------------------------------------------
190 TESTING BYTECODE COMPILER
191 ------------------------------------------------------------------------------
194 $ENV{PERLCC_TIMEOUT} = 120
195 if ($type eq 'compile' && !$ENV{PERLCC_TIMEOUT});
203 foreach my $t (@tests) {
204 unless (exists $name{$t}) {
205 my $tname = File::Spec->catfile('t',$t);
206 $tname = VMS::Filespec::unixify($tname) if $^O eq 'VMS';
211 foreach (@name{@tests}) {
214 $maxlen = $len if $len > $maxlen;
216 # + 3 : we want three dots between the test name and the "ok"
217 $dotdotdot = $maxlen + 3 ;
219 my $valgrind_log = 'current.valgrind';
220 while ($test = shift @tests) {
222 if ( $infinite{$test} && $type eq 'compile' ) {
223 print STDERR "$test creates infinite loop! Skipping.\n";
229 if ($type eq 'deparse') {
230 if ($test eq "comp/redef.t") {
231 # Redefinition happens at compile time
234 elsif ($test =~ m{lib/Switch/t/}) {
235 # B::Deparse doesn't support source filtering
239 $te = $name{$test} . '.' x ($dotdotdot - length($name{$test}));
241 if ($^O ne 'VMS') { # defer printing on VMS due to piping bug
246 $test = $OVER{$test} if exists $OVER{$test};
248 open(SCRIPT,"<$test") or die "Can't run $test.\n";
250 close(SCRIPT) unless ($type eq 'deparse');
254 if (/#!.*\bperl.*\s-\w*([tT])/) {
259 # not all tests are expected to pass with this option
267 my $test_executable; # for 'compile' tests
269 if ($type eq 'deparse') {
270 # Look for #line directives which change the filename
272 $file_opts .= ",-f$3$4"
273 if /^#\s*line\s+(\d+)\s+((\w+)|"([^"]+)")/;
278 my $utf8 = $with_utf8 ? '-I../lib -Mutf8' : '';
279 my $testswitch = '-I. -MTestInit'; # -T will strict . from @INC
280 if ($type eq 'deparse') {
282 "./perl $testswitch $switch -I../lib -MO=-qq,Deparse,-sv1.,".
283 "-l$deparse_opts$file_opts ".
285 "&& ./perl $testswitch $switch -I../lib $test.dp |";
286 open(RESULTS, $deparse)
287 or print "can't deparse '$deparse': $!.\n";
289 elsif ($type eq 'bytecompile') {
291 if( $^O eq 'MSWin32') {
299 my $perl = $ENV{PERL} || "$pwd/perl";
300 my $bswitch = "-MO=Bytecode,-H,-TI,-s$pwd/$test,";
301 $bswitch .= "-TF$test.plc,"
302 if $test =~ m(chdir|pod/|CGI/t/carp|lib/DB);
304 if $test =~ m(deparse|terse|ext/Storable/t/code);
306 if $test =~ m(op/getpid);
308 "$perl $testswitch $switch -I../lib $bswitch".
309 "-o$test.plc $test 2>$null &&".
310 "$perl $testswitch $switch -I../lib $utf8 $test.plc |";
311 open(RESULTS,$bytecompile)
312 or print "can't byte-compile '$bytecompile': $!.\n";
314 elsif ($type eq 'perl') {
315 my $perl = $ENV{PERL} || './perl';
316 my $redir = $^O eq 'VMS' ? '2>&1' : '';
317 if ($ENV{PERL_VALGRIND}) {
318 $perl = "valgrind --suppressions=perl.supp --leak-check=yes "
319 . "--leak-resolution=high --show-reachable=yes "
320 . "--num-callers=50 --logfile-fd=3 $perl";
321 $redir = "3>$valgrind_log";
323 my $run = "$perl" . _quote_args("$testswitch $switch $utf8") . " $test $redir|";
324 open(RESULTS,$run) or print "can't run '$run': $!.\n";
328 my $pl2c = "$testswitch -I../lib ../utils/perlcc --testsuite " .
329 # -O9 for good measure, -fcog is broken ATM
330 "$switch -Wb=-O9,-fno-cog -L .. " .
331 "-I \".. ../lib/CORE\" $args $utf8 $test -o ";
333 if( $^O eq 'MSWin32' ) {
334 $test_executable = "$test.exe";
335 # hopefully unused name...
336 open HACK, "> xweghyz.pl";
340 open HACK, '.\\perl $pl2c $test_executable |';
341 # cl.exe prints the name of the .c file on stdout (\%^\$^#)
342 while(<HACK>) {m/^\\w+\\.[cC]\$/ && next;print}
343 open HACK, '$test_executable |';
344 while(<HACK>) {print}
347 $compile = 'xweghyz.pl |';
350 $test_executable = "$test.plc";
351 $compile = "./perl $pl2c $test_executable && $test_executable |";
353 unlink $test_executable if -f $test_executable;
354 open(RESULTS, $compile)
355 or print "can't compile '$compile': $!.\n";
363 next if /^\s*$/; # skip blank lines
368 if (/^1\.\.([0-9]+)( todo ([\d ]+))?/) {
370 %todo = map { $_ => 1 } split / /, $3 if $3;
380 if (/^(not )?ok (\d+)[^\#]*(\s*\#.*)?/) {
381 unless ($seen_leader) {
389 my($not, $num, $extra) = ($1, $2, $3);
390 my($istodo) = $extra =~ /#\s*TODO/ if $extra;
391 $istodo = 1 if $todo{$num};
393 if( $not && !$istodo ) {
403 elsif (/^Bail out!\s*(.*)/i) { # magic words
404 die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n");
413 if ($ENV{PERL_VALGRIND}) {
415 if (-e $valgrind_log) {
416 if (open(V, $valgrind_log)) {
420 warn "$0: Failed to open '$valgrind_log': $!\n";
426 for my $i (0..$#valgrind) {
427 local $_ = $valgrind[$i];
428 if (/^==\d+== ERROR SUMMARY: (\d+) errors? /) {
429 $errors += $1; # there may be multiple error summaries
430 } elsif (/^==\d+== LEAK SUMMARY:/) {
431 for my $off (1 .. 4) {
432 if ($valgrind[$i+$off] =~
433 /(?:lost|reachable):\s+\d+ bytes in (\d+) blocks/) {
439 if ($errors or $leaks) {
440 if (rename $valgrind_log, "$test.valgrind") {
443 warn "$0: Failed to create '$test.valgrind': $!\n";
447 warn "No valgrind output?\n";
449 if (-e $valgrind_log) {
451 or warn "$0: Failed to unlink '$valgrind_log': $!\n";
454 if ($type eq 'deparse') {
457 if ($ENV{PERL_3LOG}) {
461 $tpp =~ s:\.t$:.3log:;
462 rename("perl.3log", $tpp) ||
463 die "rename: perl3.log to $tpp: $!\n";
466 # test if the compiler compiled something
467 if( $type eq 'compile' && !-e "$test_executable" ) {
469 print "Test did not compile\n";
471 if ($ok && $next == $max ) {
477 print "${te}skipping test on this platform\n";
484 print "${te}FAILED at test $next\tpossibly due to extra output\n";
487 print "${te}FAILED at test $next\n";
492 die "Failed a basic test--cannot continue.\n";
499 print "All tests successful.\n";
500 # XXX add mention of 'perlbug -ok' ?
503 die "FAILED--no tests were run for some reason.\n";
507 $pct = $files ? sprintf("%.2f", ($files - $bad) / $files * 100) : "0.00";
509 warn "Failed 1 test script out of $files, $pct% okay.\n";
512 warn "Failed $bad test scripts out of $files, $pct% okay.\n";
515 ### Since not all tests were successful, you may want to run some of
516 ### them individually and examine any diagnostic messages they produce.
517 ### See the INSTALL document's section on "make test".
519 warn <<'SHRDLU_2' if $good / $total > 0.8;
520 ### You have a good chance to get more information by running
522 ### in the 't' directory since most (>=80%) of the tests succeeded.
524 if (eval {require Config; import Config; 1}) {
525 if ($Config{usedl} && (my $p = $Config{ldlibpthname})) {
527 ### You may have to set your dynamic library search path,
528 ### $p, to point to the build directory:
530 if (exists $ENV{$p} && $ENV{$p} ne '') {
532 ### setenv $p `pwd`:\$$p; cd t; ./perl harness
533 ### $p=`pwd`:\$$p; export $p; cd t; ./perl harness
534 ### export $p=`pwd`:\$$p; cd t; ./perl harness
538 ### setenv $p `pwd`; cd t; ./perl harness
539 ### $p=`pwd`; export $p; cd t; ./perl harness
540 ### export $p=`pwd`; cd t; ./perl harness
544 ### for csh-style shells, like tcsh; or for traditional/modern
545 ### Bourne-style shells, like bash, ksh, and zsh, respectively.
550 ($user,$sys,$cuser,$csys) = times;
551 print sprintf("u=%g s=%g cu=%g cs=%g scripts=%d tests=%d\n",
552 $user,$sys,$cuser,$csys,$files,$totmax);
553 if ($ENV{PERL_VALGRIND}) {
554 my $s = $valgrind == 1 ? '' : 's';
555 print "$valgrind valgrind report$s created.\n", ;