From 4d18074ad9c3aeb0efdada2ff1d15726315f109e Mon Sep 17 00:00:00 2001 From: Andreas Gruenbacher Date: Mon, 23 Feb 2009 00:37:43 +0100 Subject: Update the run script to a more recent version 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. Add a >~ test line that is similar to > but is interpreted as a regular expression. Signed-off-by: Brandon Philips Signed-off-by: Andreas Gruenbacher --- test/run | 87 ++++++++++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 69 insertions(+), 18 deletions(-) mode change 100644 => 100755 test/run diff --git a/test/run b/test/run old mode 100644 new mode 100755 index c4d017a..40b3565 --- a/test/run +++ b/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))) { @@ -26,17 +54,20 @@ if (isatty(fileno(STDOUT))) { } 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 +76,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 /(? @$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 +232,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 -- cgit v1.2.3