test_driver: check for leftover temp files after each test

Reset the temp directory for every test to a local directory, then
after each test see if any new temp files were created and not
deleted: if they were then fail the test.  Rather than delete the
temp files we leave them there and avoid reporting files that were
seen before, so the user can investigate them.

Rewrite the temp_stdin tests to rely on this built-in behavior
rather than implementing the checks directly.

* tests/test_driver.pl: Create a $TEMPDIR variable pointing to a
temporary directory outside the test temp directory.
(toplevel) Before starting any tests create a temp directory and set
the POSIX and Windows temp directory environment variables to use it.
(compare_output) Check the contents of the temp directory.  If any
new files have appeared, fail the test.
* tests/scripts/features/temp_stdin: Remove check_tempfile() and
all users of it, plus setting of temp environment variables.

diff --git a/tests/scripts/features/temp_stdin b/tests/scripts/features/temp_stdin
index af2de2f9d0f0a8917fcd44f8d22675e6db679a38..5b65c51b610002df4a9ad49d49bb42b2d2515b19 100644 (file)
--- a/tests/scripts/features/temp_stdin
+++ b/tests/scripts/features/temp_stdin
@@ -2,16 +2,7 @@
 
 $description = "Test handling of temporary file created from stdin.";
 
-use File::Temp qw /tempdir/;
-
-sub check_tempfile
-{
-    my ($tdir) = @_;
-    my @left = glob $tdir . '/Gm*';
-    scalar @left == 0 && return;
-    my $answer = "temporary file $left[0] is left behind\n";
-    compare_output($answer, &get_logfile(1));
-}
+# These tests rely on the test_driver checking for leftover temporary content
 
 create_file('input.mk', "world:=1\n");
 create_file('bye.mk', "moon:=2\n");
@@ -22,37 +13,26 @@ create_file('bye.mk', "moon:=2\n");
 my @opts = ('-v', '-h', '--nosuchopt');
 my @exit_codes = (0, 0, 512);
 for my $i (0 .. $#opts) {
-    my $tdir = tempdir(CLEANUP => 1);
-    $ENV{'TMPDIR'} = $tdir;
-    $ENV{'TMP'} = $tdir;
     close(STDIN);
     open(STDIN, "<", 'input.mk') || die "$0: cannot open input.mk for reading: $!";
     run_make_test(q!
 all:; $(info hello world)
 !,
                   "$opts[$i] -f-", "/uilt for /", $exit_codes[$i]);
-    check_tempfile($tdir);
 }
 
 # sv 62118,62145.
 # Test that a stdin temp file is removed.
-my $tdir = tempdir(CLEANUP => 1);
-$ENV{'TMPDIR'} = $tdir;
-$ENV{'TMP'} = $tdir;
 close(STDIN);
 open(STDIN, "<", 'input.mk') || die "$0: cannot open input.mk for reading: $!";
 run_make_test(q!
 all:; $(info world=$(world))
 !,
               '-f-', "world=1\n#MAKE#: 'all' is up to date.\n");
-check_tempfile($tdir);
 
 # sv 62118,62145.
 # Test that a stdin temp file is removed, even when make re-execs.
-# Also test that make nohors TMPDIR to create the temp file.
-$tdir = tempdir(CLEANUP => 1);
-$ENV{'TMPDIR'} = $tdir;
-$ENV{'TMP'} = $tdir;
+# Also test that make honors TMPDIR to create the temp file.
 # Ensure touching bye.mk causes re-exec.
 &utouch(-600, 'bye.mk');
 close(STDIN);
@@ -63,20 +43,17 @@ all:; $(info hello)
 $(MAKE_RESTARTS)bye.mk: force; touch $@
 force:
 !,
-              '-R --debug=b -f-', "/Re-executing.+?--temp-stdin=\Q$tdir\E/");
-check_tempfile($tdir);
+              '-R --debug=b -f-', "/Re-executing.+?--temp-stdin=\Q$temppath\E/");
 
 if ($port_type eq 'UNIX') {
 # sv 62118,62145.
 # Test that a stdin temp file is removed, when execvp fails to re-exec make.
 # In order to cause execvp to fail, copy the tested make binary to the temp
 # directory and take away the 'x' bit.
+use File::Spec;
 use File::Copy;
 
-my $tdir = tempdir(CLEANUP => 1);
-$ENV{'TMPDIR'} = $tdir;
-$ENV{'TMP'} = $tdir;
-my $makecopy = "$tdir/make";
+my $makecopy = File::Spec->catfile($TEMPDIR, "make");
 copy("$mkpath", $makecopy);
 # Set file mode bits, because perl copy won't.
 chmod 0750, $makecopy;
@@ -95,7 +72,6 @@ all:; \$(info hello)
 force:
 ",
               "-f-", "touch bye.mk && chmod -x $makecopy\nmake: $makecopy: $ERR_nonexe_file\n", 32512);
-check_tempfile($tdir);
 
 @make_command = @make_orig;
 unlink($makecopy);

