[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
removal of the last vestiges of "fetish" from coreutils
|
From: |
Paul Eggert |
|
Subject: |
removal of the last vestiges of "fetish" from coreutils |
|
Date: |
Wed, 20 Apr 2005 01:05:26 -0700 |
I installed this patch. I think it removes the last instances of the
word "fetish" from coreutils CVS, except for ChangeLog entries.
2005-04-20 Paul Eggert <address@hidden>
"fetish" -> "coreutils" in more places.
* tests/Coreutils.pm: Renamed from tests/Fetish.pm.
(package Coreutils): Renamed from package Fetish. All uses changed.
* tests/Makefile.am (EXTRA_DIST): Add Coreutils.pm and
remove Fetish.pm.
Index: tests/Makefile.am
===================================================================
RCS file: /fetish/cu/tests/Makefile.am,v
retrieving revision 1.20
diff -p -u -r1.20 Makefile.am
--- tests/Makefile.am 5 Apr 2005 11:44:54 -0000 1.20
+++ tests/Makefile.am 20 Apr 2005 07:46:05 -0000
@@ -14,7 +14,7 @@ TESTS_ENVIRONMENT = \
PATH="`pwd`/../src$(PATH_SEPARATOR)$$PATH"
EXTRA_DIST = \
- $(TESTS) .env-warn Fetish.pm Makefile.am.in README envvar-check \
+ $(TESTS) .env-warn Coreutils.pm Makefile.am.in README envvar-check \
expensive group-names input-tty lang-default mk-script priv-check \
rwx-to-mode sample-test setgid-check
Index: tests/basename/basic
===================================================================
RCS file: /fetish/cu/tests/basename/basic,v
retrieving revision 1.5
diff -p -u -r1.5 basic
--- tests/basename/basic 21 Jun 2004 15:04:54 -0000 1.5
+++ tests/basename/basic 20 Apr 2005 07:46:06 -0000
@@ -11,7 +11,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
}
d=$srcdir/..
-exec $PERL -w -I$d -MFetish -- - << \EOF
+exec $PERL -w -I$d -MCoreutils -- - << \EOF
require 5.003;
use strict;
Index: tests/dd/skip-seek
===================================================================
RCS file: /fetish/cu/tests/dd/skip-seek,v
retrieving revision 1.13
diff -p -u -r1.13 skip-seek
--- tests/dd/skip-seek 12 Jan 2005 15:18:54 -0000 1.13
+++ tests/dd/skip-seek 20 Apr 2005 07:46:06 -0000
@@ -13,7 +13,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
SCRIPT_NAME=$0
export SCRIPT_NAME
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
require 5.003;
use strict;
Index: tests/dircolors/simple
===================================================================
RCS file: /fetish/cu/tests/dircolors/simple,v
retrieving revision 1.5
diff -p -u -r1.5 simple
--- tests/dircolors/simple 8 Apr 2003 10:55:01 -0000 1.5
+++ tests/dircolors/simple 20 Apr 2005 07:46:06 -0000
@@ -9,7 +9,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
require 5.003;
use strict;
Index: tests/du/files0-from
===================================================================
RCS file: /fetish/cu/tests/du/files0-from,v
retrieving revision 1.8
diff -p -u -r1.8 files0-from
--- tests/du/files0-from 6 Dec 2004 22:43:07 -0000 1.8
+++ tests/du/files0-from 20 Apr 2005 07:46:06 -0000
@@ -13,7 +13,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
#/
require 5.003;
use strict;
Index: tests/expr/basic
===================================================================
RCS file: /fetish/cu/tests/expr/basic,v
retrieving revision 1.10
diff -p -u -r1.10 basic
--- tests/expr/basic 21 Jun 2004 15:05:03 -0000 1.10
+++ tests/expr/basic 20 Apr 2005 07:46:06 -0000
@@ -11,7 +11,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
}
d=$srcdir/..
-exec $PERL -w -I$d -MFetish -- - << \EOF
+exec $PERL -w -I$d -MCoreutils -- - << \EOF
require 5.003;
use strict;
Index: tests/factor/basic
===================================================================
RCS file: /fetish/cu/tests/factor/basic,v
retrieving revision 1.5
diff -p -u -r1.5 basic
--- tests/factor/basic 21 Sep 2004 22:25:51 -0000 1.5
+++ tests/factor/basic 20 Apr 2005 07:46:07 -0000
@@ -11,7 +11,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
}
d=$srcdir/..
-exec $PERL -w -I$d -MFetish -- - << \EOF
+exec $PERL -w -I$d -MCoreutils -- - << \EOF
require 5.003;
use strict;
Index: tests/fmt/basic
===================================================================
RCS file: /fetish/cu/tests/fmt/basic,v
retrieving revision 1.11
diff -p -u -r1.11 basic
--- tests/fmt/basic 10 Aug 2004 22:47:12 -0000 1.11
+++ tests/fmt/basic 20 Apr 2005 07:46:07 -0000
@@ -12,11 +12,11 @@ $PERL -e 1 > /dev/null 2>&1 || {
# Export this to avoid hassles when run in a UTF-8 locale,
# since we use 8-bit characters below, and those values are
-# interpolated into strings (to perform substitution) in Fetish.pm.
+# interpolated into strings (to perform substitution) in Coreutils.pm.
LC_ALL=C
export LC_ALL
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
require 5.003;
use strict;
Index: tests/ls-2/tests
===================================================================
RCS file: /fetish/cu/tests/ls-2/tests,v
retrieving revision 1.20
diff -p -u -r1.20 tests
--- tests/ls-2/tests 14 Dec 2004 00:42:46 -0000 1.20
+++ tests/ls-2/tests 20 Apr 2005 07:46:08 -0000
@@ -9,7 +9,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - << \EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - << \EOF
require 5.003;
use strict;
Index: tests/md5sum/basic-1
===================================================================
RCS file: /fetish/cu/tests/md5sum/basic-1,v
retrieving revision 1.10
diff -p -u -r1.10 basic-1
--- tests/md5sum/basic-1 31 Aug 2003 11:26:23 -0000 1.10
+++ tests/md5sum/basic-1 20 Apr 2005 07:46:08 -0000
@@ -9,7 +9,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
require 5.003;
use strict;
Index: tests/md5sum/newline-1
===================================================================
RCS file: /fetish/cu/tests/md5sum/newline-1,v
retrieving revision 1.5
diff -p -u -r1.5 newline-1
--- tests/md5sum/newline-1 8 Apr 2003 10:55:01 -0000 1.5
+++ tests/md5sum/newline-1 20 Apr 2005 07:46:08 -0000
@@ -25,7 +25,7 @@ if test $filename_may_contain_newline =
exit 77
fi
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
require 5.003;
use strict;
Index: tests/misc/expand
===================================================================
RCS file: /fetish/cu/tests/misc/expand,v
retrieving revision 1.1
diff -p -u -r1.1 expand
--- tests/misc/expand 9 Jan 2004 21:49:32 -0000 1.1
+++ tests/misc/expand 20 Apr 2005 07:46:08 -0000
@@ -11,7 +11,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
#/
require 5.003;
use strict;
Index: tests/misc/fold
===================================================================
RCS file: /fetish/cu/tests/misc/fold,v
retrieving revision 1.2
diff -p -u -r1.2 fold
--- tests/misc/fold 3 Nov 2003 16:10:58 -0000 1.2
+++ tests/misc/fold 20 Apr 2005 07:46:08 -0000
@@ -24,7 +24,7 @@ case $ver in
exit 1;;
esac
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
#/
require 5.003;
use strict;
Index: tests/misc/head-elide-tail
===================================================================
RCS file: /fetish/cu/tests/misc/head-elide-tail,v
retrieving revision 1.2
diff -p -u -r1.2 head-elide-tail
--- tests/misc/head-elide-tail 4 Jul 2003 10:15:47 -0000 1.2
+++ tests/misc/head-elide-tail 20 Apr 2005 07:46:08 -0000
@@ -11,7 +11,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
#/
require 5.003;
use strict;
Index: tests/misc/paste-no-nl
===================================================================
RCS file: /fetish/cu/tests/misc/paste-no-nl,v
retrieving revision 1.1
diff -p -u -r1.1 paste-no-nl
--- tests/misc/paste-no-nl 27 Aug 2003 11:41:05 -0000 1.1
+++ tests/misc/paste-no-nl 20 Apr 2005 07:46:08 -0000
@@ -11,7 +11,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
#/
require 5.003;
use strict;
Index: tests/misc/sort
===================================================================
RCS file: /fetish/cu/tests/misc/sort,v
retrieving revision 1.2
diff -p -u -r1.2 sort
--- tests/misc/sort 8 Apr 2003 10:55:01 -0000 1.2
+++ tests/misc/sort 20 Apr 2005 07:46:08 -0000
@@ -9,7 +9,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
require 5.003;
use strict;
Index: tests/mv/i-1
===================================================================
RCS file: /fetish/cu/tests/mv/i-1,v
retrieving revision 1.3
diff -p -u -r1.3 i-1
--- tests/mv/i-1 8 Apr 2003 10:55:01 -0000 1.3
+++ tests/mv/i-1 20 Apr 2005 07:46:08 -0000
@@ -9,7 +9,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
require 5.003;
use strict;
Index: tests/rm/empty-name
===================================================================
RCS file: /fetish/cu/tests/rm/empty-name,v
retrieving revision 1.3
diff -p -u -r1.3 empty-name
--- tests/rm/empty-name 8 Apr 2003 10:55:01 -0000 1.3
+++ tests/rm/empty-name 20 Apr 2005 07:46:09 -0000
@@ -13,7 +13,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - << \EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - << \EOF
require 5.003;
use strict;
Index: tests/rm/unreadable
===================================================================
RCS file: /fetish/cu/tests/rm/unreadable,v
retrieving revision 1.2
diff -p -u -r1.2 unreadable
--- tests/rm/unreadable 8 Apr 2003 10:55:01 -0000 1.2
+++ tests/rm/unreadable 20 Apr 2005 07:46:09 -0000
@@ -9,7 +9,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - << \EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - << \EOF
require 5.003;
use strict;
Index: tests/seq/basic
===================================================================
RCS file: /fetish/cu/tests/seq/basic,v
retrieving revision 1.9
diff -p -u -r1.9 basic
--- tests/seq/basic 5 Sep 2003 06:56:38 -0000 1.9
+++ tests/seq/basic 20 Apr 2005 07:46:09 -0000
@@ -11,7 +11,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
}
d=$srcdir/..
-exec $PERL -w -I$d -MFetish -- - << \EOF
+exec $PERL -w -I$d -MCoreutils -- - << \EOF
require 5.003;
use strict;
Index: tests/sha1sum/basic-1
===================================================================
RCS file: /fetish/cu/tests/sha1sum/basic-1,v
retrieving revision 1.4
diff -p -u -r1.4 basic-1
--- tests/sha1sum/basic-1 31 Aug 2003 11:23:57 -0000 1.4
+++ tests/sha1sum/basic-1 20 Apr 2005 07:46:09 -0000
@@ -9,7 +9,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
require 5.003;
use strict;
Index: tests/sha1sum/sample-vec
===================================================================
RCS file: /fetish/cu/tests/sha1sum/sample-vec,v
retrieving revision 1.7
diff -p -u -r1.7 sample-vec
--- tests/sha1sum/sample-vec 8 Apr 2003 10:55:01 -0000 1.7
+++ tests/sha1sum/sample-vec 20 Apr 2005 07:46:10 -0000
@@ -9,7 +9,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
require 5.003;
use strict;
Index: tests/sum/basic-1
===================================================================
RCS file: /fetish/cu/tests/sum/basic-1,v
retrieving revision 1.3
diff -p -u -r1.3 basic-1
--- tests/sum/basic-1 8 Apr 2003 10:55:01 -0000 1.3
+++ tests/sum/basic-1 20 Apr 2005 07:46:11 -0000
@@ -9,7 +9,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
require 5.003;
use strict;
Index: tests/tsort/basic-1
===================================================================
RCS file: /fetish/cu/tests/tsort/basic-1,v
retrieving revision 1.8
diff -p -u -r1.8 basic-1
--- tests/tsort/basic-1 21 Jun 2004 15:05:03 -0000 1.8
+++ tests/tsort/basic-1 20 Apr 2005 07:46:11 -0000
@@ -10,7 +10,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
#/
require 5.003;
use strict;
Index: tests/unexpand/basic-1
===================================================================
RCS file: /fetish/cu/tests/unexpand/basic-1,v
retrieving revision 1.17
diff -p -u -r1.17 basic-1
--- tests/unexpand/basic-1 11 Jan 2005 17:02:57 -0000 1.17
+++ tests/unexpand/basic-1 20 Apr 2005 07:46:11 -0000
@@ -9,7 +9,7 @@ $PERL -e 1 > /dev/null 2>&1 || {
exit 77
}
-exec $PERL -w -I$srcdir/.. -MFetish -- - <<\EOF
+exec $PERL -w -I$srcdir/.. -MCoreutils -- - <<\EOF
require 5.003;
use strict;
--- /dev/null 2003-03-18 13:55:57 -0800
+++ tests/Coreutils.pm 2005-04-20 00:53:09 -0700
@@ -0,0 +1,470 @@
+package Coreutils;
+# This is a testing framework.
+
+require 5.003;
+use strict;
+use vars qw($VERSION @ISA @EXPORT);
+
+use FileHandle;
+use File::Compare qw(compare);
+
address@hidden = qw(Exporter);
+($VERSION = '$Revision: 1.1 $ ') =~ tr/[0-9].//cd;
address@hidden = qw (run_tests);
+
+my $debug = $ENV{DEBUG};
+
+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 OUT_SUBST
ERR_SUBST);
+my $srcdir = $ENV{srcdir};
+my $Global_count = 1;
+
+# When running in a DJGPP environment, make $ENV{SHELL} point to bash.
+# Otherwise, a bad shell might be used (e.g. command.com) and many
+# tests would fail.
+defined $ENV{DJDIR}
+ and $ENV{SHELL} = "$ENV{DJDIR}/bin/bash.exe";
+
+# A file spec: a scalar or a reference to a single-keyed hash
+# ================
+# 'contents' contents only (file name is derived from test name)
+# {filename => 'contents'} filename and contents
+# {filename => undef} filename only -- $(srcdir)/filename must exist
+#
+# FIXME: If there is more than one input file, then you can't specify `REDIR'.
+# PIPE is still ok.
+#
+# I/O spec: a hash ref with the following properties
+# ================
+# - one key/value pair
+# - the key must be one of these strings: IN, OUT, ERR, AUX, CMP, EXIT
+# - the value must be a file spec
+# {OUT => 'data'} put data in a temp file and compare it to stdout from cmd
+# {OUT => {'filename'=>undef}} compare contents of existing filename to
+# stdout from cmd
+# {OUT => {'filename'=>[$CTOR, $DTOR]}} $CTOR and $DTOR are references to
+# functions, each which is passed the single argument `filename'.
+# $CTOR must create `filename'.
+# DTOR may be omitted in which case `sub{unlink @_[0]}' is used.
+# FIXME: implement this
+# {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
+# are concatenated in order on the command line.
+# There may be at most one of the OUT-, ERR-, and EXIT-keyed specs.
+# If the OUT-(or ERR)-keyed hash ref is omitted, then expect no output
+# on stdout (or stderr).
+# If the EXIT-keyed one is omitted, then expect the exit status to be zero.
+
+# FIXME: Make sure that no junkfile is also listed as a
+# non-junkfile (i.e. with undef for contents)
+
+sub _shell_quote ($)
+{
+ my ($string) = @_;
+ $string =~ s/\'/\'\\\'\'/g;
+ return "'$string'";
+}
+
+sub _create_file ($$$$)
+{
+ my ($program_name, $test_name, $file_name, $data) = @_;
+ my $file;
+ if (defined $file_name)
+ {
+ $file = $file_name;
+ }
+ else
+ {
+ $file = "$test_name.$Global_count";
+ ++$Global_count;
+ }
+
+ warn "creating file `$file' with contents `$data'\n" if $debug;
+
+ # The test spec gave a string.
+ # Write it to a temp file and return tempfile name.
+ my $fh = new FileHandle "> $file";
+ die "$program_name: $file: $!\n" if ! $fh;
+ print $fh $data;
+ $fh->close || die "$program_name: $file: $!\n";
+
+ return $file;
+}
+
+sub _compare_files ($$$$$)
+{
+ my ($program_name, $test_name, $in_or_out, $actual, $expected) = @_;
+
+ my $differ = compare ($expected, $actual);
+ if ($differ)
+ {
+ my $info = (defined $in_or_out ? "std$in_or_out " : '');
+ warn "$program_name: test $test_name: ${info}mismatch, comparing "
+ . "$actual (actual) and $expected (expected)\n";
+ # Ignore any failure, discard stderr.
+ system "diff -c $actual $expected 2>/dev/null";
+ }
+
+ return $differ;
+}
+
+sub _process_file_spec ($$$$$)
+{
+ my ($program_name, $test_name, $file_spec, $type, $junk_files) = @_;
+
+ my ($file_name, $contents);
+ if (!ref $file_spec)
+ {
+ ($file_name, $contents) = (undef, $file_spec);
+ }
+ elsif (ref $file_spec eq 'HASH')
+ {
+ my $n = keys %$file_spec;
+ die "$program_name: $test_name: $type spec has $n elements --"
+ . " expected 1\n"
+ if $n != 1;
+ ($file_name, $contents) = each %$file_spec;
+
+ # This happens for the AUX hash in an io_spec like this:
+ # {CMP=> ['zy123utsrqponmlkji', {'@AUX@'=> undef}]},
+ defined $contents
+ or return $file_name;
+ }
+ else
+ {
+ die "$program_name: $test_name: invalid RHS in $type-spec\n"
+ }
+
+ my $is_junk_file = (! defined $file_name
+ || (($type eq 'IN' || $type eq 'AUX' || $type eq 'CMP')
+ && defined $contents));
+ my $file = _create_file ($program_name, $test_name,
+ $file_name, $contents);
+
+ if ($is_junk_file)
+ {
+ push @$junk_files, $file
+ }
+ else
+ {
+ # FIXME: put $srcdir in here somewhere
+ warn "$program_name: $test_name: specified file `$file' does"
+ . " not exist\n"
+ if ! -f "$srcdir/$file";
+ }
+
+ return $file;
+}
+
+sub _at_replace ($$)
+{
+ my ($map, $s) = @_;
+ foreach my $eo (qw (AUX OUT ERR))
+ {
+ my $f = $map->{$eo};
+ $f
+ and $s =~ /address@hidden@/
+ and $s =~ s/address@hidden@/$f/g;
+ }
+ return $s;
+}
+
+# FIXME: cleanup on interrupt
+# FIXME: extract `do_1_test' function
+
+# FIXME: having to include $program_name here is an expedient kludge.
+# Library code doesn't `die'.
+sub run_tests ($$$$$)
+{
+ my ($program_name, $prog, $t_spec, $save_temps, $verbose) = @_;
+
+ # Warn about empty t_spec.
+ # FIXME
+
+ # Remove all temp files upon interrupt.
+ # FIXME
+
+ # Verify that test names are distinct.
+ my $bad_test_name = 0;
+ my %seen;
+ my %seen_8dot3;
+ my $t;
+ foreach $t (@$t_spec)
+ {
+ my $test_name = $t->[0];
+ if ($seen{$test_name})
+ {
+ warn "$program_name: $test_name: duplicate test name\n";
+ $bad_test_name = 1;
+ }
+ $seen{$test_name} = 1;
+
+ if (0)
+ {
+ my $t8 = lc substr $test_name, 0, 8;
+ if ($seen_8dot3{$t8})
+ {
+ warn "$program_name: 8.3 test name conflict: "
+ . "$test_name, $seen_8dot3{$t8}\n";
+ $bad_test_name = 1;
+ }
+ $seen_8dot3{$t8} = $test_name;
+ }
+
+ # The test name may be no longer than 12 bytes,
+ # so that we can add a two-byte suffix without exceeding
+ # the maximum of 14 imposed on some old file systems.
+ if (14 < (length $test_name) + 2)
+ {
+ warn "$program_name: $test_name: test name is too long (> 12)\n";
+ $bad_test_name = 1;
+ }
+ }
+ return 1 if $bad_test_name;
+
+ # FIXME check exit status
+ system ($prog, '--version') if $verbose;
+
+ my @junk_files;
+ my $fail = 0;
+ foreach $t (@$t_spec)
+ {
+ my @post_compare;
+ my $test_name = shift @$t;
+ my $expect = {};
+ my ($pre, $post);
+
+ # FIXME: maybe don't reset this.
+ $Global_count = 1;
+ my @args;
+ my $io_spec;
+ my %seen_type;
+ foreach $io_spec (@$t)
+ {
+ if (!ref $io_spec)
+ {
+ push @args, $io_spec;
+ next;
+ }
+
+ die "$program_name: $test_name: invalid test spec\n"
+ if ref $io_spec ne 'HASH';
+
+ my $n = keys %$io_spec;
+ die "$program_name: $test_name: spec has $n elements --"
+ . " expected 1\n"
+ if $n != 1;
+ my ($type, $val) = each %$io_spec;
+ die "$program_name: $test_name: invalid key `$type' in test spec\n"
+ if ! $Types{$type};
+
+ # Make sure there's no more than one of OUT, ERR, EXIT.
+ die "$program_name: $test_name: more than one $type spec\n"
+ if $Zero_one_type{$type} and $seen_type{$type}++;
+
+ if ($type eq 'PRE' or $type eq 'POST')
+ {
+ $expect->{$type} = $val;
+ next;
+ }
+
+ if ($type eq 'CMP')
+ {
+ my $t = ref $val;
+ $t && $t eq 'ARRAY'
+ or die "$program_name: $test_name: invalid CMP spec\n";
+ @$val == 2
+ or die "$program_name: $test_name: invalid CMP list; must have"
+ . " exactly 2 elements\n";
+ my @cmp_files;
+ foreach my $e (@$val)
+ {
+ my $r = ref $e;
+ $r && $r ne 'HASH'
+ and die "$program_name: $test_name: invalid element ($r)"
+ . " in CMP list; only scalars and hash references "
+ . "are allowed\n";
+ if ($r && $r eq 'HASH')
+ {
+ my $n = keys %$e;
+ $n == 1
+ or die "$program_name: $test_name: CMP spec has $n "
+ . "elements -- expected 1\n";
+
+ # Replace any address@hidden@' in the key of %$e.
+ my ($ff, $val) = each %$e;
+ my $new_ff = _at_replace $expect, $ff;
+ if ($new_ff ne $ff)
+ {
+ $e->{$new_ff} = $val;
+ delete $e->{$ff};
+ }
+ }
+ my $cmp_file = _process_file_spec ($program_name, $test_name,
+ $e, $type, address@hidden);
+ push @cmp_files, $cmp_file;
+ }
+ push @post_compare, address@hidden;
+
+ $expect->{$type} = $val;
+ next;
+ }
+
+ if ($type eq 'EXIT')
+ {
+ die "$program_name: $test_name: invalid EXIT code\n"
+ if $val !~ /^\d+$/;
+ # FIXME: make sure $data is numeric
+ $expect->{EXIT} = $val;
+ 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, address@hidden);
+
+ if ($type eq 'IN')
+ {
+ push @args, _shell_quote $file;
+ }
+ elsif ($type eq 'AUX' || $type eq 'OUT' || $type eq 'ERR')
+ {
+ $expect->{$type} = $file;
+ }
+ else
+ {
+ die "$program_name: $test_name: invalid type: $type\n"
+ }
+ }
+
+ # Expect an exit status of zero if it's not specified.
+ $expect->{EXIT} ||= 0;
+
+ # Allow ERR to be omitted -- in that case, expect no error output.
+ foreach my $eo (qw (OUT ERR))
+ {
+ if (!exists $expect->{$eo})
+ {
+ $expect->{$eo} = _create_file ($program_name, $test_name,
+ undef, '');
+ push @junk_files, $expect->{$eo};
+ }
+ }
+
+ # FIXME: Does it ever make sense to specify a filename *and* contents
+ # in OUT or ERR spec?
+
+ # FIXME: this is really suboptimal...
+ my @new_args;
+ foreach my $a (@args)
+ {
+ $a = _at_replace $expect, $a;
+ push @new_args, $a;
+ }
+ @args = @new_args;
+
+ warn "$test_name...\n" if $verbose;
+ &{$expect->{PRE}} if $expect->{PRE};
+ 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;
+ if ($rc == 0xff00)
+ {
+ warn "$program_name: test $test_name failed: command failed:\n"
+ . " `$cmd_str': $!\n";
+ $fail = 1;
+ goto cleanup;
+ }
+ $rc >>= 8 if $rc > 0x80;
+ if ($expect->{EXIT} != $rc)
+ {
+ warn "$program_name: test $test_name failed: exit status mismatch:"
+ . " expected $expect->{EXIT}, got $rc\n";
+ $fail = 1;
+ goto cleanup;
+ }
+
+ 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";
+
+ # 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, (unlink $orig), next;
+ unlink $orig
+ or (warn "$program_name: cannot unlink $orig: $!\n"),
+ $fail = 1;
+ 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,
+ $actual{$eo}, $expect->{$eo})
+ and $fail = 1;
+ }
+
+ foreach my $pair (@post_compare)
+ {
+ my ($expected, $actual) = @$pair;
+ _compare_files $program_name, $test_name, undef, $actual, $expected
+ and $fail = 1;
+ }
+
+ cleanup:
+ &{$expect->{POST}} if $expect->{POST};
+
+ }
+
+ # FIXME: maybe unlink files inside the big foreach loop?
+ unlink @junk_files if ! $save_temps;
+
+ return $fail;
+}
+
+## package return
+1;
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- removal of the last vestiges of "fetish" from coreutils,
Paul Eggert <=