# Written 91-12-02 through 92-01-01 by Stephen McGee.
# Modified 92-02-11 through 92-02-22 by Chris Arthur to further generalize.
#
-# Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-# 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software
-# Foundation, Inc.
+# Copyright (C) 1991-2013 Free Software Foundation, Inc.
# This file is part of GNU Make.
#
# GNU Make is free software; you can redistribute it and/or modify it under
# this routine controls the whole mess; each test suite sets up a few
# variables and then calls &toplevel, which does all the real work.
-# $Id: test_driver.pl,v 1.30 2010/07/28 05:39:50 psmith Exp $
+# $Id$
# The number of test categories we've run
foreach (# UNIX-specific things
'TZ', 'TMPDIR', 'HOME', 'USER', 'LOGNAME', 'PATH',
+ 'LD_LIBRARY_PATH',
# Purify things
'PURIFYOPTIONS',
# Windows NT-specific stuff
&parse_command_line (@ARGV);
- print "OS name = `$osname'\n" if $debug;
+ print "OS name = '$osname'\n" if $debug;
$workpath = "$cwdslash$workdir";
$scriptpath = "$cwdslash$scriptdir";
$dir = $1;
push (@rmdirs, $dir);
-d "$workpath/$dir"
- || mkdir ("$workpath/$dir", 0777)
+ || mkdir ("$workpath/$dir", 0777)
|| &error ("Couldn't mkdir $workpath/$dir: $!\n");
}
}
{
print "Finding tests...\n";
opendir (SCRIPTDIR, $scriptpath)
- || &error ("Couldn't opendir $scriptpath: $!\n");
+ || &error ("Couldn't opendir $scriptpath: $!\n");
@dirs = grep (!/^(\..*|CVS|RCS)$/, readdir (SCRIPTDIR) );
closedir (SCRIPTDIR);
foreach $dir (@dirs)
mkdir ("$workpath/$dir", 0777)
|| &error ("Couldn't mkdir $workpath/$dir: $!\n");
opendir (SCRIPTDIR, "$scriptpath/$dir")
- || &error ("Couldn't opendir $scriptpath/$dir: $!\n");
+ || &error ("Couldn't opendir $scriptpath/$dir: $!\n");
@files = grep (!/^(\..*|CVS|RCS|.*~)$/, readdir (SCRIPTDIR) );
closedir (SCRIPTDIR);
foreach $test (@files)
{
-d $test and next;
- push (@TESTS, "$dir/$test");
+ push (@TESTS, "$dir/$test");
}
}
}
print "\n";
- &run_each_test;
+ run_all_tests();
foreach $dir (@rmdirs)
{
print "s" unless $total_tests_failed == 1;
print " in $categories_failed Categor";
print ($categories_failed == 1 ? "y" : "ies");
- print " Failed (See .$diffext files in $workdir dir for details) :-(\n\n";
+ print " Failed (See .$diffext* files in $workdir dir for details) :-(\n\n";
return 0;
}
else
eval "chop (\$osname = `sh -c 'uname -nmsr 2>&1'`)";
if ($osname =~ /not found/i)
{
- $osname = "(something posixy with no uname)";
+ $osname = "(something posixy with no uname)";
}
elsif ($@ ne "" || $?)
{
eval "chop (\$osname = `sh -c 'uname -a 2>&1'`)";
if ($@ ne "" || $?)
{
- $osname = "(something posixy)";
- }
+ $osname = "(something posixy)";
+ }
}
$vos = 0;
$pathsep = "/";
print "\n";
}
-sub run_each_test
+sub run_all_tests
{
- $categories_run = 0;
+ $categories_run = 0;
+
+ foreach $testname (sort @TESTS) {
+ $suite_passed = 1; # reset by test on failure
+ $num_of_logfiles = 0;
+ $num_of_tmpfiles = 0;
+ $description = "";
+ $details = "";
+ $old_makefile = undef;
+ $testname =~ s/^$scriptpath$pathsep//;
+ $perl_testname = "$scriptpath$pathsep$testname";
+ $testname =~ s/(\.pl|\.perl)$//;
+ $testpath = "$workpath$pathsep$testname";
+ # Leave enough space in the extensions to append a number, even
+ # though it needs to fit into 8+3 limits.
+ if ($short_filenames) {
+ $logext = 'l';
+ $diffext = 'd';
+ $baseext = 'b';
+ $runext = 'r';
+ $extext = '';
+ } else {
+ $logext = 'log';
+ $diffext = 'diff';
+ $baseext = 'base';
+ $runext = 'run';
+ $extext = '.';
+ }
+ $log_filename = "$testpath.$logext";
+ $diff_filename = "$testpath.$diffext";
+ $base_filename = "$testpath.$baseext";
+ $run_filename = "$testpath.$runext";
+ $tmp_filename = "$testpath.$tmpfilesuffix";
- foreach $testname (sort @TESTS)
- {
- ++$categories_run;
- $suite_passed = 1; # reset by test on failure
- $num_of_logfiles = 0;
- $num_of_tmpfiles = 0;
- $description = "";
- $details = "";
- $old_makefile = undef;
- $testname =~ s/^$scriptpath$pathsep//;
- $perl_testname = "$scriptpath$pathsep$testname";
- $testname =~ s/(\.pl|\.perl)$//;
- $testpath = "$workpath$pathsep$testname";
- # Leave enough space in the extensions to append a number, even
- # though it needs to fit into 8+3 limits.
- if ($short_filenames) {
- $logext = 'l';
- $diffext = 'd';
- $baseext = 'b';
- $runext = 'r';
- $extext = '';
- } else {
- $logext = 'log';
- $diffext = 'diff';
- $baseext = 'base';
- $runext = 'run';
- $extext = '.';
- }
- $log_filename = "$testpath.$logext";
- $diff_filename = "$testpath.$diffext";
- $base_filename = "$testpath.$baseext";
- $run_filename = "$testpath.$runext";
- $tmp_filename = "$testpath.$tmpfilesuffix";
+ setup_for_test();
- &setup_for_test; # suite-defined
+ $output = "........................................................ ";
- $output = "........................................................ ";
+ substr($output,0,length($testname)) = "$testname ";
- substr($output,0,length($testname)) = "$testname ";
+ print $output;
- print $output;
+ $tests_run = 0;
+ $tests_passed = 0;
- # Run the actual test!
- $tests_run = 0;
- $tests_passed = 0;
+ # Run the test!
+ $code = do $perl_testname;
- $code = do $perl_testname;
+ ++$categories_run;
+ $total_tests_run += $tests_run;
+ $total_tests_passed += $tests_passed;
- $total_tests_run += $tests_run;
- $total_tests_passed += $tests_passed;
+ # How did it go?
+ if (!defined($code)) {
+ # Failed to parse or called die
+ if (length ($@)) {
+ warn "\n*** Test died ($testname): $@\n";
+ } else {
+ warn "\n*** Couldn't parse $perl_testname\n";
+ }
+ $status = "FAILED ($tests_passed/$tests_run passed)";
+ }
- # How did it go?
- if (!defined($code))
- {
- $suite_passed = 0;
- if (length ($@)) {
- warn "\n*** Test died ($testname): $@\n";
- } else {
- warn "\n*** Couldn't run $perl_testname\n";
- }
- }
- elsif ($code == -1) {
- $suite_passed = 0;
- }
- elsif ($code != 1 && $code != -1) {
- $suite_passed = 0;
- warn "\n*** Test returned $code\n";
- }
+ elsif ($code == -1) {
+ # Skipped... not supported
+ $status = "N/A";
+ --$categories_run;
+ }
- if ($suite_passed) {
- ++$categories_passed;
- $status = "ok ($tests_passed passed)";
- for ($i = $num_of_tmpfiles; $i; $i--)
- {
- &rmfiles ($tmp_filename . &num_suffix ($i) );
- }
+ elsif ($code != 1) {
+ # Bad result... this shouldn't really happen. Usually means that
+ # the suite forgot to end with "1;".
+ warn "\n*** Test returned $code\n";
+ $status = "FAILED ($tests_passed/$tests_run passed)";
+ }
- for ($i = $num_of_logfiles ? $num_of_logfiles : 1; $i; $i--)
- {
- &rmfiles ($log_filename . &num_suffix ($i) );
- &rmfiles ($base_filename . &num_suffix ($i) );
- }
- }
- elsif (!defined $code || $code > 0) {
- $status = "FAILED ($tests_passed/$tests_run passed)";
- }
- elsif ($code < 0) {
- $status = "N/A";
- --$categories_run;
- }
+ elsif ($tests_run == 0) {
+ # Nothing was done!!
+ $status = "FAILED (no tests found!)";
+ }
- # If the verbose option has been specified, then a short description
- # of each test is printed before displaying the results of each test
- # describing WHAT is being tested.
+ elsif ($tests_run > $tests_passed) {
+ # Lose!
+ $status = "FAILED ($tests_passed/$tests_run passed)";
+ }
- if ($verbose)
- {
- if ($detail)
- {
- print "\nWHAT IS BEING TESTED\n";
- print "--------------------";
- }
- print "\n\n$description\n\n";
- }
+ else {
+ # Win!
+ ++$categories_passed;
+ $status = "ok ($tests_passed passed)";
+
+ # Clean up
+ for ($i = $num_of_tmpfiles; $i; $i--) {
+ rmfiles($tmp_filename . num_suffix($i));
+ }
+ for ($i = $num_of_logfiles ? $num_of_logfiles : 1; $i; $i--) {
+ rmfiles($log_filename . num_suffix($i));
+ rmfiles($base_filename . num_suffix($i));
+ }
+ }
- # If the detail option has been specified, then the details of HOW
- # the test is testing what it says it is testing in the verbose output
- # will be displayed here before the results of the test are displayed.
+ # If the verbose option has been specified, then a short description
+ # of each test is printed before displaying the results of each test
+ # describing WHAT is being tested.
- if ($detail)
- {
- print "\nHOW IT IS TESTED\n";
- print "----------------";
- print "\n\n$details\n\n";
- }
+ if ($verbose) {
+ if ($detail) {
+ print "\nWHAT IS BEING TESTED\n";
+ print "--------------------";
+ }
+ print "\n\n$description\n\n";
+ }
- print "$status\n";
- }
+ # If the detail option has been specified, then the details of HOW
+ # the test is testing what it says it is testing in the verbose output
+ # will be displayed here before the results of the test are displayed.
+
+ if ($detail) {
+ print "\nHOW IT IS TESTED\n";
+ print "----------------";
+ print "\n\n$details\n\n";
+ }
+
+ print "$status\n";
+ }
}
# If the keep flag is not set, this subroutine deletes all filenames that
local($answer,$logfile) = @_;
local($slurp, $answer_matched) = ('', 0);
- print "Comparing Output ........ " if $debug;
+ ++$tests_run;
- $slurp = &read_file_into_string ($logfile);
+ if (! defined $answer) {
+ print "Ignoring output ........ " if $debug;
+ $answer_matched = 1;
+ } else {
+ print "Comparing Output ........ " if $debug;
- # For make, get rid of any time skew error before comparing--too bad this
- # has to go into the "generic" driver code :-/
- $slurp =~ s/^.*modification time .*in the future.*\n//gm;
- $slurp =~ s/^.*Clock skew detected.*\n//gm;
+ $slurp = &read_file_into_string ($logfile);
- ++$tests_run;
+ # For make, get rid of any time skew error before comparing--too bad this
+ # has to go into the "generic" driver code :-/
+ $slurp =~ s/^.*modification time .*in the future.*\n//gm;
+ $slurp =~ s/^.*Clock skew detected.*\n//gm;
- if ($slurp eq $answer) {
- $answer_matched = 1;
- } else {
- # See if it is a slash or CRLF problem
- local ($answer_mod, $slurp_mod) = ($answer, $slurp);
+ if ($slurp eq $answer) {
+ $answer_matched = 1;
+ } else {
+ # See if it is a slash or CRLF problem
+ local ($answer_mod, $slurp_mod) = ($answer, $slurp);
- $answer_mod =~ tr,\\,/,;
- $answer_mod =~ s,\r\n,\n,gs;
+ $answer_mod =~ tr,\\,/,;
+ $answer_mod =~ s,\r\n,\n,gs;
- $slurp_mod =~ tr,\\,/,;
- $slurp_mod =~ s,\r\n,\n,gs;
+ $slurp_mod =~ tr,\\,/,;
+ $slurp_mod =~ s,\r\n,\n,gs;
- $answer_matched = ($slurp_mod eq $answer_mod);
+ $answer_matched = ($slurp_mod eq $answer_mod);
- # If it still doesn't match, see if the answer might be a regex.
- if (!$answer_matched && $answer =~ m,^/(.+)/$,) {
- $answer_matched = ($slurp =~ /$1/);
- if (!$answer_matched && $answer_mod =~ m,^/(.+)/$,) {
- $answer_matched = ($slurp_mod =~ /$1/);
+ # If it still doesn't match, see if the answer might be a regex.
+ if (!$answer_matched && $answer =~ m,^/(.+)/$,) {
+ $answer_matched = ($slurp =~ /$1/);
+ if (!$answer_matched && $answer_mod =~ m,^/(.+)/$,) {
+ $answer_matched = ($slurp_mod =~ /$1/);
+ }
+ }
}
- }
}
if ($answer_matched && $test_passed)
local($command) = "diff -c " . &get_basefile . " " . $logfile;
&run_command_with_output(&get_difffile,$command);
- } else {
- &rmfiles ();
}
- $suite_passed = 0;
return 0;
}
return $slurp;
}
+my @OUTSTACK = ();
+my @ERRSTACK = ();
+
sub attach_default_output
{
local ($filename) = @_;
return 1;
}
- open ("SAVEDOS" . $default_output_stack_level . "out", ">&STDOUT")
- || &error ("ado: $! duping STDOUT\n", 1);
- open ("SAVEDOS" . $default_output_stack_level . "err", ">&STDERR")
- || &error ("ado: $! duping STDERR\n", 1);
+ my $dup = undef;
+ open($dup, '>&', STDOUT) or error("ado: $! duping STDOUT\n", 1);
+ push @OUTSTACK, $dup;
- open (STDOUT, "> " . $filename)
- || &error ("ado: $filename: $!\n", 1);
- open (STDERR, ">&STDOUT")
- || &error ("ado: $filename: $!\n", 1);
+ $dup = undef;
+ open($dup, '>&', STDERR) or error("ado: $! duping STDERR\n", 1);
+ push @ERRSTACK, $dup;
- $default_output_stack_level++;
+ open(STDOUT, '>', $filename) or error("ado: $filename: $!\n", 1);
+ open(STDERR, ">&STDOUT") or error("ado: $filename: $!\n", 1);
}
# close the current stdout/stderr, and restore the previous ones from
return 1;
}
- if (--$default_output_stack_level < 0)
- {
- &error ("default output stack has flown under!\n", 1);
- }
-
- close (STDOUT);
- close (STDERR);
+ @OUTSTACK or error("default output stack has flown under!\n", 1);
- open (STDOUT, ">&SAVEDOS" . $default_output_stack_level . "out")
- || &error ("ddo: $! duping STDOUT\n", 1);
- open (STDERR, ">&SAVEDOS" . $default_output_stack_level . "err")
- || &error ("ddo: $! duping STDERR\n", 1);
+ close(STDOUT);
+ close(STDERR);
- close ("SAVEDOS" . $default_output_stack_level . "out")
- || &error ("ddo: $! closing SCSDOSout\n", 1);
- close ("SAVEDOS" . $default_output_stack_level . "err")
- || &error ("ddo: $! closing SAVEDOSerr\n", 1);
+ open (STDOUT, '>&', pop @OUTSTACK) or error("ddo: $! duping STDOUT\n", 1);
+ open (STDERR, '>&', pop @ERRSTACK) or error("ddo: $! duping STDERR\n", 1);
}
# This runs a command without any debugging info.
resetENV();
eval {
- local $SIG{ALRM} = sub { die "timeout\n"; };
+ my $pid = fork();
+ if (! $pid) {
+ exec(@_) or die "Cannot execute $_[0]\n";
+ }
+ local $SIG{ALRM} = sub { my $e = $ERRSTACK[0]; print $e "\nTest timed out after $test_timeout seconds\n"; die "timeout\n"; };
alarm $test_timeout;
- $code = system(@_);
+ waitpid($pid, 0) > 0 or die "No such pid: $pid\n";
+ $code = $?;
alarm 0;
};
if ($@) {
# The eval failed. If it wasn't SIGALRM then die.
- $@ eq "timeout\n" or die;
+ $@ eq "timeout\n" or die "Command failed: $@";
# Timed out. Resend the alarm to our process group to kill the children.
$SIG{ALRM} = 'IGNORE';
print "\nrun_command_with_output($filename,$runname): @_\n" if $debug;
&attach_default_output ($filename);
- my $code = _run_command(@_);
+ my $code = eval { _run_command(@_) };
+ my $err = $@;
&detach_default_output;
+
+ $err and die $err;
+
print "run_command_with_output returned $code.\n" if $debug;
return $code;
foreach $file (@_) {
(open(T, ">> $file") && print(T "\n") && close(T))
- || &error("Couldn't touch $file: $!\n", 1);
+ || &error("Couldn't touch $file: $!\n", 1);
}
}
projects / platform / upstream / make.git / blobdiff