diff --git a/tests/test_driver.pl b/tests/test_driver.pl
index b04dadbab698760d6c000dbf6e800dadf1990344..2beb7c99bb4e9f0d4da349d2b99f124a60b0df77 100644 (file)
--- a/tests/test_driver.pl
+++ b/tests/test_driver.pl
@@ -33,6 +33,7 @@
 use Config;
 use Cwd;
 use File::Spec;
+use File::Temp;
 
 # The number of test categories we've run
 $categories_run = 0;
@@ -61,6 +62,10 @@ $test_timeout = 10 if $^O eq 'VMS';
 
 $diff_name = undef;
 
+# Create a temporary directory that tests can use, outside the temp
+# directory that make is using.
+$TEMPDIR = File::Temp->newdir();
+
 # Path to Perl
 $perl_name = $^X;
 if ($^O ne 'VMS') {
@@ -101,7 +106,7 @@ sub which {
 }
 
 # %makeENV is the cleaned-out environment.  Tests must not modify it.
-%makeENV = ();
+my %makeENV = ();
 
 sub vms_get_process_logicals {
   # Sorry for the long note here, but to keep this test running on
@@ -188,6 +193,8 @@ sub cmd2str
 
 sub toplevel
 {
+  %origENV = %ENV unless $^O eq 'VMS';
+
   # Pull in benign variables from the user's environment
 
   foreach (# POSIX-specific things
@@ -213,9 +220,6 @@ sub toplevel
   $makeENV{LANGUAGE} = 'C';
 
   # Replace the environment with the new one
-  #
-  %origENV = %ENV unless $^O eq 'VMS';
-
   resetENV();
 
   $| = 1;                     # unbuffered output
@@ -226,6 +230,7 @@ sub toplevel
   $detail = 0;                # detailed verbosity
   $keep = 0;                  # keep temp files around
   $workdir = "work";          # The directory where the test will start running
+  $tempdir = "_tmp";          # A temporary directory
   $scriptdir = "scripts";     # The directory where we find the test scripts
   $tmpfilesuffix = "t";       # the suffix used on tmpfiles
   $default_output_stack_level = 0;  # used by attach_default_output, etc.
@@ -249,6 +254,23 @@ sub toplevel
 
   print "OS name = '$osname'\n" if $debug;
 
+  $temppath = File::Spec->rel2abs($tempdir);
+
+  if (-d $temppath) {
+    print "Clearing $temppath...\n";
+    &remove_directory_tree("$temppath/")
+      or &error ("Couldn't wipe out $temppath: $!\n");
+  } else {
+    mkdir ($temppath, 0777) or error ("Cannot mkdir $temppath: $!\n");
+  }
+
+  # This is used by POSIX systems
+  $makeENV{TMPDIR} = $temppath;
+
+  # These are used on Windows
+  $makeENV{TMP} = $temppath;
+  $makeENV{TEMP} = $temppath;
+
   $workpath = "$cwdslash$workdir";
   $scriptpath = "$cwdslash$scriptdir";
 
@@ -278,7 +300,7 @@ sub toplevel
     &remove_directory_tree("$workpath/")
       or &error ("Couldn't wipe out $workpath: $!\n");
   } else {
-    mkdir ($workpath, 0777) or &error ("Couldn't mkdir $workpath: $!\n");
+    mkdir ($workpath, 0777) or &error ("Cannot mkdir $workpath: $!\n");
   }
 
   if (!-d $scriptpath) {
@@ -332,6 +354,8 @@ sub toplevel
     rmdir ("$workpath/$dir");
   }
 
+  rmdir ($temppath);
+
   $| = 1;
 
   $categories_failed = $categories_run - $categories_passed;
@@ -786,13 +810,29 @@ sub error
   die "$caller: $message";
 }
 
+my %old_tempfiles = ();
+
 sub compare_output
 {
   my ($answer, $logfile) = @_;
-  my ($slurp, $answer_matched) = ('', 0);
+  my ($slurp, $answer_matched, $extra) = ('', 0, 0);
 
   ++$tests_run;
 
+  my @tf = ();
+  foreach my $file (glob(File::Spec->catfile($temppath, "*"))) {
+    if (!exists $old_tempfiles{$file}) {
+      push @tf, $file;
+      $old_tempfiles{$file} = 1;
+    }
+  }
+  if (@tf) {
+    open (LOGFILE, '>>', $logfile) or die "Cannot open log file $logfile: $!\n";
+    print LOGFILE "Leftover temporary files: @tf\n";
+    close (LOGFILE);
+    $extra = 1;
+  }
+
   if (! defined $answer) {
     print "Ignoring output ........ " if $debug;
     $answer_matched = 1;
@@ -950,7 +990,7 @@ sub compare_output
     &create_file(&get_runfile, $command_string);
   }
 
-  if ($answer_matched && $test_passed) {
+  if ($answer_matched && $test_passed && !$extra) {
     print "ok\n" if $debug;
     ++$tests_passed;
     return 1;