CC-tea/coreutils
1
0
Fork 0
mirror of git://git.sv.gnu.org/coreutils.git synced 2026-04-21 11:16:16 +02:00
Code Issues Projects Releases Wiki Activity

Accept new directives: OUT_SUBST, ERR_SUBST.

Browse Source 
Rename `%tmp' to `%actual'.  Reverse order of last two args to
_compare_files (to actual, $expected) so as to match declaration.
This commit is contained in:
Jim Meyering
2004-03-29 09:23:36 +00:00
parent 1cf3f4352a
commit 216904e67c
1 changed files with 59 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

71
tests/Fetish.pm
View File

@@ -12,14 +12,14 @@ use FileHandle;
use File::Compare qw(compare);
@ISA = qw(Exporter);
($VERSION = '$Revision: 1.14 $ ') =~ tr/[0-9].//cd;
($VERSION = '$Revision: 1.15 $ ') =~ tr/[0-9].//cd;
@EXPORT = qw (run_tests);
my $debug = $ENV{DEBUG};
my @Types = qw (IN OUT ERR AUX CMP EXIT PRE POST);
my @Types = qw (IN OUT ERR AUX CMP EXIT PRE POST OUT_SUBST ERR_SUBST);
my %Types = map {$_ => 1} @Types;
my %Zero_one_type = map {$_ => 1} qw (OUT ERR EXIT PRE POST);
my %Zero_one_type = map {$_ => 1} qw (OUT ERR EXIT PRE POST OUT_SUBST ERR_SUBST);
my $srcdir = $ENV{srcdir};
my $Global_count = 1;
@@ -51,7 +51,18 @@ defined $ENV{DJDIR}
# $CTOR must create `filename'.
# DTOR may be omitted in which case `sub{unlink @_[0]}' is used.
# FIXME: implement this
# Ditto for `ERR', but compare with stderr
# {ERR => ...}
# Same as for OUT, but compare with stderr, not stdout.
# {OUT_SUBST => 's/variable_output/expected_output/'}
# Transform actual standard output before comparing it against expected output.
# This is useful e.g. for programs like du that produce output that
# varies a lot from system. E.g., an empty file may consume zero file
# blocks, or more, depending on the OS and on the file system type.
# {ERR_SUBST => 's/variable_output/expected_output/'}
# Transform actual stderr output before comparing it against expected.
# This is useful when verifying that we get a meaningful diagnostic.
# For example, in rm/fail-2eperm, we have to account for three different
# diagnostics: Operation not permitted, Not owner, and Permission denied.
# {EXIT => N} expect exit status of cmd to be N
#
# There may be many input file specs. File names from the input specs
@@ -312,6 +323,13 @@ sub run_tests ($$$$$)
next;
}
if ($type =~ /^(OUT|ERR)_SUBST$/)
{
$expect->{RESULT_SUBST} ||= {};
$expect->{RESULT_SUBST}->{$1} = $val;
next;
}
my $file = _process_file_spec ($program_name, $test_name, $val,
$type, \@junk_files);
@@ -357,11 +375,11 @@ sub run_tests ($$$$$)
warn "$test_name...\n" if $verbose;
&{$expect->{PRE}} if $expect->{PRE};
my %tmp;
$tmp{OUT} = "$test_name.O";
$tmp{ERR} = "$test_name.E";
push @junk_files, $tmp{OUT}, $tmp{ERR};
my @cmd = ($prog, @args, "> $tmp{OUT}", "2> $tmp{ERR}");
my %actual;
$actual{OUT} = "$test_name.O";
$actual{ERR} = "$test_name.E";
push @junk_files, $actual{OUT}, $actual{ERR};
my @cmd = ($prog, @args, "> $actual{OUT}", "2> $actual{ERR}");
my $cmd_str = join ' ', @cmd;
warn "Running command: `$cmd_str'\n" if $debug;
my $rc = 0xffff & system $cmd_str;
@@ -383,16 +401,45 @@ sub run_tests ($$$$$)
foreach my $eo (qw (OUT ERR))
{
my $subst_expr = $expect->{RESULT_SUBST}->{$eo};
if (defined $subst_expr)
{
my $out = $actual{$eo};
my $orig = "$out.orig";
warn "rename $out, $orig";
# Move $out aside (to $orig), then then recreate $out
# by transforming each line of $orig via $subst_expr.
rename $out, $orig
or (warn "$program_name: cannot rename $out to $orig: $!\n"),
$fail = 1, next;
open IN, $orig
or (warn "$program_name: cannot open $orig for reading: $!\n"),
$fail = 1, next;
open OUT, ">$out"
or (warn "$program_name: cannot open $out for writing: $!\n"),
$fail = 1, next;
while (defined (my $line = <IN>))
{
eval "\$_ = \$line; $subst_expr; \$line = \$_";
print OUT $line;
}
close IN;
close OUT
or (warn "$program_name: failed to write $out: $!\n"),
$fail = 1, next;
}
my $eo_lower = lc $eo;
_compare_files ($program_name, $test_name, $eo_lower,
$expect->{$eo}, $tmp{$eo})
$actual{$eo}, $expect->{$eo})
and $fail = 1;
}
foreach my $pair (@post_compare)
{
my ($a, $b) = @$pair;
_compare_files $program_name, $test_name, undef, $a, $b
my ($expected, $actual) = @$pair;
_compare_files $program_name, $test_name, undef, $actual, $expected
and $fail = 1;
}