189 lines
5.9 KiB
Diff
189 lines
5.9 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 | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++-------------
|
|
1 file changed, 72 insertions(+), 18 deletions(-)
|
|
|
|
Index: attr-2.4.43/test/run
|
|
===================================================================
|
|
--- attr-2.4.43.orig/test/run
|
|
+++ attr-2.4.43/test/run
|
|
@@ -1,5 +1,32 @@
|
|
#!/usr/bin/perl -w -U
|
|
|
|
+# Copyright (c) 2007, 2008 Andreas Gruenbacher.
|
|
+# All rights reserved.
|
|
+#
|
|
+# Redistribution and use in source and binary forms, with or without
|
|
+# modification, are permitted provided that the following conditions
|
|
+# are met:
|
|
+# 1. Redistributions of source code must retain the above copyright
|
|
+# notice, this list of conditions, and the following disclaimer,
|
|
+# without modification, immediately at the beginning of the file.
|
|
+# 2. The name of the author may not be used to endorse or promote products
|
|
+# derived from this software without specific prior written permission.
|
|
+#
|
|
+# Alternatively, this software may be distributed under the terms of the
|
|
+# GNU Public License ("GPL").
|
|
+#
|
|
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
|
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR
|
|
+# ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
|
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
|
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
|
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
|
+# SUCH DAMAGE.
|
|
+
|
|
#
|
|
# Possible improvements:
|
|
#
|
|
@@ -12,12 +39,13 @@
|
|
use strict;
|
|
use FileHandle;
|
|
use Getopt::Std;
|
|
-use POSIX qw(isatty setuid);
|
|
-use vars qw($opt_v);
|
|
+use POSIX qw(isatty setuid getcwd);
|
|
+use vars qw($opt_l $opt_v);
|
|
|
|
no warnings qw(taint);
|
|
|
|
-getopts('v');
|
|
+$opt_l = ~0; # a really huge number
|
|
+getopts('l:v');
|
|
|
|
my ($OK, $FAILED) = ("ok", "failed");
|
|
if (isatty(fileno(STDOUT))) {
|
|
@@ -25,18 +53,24 @@ if (isatty(fileno(STDOUT))) {
|
|
$FAILED = "\033[31m\033[1m" . $FAILED . "\033[m";
|
|
}
|
|
|
|
+$ENV{"TUSER"} = getpwuid($>);
|
|
+$ENV{"TGROUP"} = getgrgid($));
|
|
+
|
|
sub exec_test($$);
|
|
+sub process_test($$$$);
|
|
|
|
my ($prog, $in, $out) = ([], [], []);
|
|
-my $line_number = 0;
|
|
-my $prog_line;
|
|
+my $prog_line = 0;
|
|
my ($tests, $failed) = (0,0);
|
|
+my $lineno;
|
|
+my $width = ($ENV{COLUMNS} || 80) >> 1;
|
|
|
|
for (;;) {
|
|
- my $line = <>; $line_number++;
|
|
+ my $line = <>; $lineno++;
|
|
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*< ?//) {
|
|
@@ -45,14 +79,14 @@ for (;;) {
|
|
push @$out, $line;
|
|
} else {
|
|
process_test($prog, $prog_line, $in, $out);
|
|
+ last if $prog_line >= $opt_l;
|
|
|
|
$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;
|
|
+ $prog_line = $lineno;
|
|
$in = [];
|
|
$out = [];
|
|
}
|
|
@@ -84,27 +118,37 @@ sub process_test($$$$) {
|
|
print "[$prog_line] \$ ", join(' ',
|
|
map { s/\s/\\$&/g; $_ } @$p), " -- ";
|
|
my $result = exec_test($prog, $in);
|
|
- my $good = 1;
|
|
+ my @good = ();
|
|
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;
|
|
- }
|
|
+ my $use_re;
|
|
+ if (defined $out->[$n] && $out->[$n] =~ /^~ /) {
|
|
+ $use_re = 1;
|
|
+ $out->[$n] =~ s/^~ //g;
|
|
+ }
|
|
+
|
|
+ if (!defined($out->[$n]) || !defined($result->[$n]) ||
|
|
+ (!$use_re && $result->[$n] ne $out->[$n]) ||
|
|
+ ( $use_re && $result->[$n] !~ /^$out->[$n]/)) {
|
|
+ push @good, ($use_re ? '!~' : '!=');
|
|
+ }
|
|
+ else {
|
|
+ push @good, ($use_re ? '=~' : '==');
|
|
+ }
|
|
}
|
|
+ my $good = !(grep /!/, @good);
|
|
$tests++;
|
|
$failed++ unless $good;
|
|
print $good ? $OK : $FAILED, "\n";
|
|
- if (!$good) {
|
|
+ if (!$good || $opt_v) {
|
|
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);
|
|
+ print sprintf("%-" . ($width-3) . "s %s %s\n",
|
|
+ $r, $good[$n], $l);
|
|
}
|
|
- } elsif ($opt_v) {
|
|
- print join('', @$result);
|
|
}
|
|
}
|
|
|
|
@@ -191,11 +235,21 @@ sub exec_test($$) {
|
|
if (!chdir $prog->[1]) {
|
|
return [ "chdir: $prog->[1]: $!\n" ];
|
|
}
|
|
+ $ENV{PWD} = getcwd;
|
|
return [];
|
|
} elsif ($prog->[0] eq "su") {
|
|
return su($prog->[1]);
|
|
} elsif ($prog->[0] eq "sg") {
|
|
return sg($prog->[1]);
|
|
+ } elsif ($prog->[0] eq "export") {
|
|
+ my ($name, $value) = split /=/, $prog->[1];
|
|
+ # FIXME: need to evaluate $value, so that things like this will work:
|
|
+ # export dir=$PWD/dir
|
|
+ $ENV{$name} = $value;
|
|
+ return [];
|
|
+ } elsif ($prog->[0] eq "unset") {
|
|
+ delete $ENV{$prog->[1]};
|
|
+ return [];
|
|
}
|
|
|
|
pipe *IN2, *OUT
|