Re: 5.005_03, BeOS: incorrect $? after system invocation (Was: 2.53b on BeOS, 7 failures)

[Akim Demaille]

>>>>> "Akim" == Akim Demaille <address@hidden> writes:

Akim> I'm applying the following patch.

Actually, I installed the following one:

Index: ChangeLog
from  Akim Demaille  <address@hidden>

        * lib/Autom4te/General.pm (&xqx): New.
        (&xsystem): Use WIFEXITED and WEXITSTATUS instead of decoding $? by
        hand, which is not portable.
        (&error): New.
        * bin/autom4te.in: Use them.
        Use &error instead of die.
        * tests/m4sugar.at (m4_warn, m4_require: circular dependencies):
        Adjust.

Index: bin/autom4te.in
===================================================================
RCS file: /cvsroot/autoconf/autoconf/bin/autom4te.in,v
retrieving revision 1.67
diff -u -u -r1.67 autom4te.in
--- bin/autom4te.in 30 Jul 2002 00:42:58 -0000 1.67
+++ bin/autom4te.in 29 Aug 2002 08:00:21 -0000
@@ -278,7 +278,7 @@
 # $M4.
 my $m4 = $ENV{"M4"} || '@M4@';
 # Some non-GNU m4's don't reject the --help option, so give them /dev/null.
-die "$me: need GNU m4 1.4 or later: $m4\n"
+error "need GNU m4 1.4 or later: $m4"
   if system "$m4 --help </dev/null 2>&1 | grep reload-state >/dev/null";
 
 # Set some high recursion limit as the default limit, 250, has already
@@ -443,7 +443,7 @@
        }
       elsif ($type eq 'end-language:')
        {
-         die "$me: $autom4te_cfg:$.: end-language mismatch: $lang\n"
+         error "$autom4te_cfg:$.: end-language mismatch: $lang"
            if $lang ne lc $words[0];
        }
       elsif ($type eq 'args:')
@@ -452,7 +452,7 @@
        }
       else
        {
-         die "$me: $autom4te_cfg:$.: unknown directive: $type\n";
+         error "$autom4te_cfg:$.: unknown directive: $type";
        }
     }
 }
@@ -477,7 +477,7 @@
 
     foreach (@language)
       {
-       die "$me: unknown language: $_\n"
+       error "unknown language: $_"
          unless exists $language{lc $_};
        unshift @ARGV, @{$language{lc $_}};
       }
@@ -510,8 +510,8 @@
      "F|freeze"  => \$freeze,
     );
 
-  die "$me: too few arguments
-Try `$me --help' for more information.\n"
+  error "too few arguments
+Try `$me --help' for more information."
     unless @ARGV;
 
   # Freezing:
@@ -519,7 +519,7 @@
   # And it implies melting: there is risk not to update properly using
   # old frozen files, and worse yet: we could load a frozen file and
   # refreeze it!  A sort of caching :)
-  die "$me: cannot freeze and trace\n"
+  error "cannot freeze and trace"
     if $freeze && @trace;
   $melt = 1
     if $freeze;
@@ -612,29 +612,22 @@
   #
   # We don't output directly to the cache files, to avoid problems
   # when we are interrupted (that leaves corrupted files).
-  my $command = ("$m4"
-                . join (' --include=', '', @include)
-                . " --define=m4_warnings=$m4_warnings"
-                . ' --debug=aflq'
-                . " --error-output=$tcache" . $req->id . "t"
-                . join (' --trace=',   '', sort @macro)
-                . " @ARGV"
-                . ' </dev/null'
-                . " >$ocache" . $req->id . "t");
-  verbose "running: $command";
-  system $command;
-  if ($?)
-    {
-      verbose "$m4: failed with exit status: " . ($? >> 8) . "\n";
-      exit $? >> 8;
-    }
+  xsystem ("$m4"
+          . join (' --include=', '', @include)
+          . " --define=m4_warnings=$m4_warnings"
+          . ' --debug=aflq'
+          . " --error-output=$tcache" . $req->id . "t"
+          . join (' --trace=',   '', sort @macro)
+          . " @ARGV"
+          . ' </dev/null'
+          . " >$ocache" . $req->id . "t");
 
   # Everything went ok: preserve the outputs.
   foreach my $file (map { $_ . $req->id } ($tcache, $ocache))
     {
       use File::Copy;
       move ("${file}t", "$file")
-       or die "$me: cannot not rename ${file}t as $file: $!\n";
+       or error "cannot not rename ${file}t as $file: $!";
     }
 }
 
