From: Stefano Lattarini <stefano.lattarini@gmail.com>
Date: Thu, 25 Aug 2011 08:53:23 +0000 (+0200)
Subject: tap/perl: don't redirect perl warnings/errors to log files
X-Git-Tag: ng-0.5a~89^2~95^2~4
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=aba3010e83194e2172006059db08f4fd5992f021;p=thirdparty%2Fautomake.git

tap/perl: don't redirect perl warnings/errors to log files

With this change, the test `tap-driver-stderr.test' also passes
with the perl implementation of the TAP driver.

* lib/tap-driver.pl (start): Save the original stderr into the
`OLDERR' file handle, and call ...
(trap_perl_warnings_and_errors): ... this new function, trapping
the `__WARN__' and `__DIE__' "pseudo-signals" to ensure that the
warning and error messages goes to that original stderr stream.
Since we are at it, be sure to prepend all possible "die" message
with the name of the script as given by the `$ME' variable.
---

diff --git a/ChangeLog b/ChangeLog
index 2be7634c9..2739949ae 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2011-08-25  Stefano Lattarini  <stefano.lattarini@gmail.com>
+
+	tap/perl: don't redirect perl warnings/errors to log files
+	With this change, the test `tap-driver-stderr.test' also passes
+	with the perl implementation of the TAP driver.
+	* lib/tap-driver.pl (start): Save the original stderr into the
+	`OLDERR' file handle, and call ...
+	(trap_perl_warnings_and_errors): ... this new function, trapping
+	the `__WARN__' and `__DIE__' "pseudo-signals" to ensure that the
+	warning and error messages goes to that original stderr stream.
+	Since we are at it, be sure to prepend all possible "die" message
+	with the name of the script as given by the `$ME' variable.
+
 2011-08-25  Stefano Lattarini  <stefano.lattarini@gmail.com>
 
 	tap/perl: add copyright notice, version string, and emacs stuff
diff --git a/lib/tap-driver.pl b/lib/tap-driver.pl
index 64f22e56a..9dce6a00e 100755
--- a/lib/tap-driver.pl
+++ b/lib/tap-driver.pl
@@ -135,6 +135,7 @@ sub report ($;$);
 sub start (@);
 sub stringify_test_result ($);
 sub testsuite_error ($);
+sub trap_perl_warnings_and_errors ();
 sub write_test_results ();
 sub yn ($);
 
@@ -155,7 +156,7 @@ sub bool_opt ($$)
     }
   else
     {
-      die "invalid argument '$val' for option '$opt'\n";
+      die "$ME: invalid argument '$val' for option '$opt'\n";
     }
 }
 
@@ -220,7 +221,7 @@ TEST_RESULTS :
 
 sub write_test_results ()
 {
-  open RES, ">", $trs_file or die "opening $trs_file: $!\n";
+  open RES, ">", $trs_file or die "$ME: opening $trs_file: $!\n";
   print RES ":global-test-result: " . get_global_test_result . "\n";
   print RES ":recheck: " . yn (must_recheck) . "\n";
   print RES ":copy-in-global-log: " . yn (copy_in_global_log) . "\n";
@@ -228,18 +229,32 @@ sub write_test_results ()
     {
       print RES ":test-result: $result\n";
     }
-  close RES or die "closing $trs_file: $!\n";
+  close RES or die "$ME: closing $trs_file: $!\n";
+}
+
+sub trap_perl_warnings_and_errors ()
+{
+  $SIG{__WARN__} = $SIG{__DIE__} = sub
+    {
+      # Be sure to send the warning/error message to the original stderr
+      # (presumably the console), not into the log file.
+      open STDERR, ">&", \*OLDERR;
+      die @_;
+    }
 }
 
 sub start (@)
 {
   # Redirect stderr and stdout to a temporary log file.  Save the
   # original stdout stream, since we need it to print testsuite
-  # progress output.
-  open LOG, ">", $log_file or die "opening $log_file: $!\n";
-  open OLDOUT, ">&STDOUT" or die "duplicating stdout: $!\n";
-  open STDOUT, ">&LOG" or die "redirecting stdout: $!\n";
-  open STDERR, ">&LOG" or die "redirecting stderr: $!\n";
+  # progress output. Save original stderr stream, so that we can
+  # redirect warning and error messages from perl there.
+  open LOG, ">", $log_file or die "$ME: opening $log_file: $!\n";
+  open OLDOUT, ">&STDOUT" or die "$ME: duplicating stdout: $!\n";
+  open OLDERR, ">&STDERR" or die "$ME: duplicating stdout: $!\n";
+  trap_perl_warnings_and_errors;
+  open STDOUT, ">&LOG" or die "$ME: redirecting stdout: $!\n";
+  open STDERR, ">&LOG" or die "$ME: redirecting stderr: $!\n";
   $parser = TAP::Parser->new ({ exec => \@_, merge => $cfg{merge} });
   $parser->ignore_exit(1) if $cfg{"ignore-exit"};
 }
@@ -489,7 +504,7 @@ sub main (@)
       testsuite_error $msg if $msg;
     }
   write_test_results;
-  close LOG or die "closing $log_file: $!\n";
+  close LOG or die "$ME: closing $log_file: $!\n";
   exit 0;
 }