[Quilt-dev] [PATCH] test suite: Record the status returned by every command

[Jean Delvare]

Record the status returned by every command, so that test cases can
check them.
---
Andreas, what do you think? Martin had a use case for this some months
ago.

 test/run |   36 ++++++++++++++++++++++--------------
 1 file changed, 22 insertions(+), 14 deletions(-)

--- a/test/run
+++ b/test/run
@@ -81,6 +81,7 @@ if (defined $ARGV[0]) {
 }
 
 for (;;) {
+  my $last_status;
   my $line = <SOURCE>; $lineno++;
   if (defined $line) {
     # Substitute %{VAR} with environment variables.
@@ -92,13 +93,16 @@ for (;;) {
     } elsif ($line =~ s/^\s*> ?//) {
       push @$out, $line;
     } else {
-      process_test($prog, $prog_line, $in, $out);
+      $last_status = process_test($prog, $prog_line, $in, $out);
       last if $prog_line >= $opt_l;
 
       $prog = [];
       $prog_line = 0;
     }
     if ($line =~ s/^\s*\$ ?//) {
+      # Substitute %{?} with the last command's status.
+      $line =~ s[%{\?}][$last_status]eg;
+
       $prog = [ map { s/\\(.)/$1/g; $_ } split /(?<!\\)\s+/, $line ];
       $prog_line = $lineno;
       $in = [];
@@ -132,13 +136,14 @@ exit $failed ? 1 : 0;
 
 sub process_test($$$$) {
   my ($prog, $prog_line, $in, $out) = @_;
+  my ($result, $exec_status);
 
   return unless @$prog;
 
        my $p = [ @$prog ];
        print_body "[$prog_line] \$ ".join(' ',
                   map { s/\s/\\$&/g; $_ } @$p)." -- ";
-       my $result = exec_test($prog, $in);
+       ($exec_status, $result) = exec_test($prog, $in);
        my @good = ();
        my $nmax = (@$out > @$result) ? @$out : @$result;
        for (my $n=0; $n < $nmax; $n++) {
@@ -171,6 +176,8 @@ sub process_test($$$$) {
                              $r, $good[$n], $l);
          }
        }
+
+       return $exec_status;
 }
 
 
@@ -180,7 +187,7 @@ sub su($) {
   $user ||= "root";
 
   my ($login, $pass, $uid, $gid) = getpwnam($user)
-    or return [ "su: user $user does not exist\n" ];
+    or return 1, [ "su: user $user does not exist\n" ];
   my @groups = ();
   my $fh = new FileHandle("/etc/group")
     or return [ "opening /etc/group: $!\n" ];
@@ -201,17 +208,17 @@ sub su($) {
   $( = $gid;
   $) = $groups;
   if ($!) {
-    return [ "su: $!\n" ];
+    return 1, [ "su: $!\n" ];
   }
   if ($uid != 0) {
     $> = $uid;
     #$< = $uid;
     if ($!) {
-      return [ "su: $prog->[1]: $!\n" ];
+      return 1, [ "su: $prog->[1]: $!\n" ];
     }
   }
   #print STDERR "[($>,$<)($(,$))]";
-  return [];
+  return 0, [];
 }
 
 
@@ -237,10 +244,10 @@ sub sg($) {
          $) = $groups;
   }
   if ($!) {
-    return [ "sg: $!\n" ];
+    return 1, [ "sg: $!\n" ];
   }
   print STDERR "[($>,$<)($(,$))]";
-  return [];
+  return 0, [];
 }
 
 
@@ -251,13 +258,13 @@ sub exec_test($$) {
 
   if ($prog->[0] eq "umask") {
     umask oct $prog->[1];
-    return [];
+    return 0, [];
   } elsif ($prog->[0] eq "cd") {
     if (!chdir $prog->[1]) {
-      return [ "chdir: $prog->[1]: $!\n" ];
+      return 1, [ "chdir: $prog->[1]: $!\n" ];
     }
     $ENV{PWD} = getcwd;
-    return [];
+    return 0, [];
   } elsif ($prog->[0] eq "su") {
     return su($prog->[1]);
   } elsif ($prog->[0] eq "sg") {
@@ -267,10 +274,10 @@ sub exec_test($$) {
     # FIXME: need to evaluate $value, so that things like this will work:
     # export dir=$PWD/dir
     $ENV{$name} = $value;
-    return [];
+    return 0, [];
   } elsif ($prog->[0] eq "unset") {
     delete $ENV{$prog->[1]};
-    return [];
+    return 0, [];
   }
 
   pipe *IN2, *OUT
@@ -320,7 +327,8 @@ sub exec_test($$) {
       }
       push @$result, $_;
     }
-    return $result;
+    wait();
+    return $? >> 8, $result;
   } else {
     # Client
     $< = $>;

-- 
Jean Delvare
Suse L3