- Never reorder files in patches. (Previously the file list

  was run through (sort | uniq) to remove duplicate entries.)
- Update test script to new format, and add regression test
  cases.

1 files changed, 98 insertions, 51 deletions

diff --git a/test/run b/test/run
index c6d09f6..f60f9c6 100755
--- a/test/run
+++ b/test/run
@@ -1,4 +1,13 @@
-#! /usr/bin/perl -w -U
+#!/usr/bin/perl -w -U
+
+#
+# Possible improvements:
+#
+# - distinguish stdout and stderr output
+# - add environment variable like assignments
+# - run up to a specific line
+# - resume at a specific line
+#
 
 use strict;
 use FileHandle;
@@ -19,20 +28,58 @@ if (isatty(fileno(STDOUT))) {
 sub exec_test($$);
 
 my ($prog, $in, $out) = ([], [], []);
-my $line = 0;
+my $line_number = 0;
 my $prog_line;
 my ($tests, $failed) = (0,0);
 
 for (;;) {
-  my $script = <>; $line++;
-  if (defined $script) {
+  my $line = <>; $line_number++;
+  if (defined $line) {
     # Substitute %VAR and %{VAR} with environment variables.
-    $script =~ s[%(?:(\w+)|\{(\w+)\})][$ENV{"$1$2"}]eg;
+    $line =~ s[%(?:(\w+)|\{(\w+)\})][$ENV{"$1$2"}]eg;
+  }
+  if (defined $line) {
+    if ($line =~ s/^\s*< ?//) {
+      push @$in, $line;
+    } elsif ($line =~ s/^\s*> ?//) {
+      push @$out, $line;
+    } else {
+      process_test($prog, $prog_line, $in, $out);
+
+      $prog = [];
+      $prog_line = 0;
+    }
+    if ($line =~ s/^\s*\$ ?//) {
+      $line =~ s/\s+#.*//;  # remove comments here...
+      $prog = [ map { s/\\(.)/$1/g; $_ } split /(?<!\\)\s+/, $line ];
+      $prog_line = $line_number;
+      $in = [];
+      $out = [];
+    }
+  } else {
+    process_test($prog, $prog_line, $in, $out);
+    last;
   }
-  next if (defined($script) && $script =~ /^!/);
-  if (!defined($script) || $script =~ s/^\$ ?//) {
-    if (@$prog) {
-       #print "[$prog_line] \$ ", join(' ', @$prog), " -- ";
+}
+
+my $status = sprintf("%d commands (%d passed, %d failed)",
+	$tests, $tests-$failed, $failed);
+if (isatty(fileno(STDOUT))) {
+	if ($failed) {
+		$status = "\033[31m\033[1m" . $status . "\033[m";
+	} else {
+		$status = "\033[32m" . $status . "\033[m";
+	}
+}
+print $status, "\n";
+exit $failed ? 1 : 0;
+
+
+sub process_test($$$$) {
+  my ($prog, $prog_line, $in, $out) = @_;
+
+  return unless @$prog;
+
        my $p = [ @$prog ];
        print "[$prog_line] \$ ", join(' ',
              map { s/\s/\\$&/g; $_ } @$p), " -- ";
@@ -43,9 +90,6 @@ for (;;) {
 	 if (!defined($out->[$n]) || !defined($result->[$n]) ||
 	     $out->[$n] ne $result->[$n]) {
 		 $good = 0;
-		 #chomp $out->[$n];
-		 #chomp $result->[$n];
-		 #print "$out->[$n] != $result->[$n]";
 	 }
        }
        $tests++;
@@ -57,41 +101,21 @@ for (;;) {
 	   chomp $l;
 	   my $r = defined($result->[$n]) ? $result->[$n] : "~";
 	   chomp $r;
-	   print sprintf("%-37s | %-39s\n", $l, $r);
+	   print sprintf("%-37s %s %-39s\n", $l, $l eq $r ? '|' : '?', $r);
          }
        } elsif ($opt_v) {
 	 print join('', @$result);
        }
-    }
-    #$prog = [ split /\s+/, $script ] if $script;
-    $prog = [ map { s/\\(.)/$1/g; $_ } split /(?<!\\)\s+/, $script ] if $script;
-    $prog_line = $line;
-    $in = [];
-    $out = [];
-  } elsif ($script =~ s/^> ?//) {
-    push @$in, $script;
-  } else {
-    push @$out, $script;
-  }
-  last unless defined($script);
 }
-my $status = sprintf("%d commands (%d passed, %d failed)",
-	$tests, $tests-$failed, $failed);
-if (isatty(fileno(STDOUT))) {
-	if ($failed) {
-		$status = "\033[31m\033[1m" . $status . "\033[m";
-	} else {
-		$status = "\033[32m" . $status . "\033[m";
-	}
-}
-print $status, "\n";
-exit $failed ? 1 : 0;
+
 
 sub su($) {
   my ($user) = @_;
 
+  $user ||= "root";
+
   my ($login, $pass, $uid, $gid) = getpwnam($user)
-    or return [ "su: user $prog->[1] does not exist\n" ];
+    or return [ "su: user $user does not exist\n" ];
   my @groups = ();
   my $fh = new FileHandle("/etc/group")
     or return [ "opening /etc/group: $!\n" ];
@@ -107,27 +131,58 @@ sub su($) {
 
   my $groups = join(" ", ($gid, $gid, @groups));
   #print STDERR "[[$groups]]\n";
+  $! = 0;  # reset errno
   $> = 0;
   $( = $gid;
   $) = $groups;
   if ($!) {
-    return [ "setgroups: $!\n" ];
+    return [ "su: $!\n" ];
   }
   if ($uid != 0) {
     $> = $uid;
     #$< = $uid;
     if ($!) {
-      return [ "seteuid: $prog->[1]: $!\n" ];
+      return [ "su: $prog->[1]: $!\n" ];
     }
   }
   #print STDERR "[($>,$<)($(,$))]";
   return [];
 }
 
+
+sub sg($) {
+  my ($group) = @_;
+
+  my $gid = getgrnam($group)
+    or return [ "sg: group $group does not exist\n" ];
+  my %groups = map { $_ eq $gid ? () : ($_ => 1) } (split /\s/, $));
+  
+  #print STDERR "<<", join("/", keys %groups), ">>\n";
+  my $groups = join(" ", ($gid, $gid, keys %groups));
+  #print STDERR "[[$groups]]\n";
+  $! = 0;  # reset errno
+  if ($> != 0) {
+	  my $uid = $>;
+	  $> = 0;
+	  $( = $gid;
+	  $) = $groups;
+	  $> = $uid;
+  } else {
+	  $( = $gid;
+	  $) = $groups;
+  }
+  if ($!) {
+    return [ "sg: $!\n" ];
+  }
+  print STDERR "[($>,$<)($(,$))]";
+  return [];
+}
+
+
 sub exec_test($$) {
   my ($prog, $in) = @_;
   local (*IN, *IN_DUP, *IN2, *OUT_DUP, *OUT, *OUT2);
-  my $needs_shell = (join('', @$prog) =~ /[|<>"'`\$]/);
+  my $needs_shell = (join('', @$prog) =~ /[][|<>"'`\$\*\?]/);
 
   if ($prog->[0] eq "umask") {
     umask oct $prog->[1];
@@ -139,15 +194,8 @@ sub exec_test($$) {
     return [];
   } elsif ($prog->[0] eq "su") {
     return su($prog->[1]);
-  } elsif ($prog->[0] eq "seteuid") {
-    my $user = $prog->[1];
-    my ($login,$pass,$uid,$gid) = getpwnam($user) or
-      return [ "seteuid: user $prog->[1] does not exist\n" ];
-    $> = $uid;
-    if ($> != $uid) {
-      return [ "seteuid: $prog->[1]: $!\n" ];
-    }
-    return [];
+  } elsif ($prog->[0] eq "sg") {
+    return sg($prog->[1]);
   }
 
   pipe *IN2, *OUT
@@ -213,13 +261,12 @@ sub exec_test($$) {
     open STDERR, ">&STDOUT"
       or die "Can't join STDOUT and STDERR: $!";
 
-    #print ERR_DUP "<", join(' ', @$prog), ">\n";
     if ($needs_shell) {
       exec ('/bin/sh', '-c', join(" ", @$prog));
     } else {
       exec @$prog;
     }
-    print ERR_DUP $prog->[0], ": $!\n";
+    print STDERR $prog->[0], ": $!\n";
     exit;
   }
 }