* lib/Autom4te/General.pm (END): Print diagnostics to STDERR.

(handle_exec_errors): New function.  Work around $! being
altered by WEXITSTATUS.
(xqx, xsystem): Use handle_exec_errors.

diff --git a/ChangeLog b/ChangeLog
index 7ba1e23c968c7ea6c318ad27b6ebe44921512f2e..fdcc666f03468fa2582331465b1421735bcf9c27 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2003-05-25  Alexandre Duret-Lutz  <adl@gnu.org>
+
+       * lib/Autom4te/General.pm (END): Print diagnostics to STDERR.
+       (handle_exec_errors): New function.  Work around $! being
+       altered by WEXITSTATUS.
+       (xqx, xsystem): Use handle_exec_errors.
+
 2003-05-23  Alexandre Duret-Lutz  <adl@gnu.org>
 
        * lib/Autom4te/General.pm (END): Rewrite exit code processing.

diff --git a/lib/Autom4te/General.pm b/lib/Autom4te/General.pm
index 375d3cf5ba523d58f7629fe7a9d3c7a69b7b8d05..083fdc806eccb3cea1ac6a0578659f96de4fab2d 100644 (file)
--- a/lib/Autom4te/General.pm
+++ b/lib/Autom4te/General.pm
@@ -121,14 +121,14 @@ sub END
        {
          if (! unlink <$tmp/*>)
            {
-             print "$me: cannot empty $tmp: $!\n";
+             print STDERR "$me: cannot empty $tmp: $!\n";
              $? = 1;
              return;
            }
        }
       if (! rmdir $tmp)
        {
-         print "$me: cannot remove $tmp: $!\n";
+         print STDERR "$me: cannot remove $tmp: $!\n";
          $? = 1;
          return;
        }
@@ -138,7 +138,7 @@ sub END
   # E.g., even --version or --help.  So it's best to do it unconditionally.
   if (! close STDOUT)
     {
-      print "$me: closing standard output: $!\n";
+      print STDERR "$me: closing standard output: $!\n";
       $? = 1;
       return;
     }
@@ -488,23 +488,57 @@ sub verbose (@)
     if $verbose;
 }
 
+# handle_exec_errors ($COMMAND)
+# -----------------------------
+# Display an error message for $COMMAND, based on the content of $? and $!.
+sub handle_exec_errors ($)
+{
+  my ($command) = @_;
+
+  $command = (split (' ', $command))[0];
+  if ($!)
+    {
+      error "failed to run $command: $!";
+    }
+  else
+    {
+      use POSIX qw (WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
+
+      if (WIFEXITED ($?))
+       {
+         my $status = WEXITSTATUS ($?);
+         # WIFEXITED and WEXITSTATUS can alter $!, reset it so that
+         # error() actually propagates the command's exit status, not $!.
+         $! = 0;
+         error "$command failed with exit status: $status";
+       }
+      elsif (WIFSIGNALED ($?))
+       {
+         my $signal = WTERMSIG ($?);
+         # In this case we prefer to exit with status 1.
+         $! = 1;
+         error "$command terminated by signal: $signal";
+       }
+      else
+       {
+         error "$command exited abnormally";
+       }
+    }
+}
 
 # xqx ($COMMAND)
 # --------------
 # Same as `qx' (but in scalar context), but fails on errors.
 sub xqx ($)
 {
-  use POSIX qw (WIFEXITED WEXITSTATUS);
-
   my ($command) = @_;
 
   verbose "running: $command";
-  my $res = `$command`;
 
-  error ((split (' ', $command))[0]
-        . " failed with exit status: "
-        . WEXITSTATUS ($?))
-    if WIFEXITED ($?) && WEXITSTATUS ($?) != 0;
+  $! = 0;
+  my $res = `$command`;
+  handle_exec_errors $command
+    if $?;
 
   return $res;
 }
@@ -514,26 +548,13 @@ sub xqx ($)
 # ------------------
 sub xsystem ($)
 {
-  use POSIX qw (WEXITSTATUS);
-
   my ($command) = @_;
 
   verbose "running: $command";
 
   $! = 0;
-
-  if (system $command)
-  {
-    $command = (split (' ', $command))[0];
-    if ($!)
-      {
-       error "failed to run $command: $!";
-      }
-    else
-      {
-       error "$command failed with exit status: " . WEXITSTATUS ($?);
-      }
-  }
+  handle_exec_errors $command
+    if system $command;
 }