File: run_tests.pl

package info (click to toggle)
makepp 2.0.98.5-2.1
  • links: PTS
  • area: main
  • in suites: bookworm, bullseye
  • size: 2,744 kB
  • sloc: perl: 15,893; makefile: 38; javascript: 25; sh: 1
file content (803 lines) | stat: -rwxr-xr-x 26,002 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
#!/usr/bin/env perl
#
# See bottom of file for documentation.
#

package Mpp;

use Config;
use Cwd;
use File::Path;

# on some (Windowsish) filesystems rmtree may temporarily fail
sub slow_rmtree(@) {
  for my $tree ( grep -d, @_ ) {
    for( 0..9 ) {
      eval { $@ = ''; local $SIG{__WARN__} = sub { die @_ }; rmtree $tree };
      -d $tree or last;
      $_ < 9 and select undef, undef, undef, .1;
    }
    warn $@ if $@;
  }
}


#
# See if this architecture defines the INT signal.
#
my $sigint;
if(defined $Config{sig_name}) {
  my $i=0;
  for(split(' ', $Config{sig_name})) {
    $sigint=$i,last if $_ eq 'INT';
    ++$i;
  }
}

my $archive = $Config{perlpath}; # Temp assignment is work-around for a nasty perl5.8.0 bug
our $source_path;
my $old_cwd;
my $dot;
my $verbose;
my $test;
my $keep;
my $name;
my $perltype;
my $basedir;
my $subdir;
my $dotted;
our $makepp_path;

# Global constants for compile time check.
BEGIN {
  open OSTDOUT, '>&STDOUT' or die $!;
  open OSTDERR, '>&STDERR' or die $!;

  $old_cwd = cwd;		# Remember where we were so we can cd back here.

  if( $0 =~ m@/@ ) {		# Path specified?
    ($source_path = $0) =~ s@/[^/]+$@@; # Get the path to our script.
  } elsif( $ENV{PATH} =~ /[;\\]/ ) { # Find it in Win $PATH:
    foreach (split(/;/, $ENV{PATH}), '.') {
      my $dir = $_ || '.';	# Blank path element is .
      if( -e "$dir\\$0" ) {
	$source_path = $dir;
	last;
      }
    }
  } else {				# Find it in $PATH:
    foreach (split(/:/, $ENV{PATH}), '.') {
      my $dir = $_ || '.';	# Blank path element is .
      if( -x "$dir/$0" ) {
	$source_path = $dir;
	last;
      }
    }
  }
  $source_path or die "$0: something's wrong, can't find path to executable\n";
  $source_path =~ m@^/@ or $source_path = "$old_cwd/$source_path";
				# Make path absolute.
  $source_path =~ s@/(?:\./)+@/@;
  $source_path =~ s@/\.$@@;
  1 while
    ($source_path =~ s@/\.(?=/|$)@@) || # Convert x/./y into x/y.
    ($source_path =~ s@/[^/]+/\.\.(?=/|$)@@); # Convert x/../y into y.

  $makepp_path = $source_path;
  $makepp_path =~ s@/([^/]+)$@/makepp@; # Get the path to the makepp
				# executable, which should always be in the
				# directory above us.

  our $datadir = substr $makepp_path, 0, rindex $makepp_path, '/';
  push @INC, $datadir;
  unless( eval { require Mpp::Text } ) {
    open my $fh, '<', $makepp_path;
    while( <$fh> ) {
      if( /^\$datadir = / ) {
	eval;
	$INC[-1] = $datadir;
	require Mpp::Text;
	last;
      }
      die "Can't locate path to makepp libraries." if $. == 99;
    }
  }

  if( $^O =~ /^MSWin/ && $] < 5.008007 ) { # IDENTICAL AS IN makepp
    # This is a very bad hack!  On earlier Win Active State "lstat 'file'; lstat _ or -l _" is broken.
    my $file = "$datadir/Mpp/File.pm";
    local $_ = "$file.broken";
    unless( -f ) {		# Already converted
      rename $file, $_;
      open my $in, '<', $_;
      open my $out, '>', $file;
      chmod 07777 & (stat)[2], $file;
      while( <$in> ) {
	s/\blstat\b/stat/g;
	s/-l _/0/g;
	print $out $_;
      }
    }
  }

  Mpp::Text::getopts(
    [qw(b basedir), \$basedir, 1],
    [qw(d dots), \$dot],
    [qw(k keep), \$keep],
    [qw(m makepp), \$makepp_path, 1],
    [qw(n name), \$name, 1],
    [qw(s subdir), \$subdir],
    [qw(t test), \$test],
    [qw(v verbose), \$verbose],
    [qr/[h?]/, 'help', undef, 0, sub { print <<EOF; exit }] );
