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

[Martin Quinson]

I must confess that I cannot remember why I needed this, actually.
Beside of this, I have nothing against the feature. Throughfully
reviewing the patch would need more time than what I can devote, but I
trust you.

Mt

On Fri, May 31, 2013 at 02:43:10PM +0200, Jean Delvare wrote:
> 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
> 

-- 
The day Microsoft makes something that doesn't suck is probably the
day they start making vacuum cleaners.