@@ -710,7 +703,7 @@
     {
       $out->open($output, O_CREAT | O_WRONLY | O_TRUNC, oct ($mode));
     }
-  die "$me: cannot create $output: $!\n"
+  error "cannot create $output: $!"
     unless $out;
   my $in = new Autom4te::XFile ($ocache . $req->id);
 
@@ -837,7 +830,7 @@
        }
       elsif (/^(\$.)/)
         {
-         die "$me: invalid escape: $1\n";
+         error "invalid escape: $1";
         }
       else
         {
@@ -1062,21 +1055,14 @@
 
   # When processing the file with diversion disabled, there must be no
   # output but comments and empty lines.
-  my $command = ("$m4"
-                . ' --fatal-warning'
-                . join (' --include=', '', @include)
-                . ' --define=divert'
-                . " @ARGV"
-                . ' </dev/null');
-  verbose "running: $command";
-  my $result = `$command`;
+  my $result = xqx ("$m4"
+                   . ' --fatal-warning'
+                   . join (' --include=', '', @include)
+                   . ' --define=divert'
+                   . " @ARGV"
+                   . ' </dev/null');
   $result =~ s/#.*\n//g;
   $result =~ s/^\n//mg;
-  if ($?)
-    {
-      verbose "$m4: failed with exit status: " . ($? >> 8) . "\n";
-      exit $? >> 8;
-    }
   if ($result)
     {
       print STDERR "$me: freezing produced output:\n$result";
@@ -1085,19 +1071,12 @@
 
   # If freezing produces output, something went wrong: a bad `divert',
   # or an improper paren etc.
-  $command = ("$m4"
-             . ' --fatal-warning'
-             . join (' --include=', '', @include)
-             . " --freeze-state=$output"
-             . " @ARGV"
-             . ' </dev/null');
-  verbose "running: $command";
-  system $command;
-  if ($?)
-    {
-      verbose "$m4: failed with exit status: " . ($? >> 8) . "\n";
-      exit $? >> 8;
-    }
+  xsystem ("$m4"
+          . ' --fatal-warning'
+          . join (' --include=', '', @include)
+          . " --freeze-state=$output"
+          . " @ARGV"
+          . ' </dev/null');
 }
 
 ## -------------- ##
@@ -1119,7 +1098,7 @@
 if (! -d "$cache")
   {
     mkdir "$cache", 0755
-      or die "$me: cannot create $cache: $!\n";
+      or error "cannot create $cache: $!";
   }
 
 # Read the cache index if available and older than autom4te itself.
Index: lib/Autom4te/General.pm
===================================================================
RCS file: /cvsroot/autoconf/autoconf/lib/Autom4te/General.pm,v
retrieving revision 1.21
diff -u -u -r1.21 General.pm
--- lib/Autom4te/General.pm 17 Jul 2002 16:07:33 -0000 1.21
+++ lib/Autom4te/General.pm 29 Aug 2002 08:00:21 -0000
@@ -37,10 +37,10 @@
 
 # Functions we define and export.
 my @export_subs =
-  qw (&backname &catfile &canonpath &debug
+  qw (&backname &catfile &canonpath &debug &error
       &file_name_is_absolute &find_configure_ac &find_file
       &getopt &mktmpdir &mtime
-      &uniq &update_file &up_to_date_p &verbose &xsystem);
+      &uniq &update_file &up_to_date_p &verbose &xsystem &xqx);
 
 # Functions we forward (coming from modules we use).
 my @export_forward_subs =
@@ -185,6 +185,22 @@
 }
 
 
+# &error (@MESSAGE)
+# -----------------
+# Same as die or confess, depending on $debug.
+sub error (@)
+{
+  if ($debug)
+    {
+      confess "$me: ", @_, "\n";
+    }
+  else
+    {
+      die "$me: ", @_, "\n";
+    }
+}
+
+
 # $BOOLEAN
 # &file_name_is_absolute ($FILE)
 # ------------------------------