run_tests.pl[ options][ tests]
    -b, --basedir=BASEDIR
	Put tdirs into subdir of given dir, to perform tests elsewhere.
    -d, --dots
	Output only a dot for every successful test.
    -k, --keep
	Keep the tdir even if the test was successful.
    -m, --makepp=PATH_TO_MAKEPP
	Use that makepp, instead of the one above run_tests.pl.
    -n, --name=NAME
	Give this test series a name.
    -s, --subdir
	Put tdirs into a subdir named [BASEDIR/]perlversion[-NAME].
    -t, --test
	Output in format expected by TAP::Harness.
    -v, --verbose
	Give some initial info and final statistics.

    If no tests are given, runs all in the current directory.
EOF

  require Mpp::Utils;
  require Mpp::Cmds;
  for( keys %Mpp::Cmds:: ) {
    if( /^c_/ and my $coderef = *{"Mpp::Cmds::$_"}{CODE} ) {
      *{"Mpp::$_"} = $coderef;
    }
  }

  $perltype =
    $Config{cf_email} =~ /(Active)(?:Perl|State)/ ? $1 :
    $Config{ldflags} =~ /(vanilla|strawberry|chocolate)/i ? ucfirst lc $1 :
    '';

  printf "%s%sPerl V%vd %dbits - %s %s\n",
    $name ? "$name " : '',
    $perltype,
    $^V, $Config{ptrsize} * 8, $^O, $Config{archname}
    if $verbose;

  if( defined $basedir ) {
    substr $basedir, 0, 0, "$old_cwd/" if &is_windows ? $basedir !~ /^(?:[a-z]:)?\//i : $basedir !~ /^\//;
    $basedir .= '/' if $basedir !~ /\/$/
  } else {
    $basedir = "$old_cwd/";
  }
  if( $subdir ) {
    $basedir .= sprintf $Config{ptrsize} == 4 ? 'V%vd' : 'V%vd-%dbits', $^V, $Config{ptrsize} * 8;
    $basedir .= "-$perltype" if $perltype;
    $basedir .= "-$name" if $name;
    slow_rmtree $basedir;
    mkdir $basedir or die "can't mkdir $basedir--$!";
    $basedir .= '/';
  }

  chdir $basedir;
  mkdir 'd';
  my $symlink = (stat 'd')[1] &&	# Do we have inums?
    eval { symlink 'd', 'e' } &&	# Dies on MSWin32.
    (stat _)[1] == (stat 'e')[1];	# MinGW emulates symlink by recursive copy, useless for repository.
  rmdir 'd';
  unlink 'e' or rmdir 'e';
  eval 'sub no_symlink() {' . ($symlink ? '' : 1) . '}';
  open my $fh, '>f';		# Use different filename because rmdir may fail on Win
  close $fh;
  my $link = eval { link 'f', 'g' } &&	# might die somewhere
    ((stat 'f')[1] ?	# Do we have inums?
      (stat _)[1] == (stat 'g')[1] : # vfat emulates link by copy, useless for build_cache.

      (stat _)[3] == 2 && (stat 'g')[3] == 2); # Link count right?
  unlink 'f', 'g';
  eval 'sub no_link() {' . ($link ? '' : 1) . '}';
  chdir $old_cwd;
}

