150 lines
4.2 KiB
Diff
150 lines
4.2 KiB
Diff
Subject: [PATCH] attr: various improvements for test/run
|
|
|
|
First move process_test to avoid a warning:
|
|
|
|
main::process_test() called too early to check prototype at ./run line 47.
|
|
main::process_test() called too early to check prototype at ./run line 60.
|
|
|
|
Create two ENV variables TUSER and TGROUP to get the user/group
|
|
running the test.
|
|
|
|
Add a | test line that is similar to > but is interpreted as a regular
|
|
expression.
|
|
|
|
Signed-off-by: Brandon Philips <bphilips@suse.de>
|
|
|
|
---
|
|
test/run | 99 ++++++++++++++++++++++++++++++++-------------------------------
|
|
1 file changed, 51 insertions(+), 48 deletions(-)
|
|
|
|
Index: acl-2.2.47/test/run
|
|
===================================================================
|
|
--- acl-2.2.47.orig/test/run
|
|
+++ acl-2.2.47/test/run
|
|
@@ -25,26 +25,69 @@ if (isatty(fileno(STDOUT))) {
|
|
$FAILED = "\033[31m\033[1m" . $FAILED . "\033[m";
|
|
}
|
|
|
|
+$ENV{"TUSER"} = getpwuid($>);
|
|
+$ENV{"TGROUP"} = getgrgid($));
|
|
+
|
|
sub exec_test($$);
|
|
|
|
-my ($prog, $in, $out) = ([], [], []);
|
|
+my ($prog, $in, $out, $outmatch) = ([], [], [], []);
|
|
my $line_number = 0;
|
|
my $prog_line;
|
|
my ($tests, $failed) = (0,0);
|
|
|
|
+sub process_test($$$$$) {
|
|
+ my ($prog, $prog_line, $in, $out, $outmatch) = @_;
|
|
+
|
|
+ return unless @$prog;
|
|
+
|
|
+ my $p = [ @$prog ];
|
|
+ print "[$prog_line] \$ ", join(' ',
|
|
+ map { s/\s/\\$&/g; $_ } @$p), " -- ";
|
|
+ my $result = exec_test($prog, $in);
|
|
+ my $good = 1;
|
|
+ my $nmax = (@$outmatch > @$result) ? @$outmatch : @$result;
|
|
+ for (my $n=0; $n < $nmax; $n++) {
|
|
+ if (!defined($outmatch->[$n]) || !defined($result->[$n]) ||
|
|
+ $result->[$n] !~ /($outmatch->[$n])/) {
|
|
+ $good = 0;
|
|
+ }
|
|
+ }
|
|
+ $tests++;
|
|
+ $failed++ unless $good;
|
|
+ print $good ? $OK : $FAILED, "\n";
|
|
+ if (!$good) {
|
|
+ for (my $n=0; $n < $nmax; $n++) {
|
|
+ my $l = defined($out->[$n]) ? $out->[$n] : "~";
|
|
+ chomp $l;
|
|
+ my $r = defined($result->[$n]) ? $result->[$n] : "~";
|
|
+ chomp $r;
|
|
+ print sprintf("%-37s %s %-39s\n", $l, $l eq $r ? "|" : "?", $r);
|
|
+ }
|
|
+ } elsif ($opt_v) {
|
|
+ print join('', @$result);
|
|
+ }
|
|
+}
|
|
+
|
|
+
|
|
+
|
|
for (;;) {
|
|
my $line = <>; $line_number++;
|
|
if (defined $line) {
|
|
# Substitute %VAR and %{VAR} with environment variables.
|
|
- $line =~ s[%(?:(\w+)|\{(\w+)\})][$ENV{"$1$2"}]eg;
|
|
+ $line =~ s[%\{(\w+)\}][$ENV{"$1"}]eg;
|
|
+ $line =~ s[%(\w+)][$ENV{"$1"}]eg;
|
|
}
|
|
if (defined $line) {
|
|
if ($line =~ s/^\s*< ?//) {
|
|
push @$in, $line;
|
|
- } elsif ($line =~ s/^\s*> ?//) {
|
|
+ } elsif ($line =~ s/^\s*> ?//) { # explicit matching
|
|
+ push @$outmatch, "^(\Q$line\E)\$";
|
|
+ push @$out, $line;
|
|
+ } elsif ($line =~ s/^\s*\| ?//) { # regex case
|
|
+ push @$outmatch, $line;
|
|
push @$out, $line;
|
|
} else {
|
|
- process_test($prog, $prog_line, $in, $out);
|
|
+ process_test($prog, $prog_line, $in, $out, $outmatch);
|
|
|
|
$prog = [];
|
|
$prog_line = 0;
|
|
@@ -55,9 +98,10 @@ for (;;) {
|
|
$prog_line = $line_number;
|
|
$in = [];
|
|
$out = [];
|
|
+ $outmatch = [];
|
|
}
|
|
} else {
|
|
- process_test($prog, $prog_line, $in, $out);
|
|
+ process_test($prog, $prog_line, $in, $out, $outmatch);
|
|
last;
|
|
}
|
|
}
|
|
@@ -75,39 +119,6 @@ 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), " -- ";
|
|
- my $result = exec_test($prog, $in);
|
|
- my $good = 1;
|
|
- my $nmax = (@$out > @$result) ? @$out : @$result;
|
|
- for (my $n=0; $n < $nmax; $n++) {
|
|
- if (!defined($out->[$n]) || !defined($result->[$n]) ||
|
|
- $out->[$n] ne $result->[$n]) {
|
|
- $good = 0;
|
|
- }
|
|
- }
|
|
- $tests++;
|
|
- $failed++ unless $good;
|
|
- print $good ? $OK : $FAILED, "\n";
|
|
- if (!$good) {
|
|
- for (my $n=0; $n < $nmax; $n++) {
|
|
- my $l = defined($out->[$n]) ? $out->[$n] : "~";
|
|
- chomp $l;
|
|
- my $r = defined($result->[$n]) ? $result->[$n] : "~";
|
|
- chomp $r;
|
|
- print sprintf("%-37s %s %-39s\n", $l, $l eq $r ? "|" : "?", $r);
|
|
- }
|
|
- } elsif ($opt_v) {
|
|
- print join('', @$result);
|
|
- }
|
|
-}
|
|
-
|
|
|
|
sub su($) {
|
|
my ($user) = @_;
|