@@ -244,7 +260,7 @@
 
   if (file_name_is_absolute ($filename))
     {
-      die "$me: no such file or directory: $filename\n"
+      error "no such file or directory: $filename"
        unless $optional;
       return undef;
     }
@@ -255,7 +271,7 @@
        if -e catfile ($path, $filename);
     }
 
-  die "$me: no such file or directory: $filename\n"
+  error "no such file or directory: $filename"
     unless $optional;
 
   return undef;
@@ -408,7 +424,7 @@
        }
       $in->close;
       unlink ($from)
-       or die "$me: cannot not remove $from: $!\n";
+       or die "cannot not remove $from: $!";
       return;
     }
 
@@ -417,7 +433,7 @@
       # File didn't change, so don't update its mod time.
       print STDERR "$me: `$to' is unchanged\n";
       unlink ($from)
-       or die "$me: cannot not remove $from: $!\n";
+       or error "cannot not remove $from: $!";
       return
     }
 
@@ -425,15 +441,15 @@
     {
       # Back up and install the new one.
       move ("$to",  "$to$SIMPLE_BACKUP_SUFFIX")
-       or die "$me: cannot not backup $to: $!\n";
+       or error "cannot not backup $to: $!";
       move ("$from", "$to")
-       or die "$me: cannot not rename $from as $to: $!\n";
+       or error "cannot not rename $from as $to: $!";
       print STDERR "$me: `$to' is updated\n";
     }
   else
     {
       move ("$from", "$to")
-       or die "$me: cannot not rename $from as $to: $!\n";
+       or error "cannot not rename $from as $to: $!";
       print STDERR "$me: `$to' is created\n";
     }
 }
@@ -448,20 +464,41 @@
 }
 
 
+# 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;
+
+  return $res;
+}
+
+
 # xsystem ($COMMAND)
 # ------------------
 sub xsystem ($)
 {
+  use POSIX qw (WEXITSTATUS);
+
   my ($command) = @_;
 
   verbose "running: $command";
 
   (system $command) == 0
-    or croak ("$me: "
-             . (split (' ', $command))[0]
+    or error ((split (' ', $command))[0]
              . " failed with exit status: "
-             . ($? >> 8)
-             . "\n");
+             . WEXITSTATUS ($?));
 }
 
 
Index: tests/m4sugar.at
===================================================================
RCS file: /cvsroot/autoconf/autoconf/tests/m4sugar.at,v
retrieving revision 1.20
diff -u -u -r1.20 m4sugar.at
--- tests/m4sugar.at 8 Oct 2001 08:21:54 -0000 1.20
+++ tests/m4sugar.at 29 Aug 2002 08:00:21 -0000
@@ -2,7 +2,7 @@
 
 AT_BANNER([M4sugar.])
 
-# Copyright 2000, 2001 Free Software Foundation, Inc.
+# Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -61,10 +61,13 @@
 [script.4s:2: warning: bar
 ])
 
-AT_CHECK_M4SUGAR([-o- -Wnone,bar,error -f], 1, [],
-[script.4s:2: error: bar
+AT_CHECK_M4SUGAR([-o- -Wnone,bar,error -f], 1, [], [stderr])
+# The error message contains the path to m4, which might change.
+AT_CHECK([sed 's/^autom4te.*failed/autom4te: m4 failed/' stderr], 0,
+[[script.4s:2: error: bar
 script.4s:2: the top level
-])
+autom4te: m4 failed with exit status: 1
+]])
 
 AT_CLEANUP
 
@@ -93,7 +96,8 @@
 baz
 ]])
 
-AT_DATA_M4SUGAR([experr],
+# Expected stderr.
+AT_DATA_M4SUGAR([expout],
 [[script.4s:11: error: m4_require: circular dependency of foo
 script.4s:11: foo is required by...
 script.4s:5: bar is expanded from...
@@ -102,9 +106,12 @@
 script.4s:11: foo is required by...
 script.4s:8: baz is expanded from...
 script.4s:11: the top level
+autom4te: m4 failed with exit status: 1
 ]])
 
-AT_CHECK_M4SUGAR([], 1, [], experr)
+AT_CHECK_M4SUGAR([], 1, [], stderr)
+# The error message contains the path to m4, which might change.
+AT_CHECK([sed 's/^autom4te.*failed/autom4te: m4 failed/' stderr], 0, [expout])
 AT_CLEANUP