my( $cc_errors, $have_cc, $want_cc ) = 0;
my $cc_hint1 = 'This test needs a C compiler that accepts options in common order.
';
my $cc_hint = $cc_hint1 .
  ($ENV{CC} ? 'Please check your value of $CC' :
   'Old makes use CC=cc, but makepp may choose another compiler in $PATH') . ".\n" .
  ($ENV{CFLAGS} ?
  'Make sure that your CFLAGS are understood by the chosen compiler!
' : '');
sub have_cc() {
  $want_cc = 1;
  unless( defined $have_cc ) {
    $have_cc =
      $ENV{CC} ||
      system( PERL, '-w', $makepp_path.'builtin', 'expr',
	      # Use mpp's CC function without loading full mpp.  No "" because of fucked up Win.
	      'sub Mpp::log($@) {} sub Mpp::Makefile::implicitly_load {} close STDERR; q!not-found! eq Mpp::Subs::f_CC',
	      '-ohave_cc' ) ?
      1 : 0;
  }
  $have_cc;
}


$ENV{PERL} ||= PERL;
#delete $ENV{'MAKEPPFLAGS'};     # These environment variables can possibly
#delete $ENV{'MAKEFLAGS'};       # mess up makepp tests.
# For some reason, with Perl 5.8.4, deleting the environment variables doesn't
# actually remove them from the environment.
$ENV{"${_}FLAGS"} = ''
  for qw(MAKEPP MAKE MAKEPPBUILTIN MAKEPPCLEAN MAKEPPLOG MAKEPPGRAPH);


for( $ENV{PATH} ) {
  my $sep = is_windows > 0 ? ';' : ':';
  s/^\.?$sep+//;			# Make sure we don't rely on current dir in PATH.
  s/$sep+\.?$//;
  s/$sep+\.?$sep+/$sep/;
  $_ = "$source_path$sep$_";
}

#
# Equivalent of system() except that it handles INT signals correctly.
#
# If the first argument is a reference to a string, that is the command to report as failing, if it did fail.
#
sub system_intabort {
  my $cmd = ref( $_[0] ) && shift;
  system @_;
  kill 'INT', $$ if $sigint && $? == $sigint;
  if( $? && $cmd ) {
    if( $? == -1 ) {
      die "failed to execute $$cmd: $!\n"
    } elsif( $? & 127 ) {
      die sprintf "$$cmd died with signal %d%s coredump\n",
	($? & 127),  ($? & 128) ? ' and' : ', no';
    } else {
      die sprintf "$$cmd exited with value %d\n", $? >> 8;
    }
  }
  return $?;
}

my %file;
my $page_break = '';
my $log_count = 1;
sub makepp(@) {
  my $extra = ref $_[0];
  my $suffix = $extra ? ${shift()} : '';
  print $page_break;
  $page_break = "\cL\n";
  if( !$suffix && -f '.makepp/log' ) {
    chdir '.makepp';		# For Win.
    my $save = 'log' . $log_count++;
    print "saved log to $save\n"
      if rename log => $save;
    chdir '..';
  }
  print "makepp$suffix" . (@_ ? " @_\n" : "\n");
  system_intabort \"makepp$suffix", # "
    PERL, '-w', exists $file{'makeppextra.pm'} ? '-Mmakeppextra' : (), $makepp_path.$suffix, @_;
  unless( $extra ) {
    for my $file ( <{*/*/*/,*/*/,*/,}.makepp/*.mk> ) {
      open my( $fh ), $file;
      $file =~ s!\.makepp/(.+)\.mk$!$1!;
      -r $file && !-d _ or next;
      my $binfo = Mpp::File::grok_build_info_file $fh;
      my $sig = join ',', (stat _)[9,7];
      warn "$file $binfo->{SIGNATURE} vs. " . $sig
	if $binfo->{SIGNATURE} ne $sig;
    }
  }
  1;				# Command succeeded.
}

@ARGV or @ARGV = <*.test *.tar *.tar.gz>;
				# Get a list of arguments.

my $n_failures = 0;
my $n_successes = 0;

(my $wts = $0) =~ s/run_tests/wait_timestamp/;
do $wts;			# Preload the function.
eval { require Time::HiRes };	# Preload the library.

# spar <http://www.cpan.org/scripts/> extraction function
# assumes DATA to be opened to the spar
sub un_spar() {
    my( $lines, $kind, $mode, %mode, $atime, $mtime, $name, $nl ) = (-1, 0);
    while( <DATA> ) {
	s/\r?\n$//;		# cross-plattform chomp
	if( $lines >= 0 ) {
	    print F $_, $lines ? "\n" : $nl;
	} elsif( $kind eq 'L' ) {
	    if( $mode eq 'S' ) {
		symlink $_, $name;
	    } else {
		link $_, $name;
	    }
	    $kind = 0;
	} elsif( /^###\t(?!SPAR)/ ) {
	    (undef, $kind, $mode, $atime, $mtime, $name) = split /\t/, $_, 6;
	    if( !$name ) {
	    } elsif( $kind eq 'D' ) {
		$name =~ s!/+$!!;
		-d $name or mkdir $name, 0700 or warn "spar: can't mkdir `$name': $!\n";
		$mode{$name} = [$atime, $mtime, oct $mode];
	    } elsif( $kind ne 'L' ) {
		open F, ">$name" or warn "spar: can't open >`$name': $!\n";
		$lines = abs $kind;
		$nl = ($kind < 0) ? '' : "\n";
	    }
	} elsif( defined $mode ) {
	    warn "spar: $archive:$.: trailing garbage ignored\n";
	}			# else before beginning of spar
    } continue {
	if( !$lines-- ) {
	    close F;
	    chmod oct( $mode ), $name and
		utime $atime, $mtime, $name or
		warn "spar: $archive:$name: Failed to set file attributes: $!\n";
	}
    }

    for( keys %mode ) {
	chmod pop @{$mode{$_}}, $_ and
	    utime @{$mode{$_}}, $_ or
	    warn "spar: $archive:$_: Failed to set directory attributes: $!\n";
    }
}


# With -d report '.' for success, 's' for skipped because of symlink failure,
# 'w' for not applicable on Windows, '-' for otherwise skipped.
sub dot($$;$) {
  if( defined $_[0] ) {
    if( $test ) {
      for( "$_[1]" ) {
	s/^passed // || s/^skipped/# skip/;
	print "ok $test $_";
      }
      $test++;
    } else {
      print $_[$dot ? 0 : 1];
      $dotted = 1 if $dot;
    }
    return;
  } elsif( $test ) {
    print "not ok $test $_[1]";
    $test++;
  } else {
    print "\n" if defined $dotted;
    print "FAILED $_[1]";
    undef $dotted;
  }
  if( $_[2] ) {			# See the error in logs that people send in.
    open my $fh, '>>', $_[2];
    print $fh "\nmakepp: run_tests.pl `FAILED' $_[1]"; # Format that Emacs makes red.
    close $fh;
  }
}


$Mpp::Subs::rule->{MAKEFILE}{PACKAGE} = 'Mpp';
sub do_pl($) {
  my $pl = "$_[0].pl";
  return -1 unless exists $file{$pl};
  $Mpp::Subs::rule->{MAKEFILE}{MAKEFILE} = Mpp::File::file_info $pl;
  $Mpp::Subs::rule->{RULE_SOURCE} = $pl . ':0';
  do $pl;
}


sub n_files(;$$) {
  my( $outf, $code ) = @_;
  open my $logfh, '.makepp/log' or die ".makepp/log--$!\n";
  seek $logfh, -20, 2 if !$code; # More than enough to find last message.
  open my $outfh, '>', $outf if $outf;
  while( <$logfh> ) {
    &$code if $code;
    if( /^[\02\03]?N_FILES\01(\d+)\01(\d+)\01(\d+)\01$/ ) {
      close $logfh;		# Might happen too late for Windows.
      my $ret ="$1 $2 $3\n";
      print $outfh $ret if $outfh;
      return $ret;
    }
  }
  return;
}

my $have_shell = -x '/bin/sh';
our $mod_answer;

print OSTDOUT '1..'.@ARGV."\n" if $test;
test_loop:
foreach $archive (@ARGV) {
  $want_cc = 0;
  undef $mod_answer;
  %file = ();
  my $testname = $archive;
  my( $tarcmd, $dirtest, $warned, $tdir, $tdir_failed, $log );
  $SIG{__WARN__} = sub {
    warn defined $dotted ? "\n" : '',
      $warned ? '' : "$testname: warning: ",
      $_[0];
    undef $dotted if -t STDERR;	# -t workaround for MSWin
    $warned = 1;
  };
  if( -d $archive ) {
    $tdir = $archive;
    substr $tdir, 0, 0, "$old_cwd/" if is_windows ? $tdir !~ /^(?:[a-z]:)?\// : $tdir !~ /^\//;
    ($log = $tdir) =~ s!/*$!.log!;
    chdir $tdir;
    $dirtest = 1;
  } else {
    $testname =~ s/\..*$//; # Test name is tar file name w/o extension.
    if( is_windows && $testname =~ /_unix/ ) {
				# Skip things that will cause errors on Cygwin.
				# E.g., the test for file names with special
				# characters doesn't work under NT!
      dot w => "skipped $testname on Windows\n";
      next;
    }
    if( no_symlink && $testname =~ /repository|symlink/ ) {
      dot s => "skipped $testname because symbolic links do not work\n";
      next;
    }
    if( no_link && $testname =~ /build_cache/ ) {
      dot l => "skipped $testname because links do not work\n";
      next;
    }
    if ($archive !~ /^\//) {	# Not an absolute path to tar file?
      $archive = "$old_cwd/$archive"; # Make it absolute, because we're going
    }				# to cd below.

    if ($testname =~ /\.gz$/) { # Compressed tar file?
      $tarcmd = "gzip -dc $archive | tar xf -";
    }
    elsif ($testname =~ /\.bz2$/) { # Tar file compressed harder?
      $tarcmd = "bzip2 -dc $archive | tar xf -";
    }
    ($tdir = "$testname.tdir") =~ s!.*/!!;
    substr $tdir, 0, 0, $basedir;
    $log = substr( $tdir, 0, -4 ) . 'log';
    $tdir_failed = substr( $tdir, 0, -4 ) . 'failed';
    slow_rmtree $tdir, $tdir_failed;
    mkdir $tdir, 0755 or die "$0: can't make directory $tdir--$!\n";
				# Make a directory.
    chdir $tdir or die "$0: can't cd into tdir--$!\n";
  }

  eval {
    local $SIG{ALRM} = sub { die "timed out\n" };
    eval { alarm( $ENV{MAKEPP_TEST_TIMEOUT} || 600 ) }; # Dies in Win Active State 5.6
    if( $tarcmd ) {
      system_intabort $tarcmd and # Extract the tar file.
	die "$0: can't extract testfile $archive\n";
    } elsif( !$dirtest ) {
      open DATA, $archive or die "$0: can't open $archive--$!\n";
      eval { local $SIG{__WARN__} = sub { die @_ if $_[0] !~ /Failed to set/ }; un_spar };
				# Alas happens a lot on native Windows.
      die +(is_windows && $@ =~ /symlink .* unimplemented/) ? "skipped s\n" :
	$@ =~ /: can't open >`/ ? "skipped\n" : $@
      	if $@;
    }
    open STDOUT, '>', $log or die "write $log: $!";
    open STDERR, '>&STDOUT' or die $!;
    open my $fh, '>>.makepprc';	# Don't let tests be confused by a user's file further up.
    close $fh;
    # check for all special files in one go:
    @file{<{is_relevant.pl,makepp_test_script.pl,makepp_test_script,cleanup_script.pl,makeppextra.pm,hint}*>} = ();

    eval {
      die "skipped x\n" if exists $file{makepp_test_script} && !$have_shell;

      do_pl 'is_relevant' or die "skipped r\n";

      $page_break = '';
      $log_count = 1;
      if( exists $file{'makepp_test_script.pl'} ) {
	local %ENV = %ENV;	# some test wrappers change it.
	do_pl 'makepp_test_script' or
	  die 'makepp_test_script.pl ' . ($@ ? "died: $@" : "returned false\n");
      } elsif( exists $file{'makepp_test_script'} ) {
	system_intabort \'makepp_test_script', './makepp_test_script', $makepp_path;
      } else {
	makepp;
      }
    };
    open STDOUT, '>&OSTDOUT' or die $!;
    open STDERR, '>&OSTDERR' or die $!;
    die $@ if $@;

#
# Now look at all the final targets:
#
    my @errors;
    {
      local $/;			# Slurp in the whole file at once.
      for my $name ( <answers/{*/*/*/,*/*/,*/,}*> ) {
	next if $name =~ /\/n_files$/ # Skip the special file.
	  or -d $name;		# Skip subdirectories.
	open TFILE, '<:crlf', $name or die "$0: can't open $tdir/$name--$!\n";
	$tfile_contents = <TFILE>; # Read in the whole thing.

	# Get the name of the actual file.
	$name =~ s!answers/!!;
	open TFILE, '<:crlf', $name or die "$0: can't open $tdir/$name--$!\n";
	my $mtfile_contents = <TFILE>; # Read in the whole file.
	&$mod_answer( $name, $mtfile_contents, $tfile_contents ) if $mod_answer;
	$mtfile_contents eq $tfile_contents
	  or push @errors, $name;
      }
    }
    close TFILE;

#
# See if the correct number of files were built:
#
    if( !defined( my $n_files_updated = n_files )) {
      push @errors, '.makepp/log';
    } elsif( open my $n_files, 'answers/n_files' ) { # Count of # of files updated?
      $_ = <$n_files>;
      &$mod_answer( 'n_files', $n_files_updated, $_ ) if $mod_answer;
      $_ eq $n_files_updated
	or push @errors, 'n_files';
    }

#
# Also search through the log file to make sure there are no Perl messages
# like "uninitialized value" or something like that.
#
    if( open my $logfile, $log ) {
      while( <$logfile> ) {
	# Have to control a few warnings before we can unleash this:
	#/makepp: warning/
	if( /at (\S+) line \d+/ && $1 !~ /[Mm]akep*file$|\.mk$/ || /(?:internal|generated) error/ ) {
	  push @errors, $log;
	  last;
	}
      }
    }
    eval { alarm 0 };
    die 'wrong file' . (@errors > 1 ? 's' : '') . ': ' . join( ', ', @errors) . "\n" if @errors;
  };

  if( $@ ) {
# Get rid of the log file so we don't get confused if the next test doesn't
# make a log file for some reason.  For a failed test it remains, hence the name.
    rename '.makepp/log' => '.makepp/log.failed';

    if ($@ =~ /skipped(?: (.))?/) {	# Skip this test?
      chop( my $loc = $@ );
      dot $1 || '-', "$loc $testname\n";
      if( !$dirtest ) {
	do_pl 'cleanup_script';
	chdir $old_cwd;		# Get back to the old directory.
	slow_rmtree $tdir;	# Get rid of the test directory.
      } else {
	chdir $old_cwd;		# Get back to the old directory.
      }
      next;
    } elsif ($@ =~ /^\S+$/) {	# Just one word?
      my $loc = $@;
      $loc =~ s/\n//;		# Strip off the trailing newline.
      dot undef, "$testname (at $loc)\n", $log;
    } else {
      dot undef, "$testname: $@", $log;
    }
    ++$n_failures;
    close TFILE;		# or Cygwin will hang
    if( exists $file{hint} ) {
      c_sed 'print "\f\n" if $. == 1', 'hint', "-o>>$log";
      c_sed 's/^/\t/', 'hint' unless $test;
    } else {
      if( $want_cc ) {
	c_echo '-n', "\f\n$cc_hint", "-o>>$log";
	unless( $test ) {
	   (my $hint = ++$cc_errors == 1 ? $cc_hint : $cc_hint1) =~ s/^/\t/gm;
	   print $hint;
	}
      }
      if( $testname =~ /(build_cache|repository)/ ) {
	my $hint = "Likely only the useful but not essential $1 feature failed.\n";
	c_echo '-n', "\f\n$hint", "-o>>$log";
	$hint =~ s/^/\t/;
	print $hint unless $test;
      }
    }
    chdir $old_cwd;		# Get back to the old directory.
    rename $tdir => $tdir_failed unless $dirtest;
    last if $testname eq 'aaasimple'; # If this one fails something is very wrong
  } else {
    dot '.', "passed $testname\n";
    $n_successes++;
    if( !$dirtest ) {
      do_pl 'cleanup_script';
      chdir $old_cwd;		# Get back to the old directory.
      slow_rmtree $tdir
	unless $keep;		# Get rid of the test directory.
    } else {
      chdir $old_cwd;		# Get back to the old directory.
    }
  }
}
print "\n" if defined $dotted;
if( $n_failures && $hint ) {
  print "\n";
  my $common = "\nIn the $basedir directory you will find details\nin the <testname>.log files and <testname>.failed directories.\n";
  if( $n_failures > $n_successes ) {
    print $n_successes ? 'Fairly bad failure!' : 'Total failure!',
      $common;
  } else {
    print $n_failures > $n_successes / 2 ? 'Partial failure, but many things work, so makepp might be ok for you...' :
      'Some failures, which possibly all have the same cause -- you are probably ok.',
      $common, <<EOF;
If you are trying to install from a makefile you configured, you need to
touch .test_done
in case you want to ignore the above failures.
EOF
  }
}
printf "%ds real  %.2fs user  %.2fs system  children: %.2fs user  %.2fs system\n", time - $^T, times
  if $verbose;
close OSTDOUT;			# shutup warnings.
close OSTDERR;
exit $n_failures;


=head1 NAME

run_tests.pl -- Run makepp regression tests

=head1 SYNOPSYS

    run_tests.pl[ options] test1.test test2.test ...

If no arguments are specified, defaults to *.test.

=head1 DESCRIPTION

This script runs the specified tests and reports their result.  With the -d
option it only prints a dot for each successful test.  A test that is skipped
for a standard reason outputs a letter instead of a dot.  The letters are B<l>
or B<m> for build cache tests that were skipped because links don't work or
MD5 is not available, B<s> for a repository test skipped because symbolic
links don't work or B<w> for a Unix test skipped because you are on Windows.
An B<x> means the test can't be executed because that would require a Shell.
If the test declares itself to not be relevant, that gives an B<r>.
Other reasons may be output as B<->.

With the -v option it also gives info about the used Perl version and system,
handy when parallely running this on many setups, and the used time for the
runner (and Perl scripts it runs directly) on the one hand and for the makepp
(and shell) child processes on the other hand.

With the -? option help more available options are shown.

A test is stored as a file with an extension of F<.test> (very economic and --
with some care -- editable spar format), or F<.tar>, F<.tar.bz2> or
F<.tar.gz>.

First a directory is created called F<I<testname>.tdir> (called the test directory
below).	 Then we cd to the directory, then extract the contents of the
tar file.  This means that the tar file ought to contain top-level
files, i.e., it should contain F<./Makeppfile>, not F<I<testname>.tdir/Makeppfile>.

A test may also be the name of an existing directory.  In that case, no
archive is unpacked and no cleanup is performed after the test.

The following files within this directory are important:

=over 4

=item is_relevant.pl

If this file exists, it should be a Perl script which return trueq if this test
is relevant on this platform, and dies or false if the test is not relevant.

The first argument to this script is the full path of the makepp executable we
are testing.  The second argument is the current platform as seen by Perl.
The environment variable C<PERL> is the path to the perl executable we are
supposed to use (which is not necessarily the one in the path).

=item makepp_test_script.pl / makepp_test_script

If this file exists, it should be a Perl script or shell script which runs
makepp after setting up whatever is necessary.  If this script dies or returns
false (!= 0 for shell), then the test fails.

In a Perl script you can use the predefined function makepp() to run it with
the correct path and wanted interpreter.  It will die if makepp fails.  You
can also use the function wait_timestamp( file ... ), which will wait for both
the local clock and the timestamp of newly created files to be at least a
second later than the newest given file.  You also have the function n_files,
the first optional argument being a file name, where to write the count of
built files, the second a sub that gets called for each log line so you can
scan for messages.  File::Copy's cp is also provided.

The first argument to this shell script is the full path of the makepp
executable we are testing.  The environment variable C<PERL> is the path
to the perl executable we are supposed to use (which is not necessarily
the one in the path).

This script must be sufficiently generic to work in all test
environments.  For example:

=over 4

=item *

It must not assume that perl is in the path.  Always use PERL or $PERL instead.

=item *

It must work with the Bourne shell, i.e., it may contain no bash
extensions.

=item *

It must not use "echo -n" because that doesn't work on HP machines.  But you
should use &echo and other builtins for efficiency anyway.

=back

If this file does not exist, then we simply execute the command
S<C<$PERL makepp>>, so makepp builds all the default targets in the makefile.

If you use the C<.pl> variant, you can set C<$Mpp::mod_answer> to a hook which
will get called for each answer file, with the filename, the generated content
and the expected answer.  The hook can then modify either of the last two
arguments, to make them fit, e.g. on Windows where an extra phony target gets
counted for each compilation.

=item makeppextra.pm

If present this module is loaded into perl before the script by the makepp
function.  See F<additional_tests/2003_11_14_timestamp_md5.test> for an
example of output redirection.

=item F<Makefile> or F<Makeppfile>

Obviously this is kind of important.

=item F<hint>

Suggestions about what might be wrong if this test fails.

=item answers

This directory says what the result should be after running the test.
Each file in the answers directory, or any of its subdirectories, is
compared to a file of the same name in the test directory (or its
corresponding subdirectory).  The files must be exactly identical or the
test fails.

Files in the main test directory do not have to exist in the F<answers>
subdirectory; if not, their contents are not compared.

There is one special file in the F<answers> subdirectory: the file
F<answers/n_files> should contain three integers in ASCII format which are the
number of files that makepp ought to build, phony targets and that are
expected to have failed.  This is compared to the corresponding number of
files that it actually built, extracted from the logfile F<.makepp/log>.

=item cleanup_script.pl

If this file exists, it should be a Perl script that is executed when the test
is done.  This script is executed just before the test directory is deleted.
No cleanup script is necessary if the test directory and all the byproducts of
the test can be deleted with just C<unlink> and C<rmdir>.  (This is usually
the case, so most tests don't include a cleanup script.)

=back

=cut