mirror of
git://git.sv.gnu.org/coreutils.git
synced 2026-07-28 11:29:09 +02:00
half-hearted attempt to support file name quoting
This commit is contained in:
+64
-12
@@ -15,6 +15,19 @@ use Test;
|
||||
|
||||
my $srcdir = '.';
|
||||
|
||||
my $sh_copy_args_from_srcdir = <<\EOF;
|
||||
new_filename_args=
|
||||
for arg in $filename_args; do
|
||||
if test -r $arg; then
|
||||
basename_arg=`echo $arg|sed 's,.*/,,'`
|
||||
test -f $basename_arg || cp -a $arg .
|
||||
arg=$basename_arg
|
||||
fi
|
||||
new_filename_args="$new_filename_args $arg"
|
||||
done
|
||||
filename_args=$new_filename_args
|
||||
EOF
|
||||
|
||||
sub validate
|
||||
{
|
||||
my %seen;
|
||||
@@ -35,6 +48,14 @@ sub validate
|
||||
}
|
||||
}
|
||||
|
||||
sub write_file ($$)
|
||||
{
|
||||
my ($filename, $file_contents) = @_;
|
||||
open F, ">$filename" || die "$0: $filename: $!\n";
|
||||
print F $file_contents;
|
||||
close F || die "$0: $filename: $!\n";
|
||||
}
|
||||
|
||||
# Given a spec for the input file(s) or expected output file of a single
|
||||
# test, create a file for any string. A file is created for each literal
|
||||
# string -- not for named files. Whether a perl `string' is treated as
|
||||
@@ -43,7 +64,10 @@ sub validate
|
||||
# the top level variable to the actual string literal.
|
||||
# If $SPEC is a literal Perl string (not a reference), then treat $SPEC
|
||||
# as the contents of a file.
|
||||
# If $SPEC is a hash reference, then there are no inputs.
|
||||
# If $SPEC is a reference to an empty hash, then there are no inputs.
|
||||
# If $SPEC is a reference to a nonempty hash, then it must have a single
|
||||
# key/value pair (both strings) where the key is the name of the file and
|
||||
# the value is contents desired for that file.
|
||||
# If $SPEC is an array reference, consider each element of the array.
|
||||
# If the element is a string reference, treat the string as the name of
|
||||
# an existing file. Otherwise, the element must be a string and is treated
|
||||
@@ -65,15 +89,30 @@ sub spec_to_list ($$$)
|
||||
my @explicit_file;
|
||||
my @maint_gen_file;
|
||||
my @content_string;
|
||||
my %file_content_pair;
|
||||
|
||||
# If SPEC is a hash reference, return empty lists.
|
||||
# SPEC is a hash reference.
|
||||
if (ref $spec eq 'HASH')
|
||||
{
|
||||
assert ($type eq $In);
|
||||
if (keys %$spec == 0)
|
||||
{
|
||||
# It's an empty hash; return empty lists.
|
||||
}
|
||||
else
|
||||
{
|
||||
# Currently we don't support lists of FILE,CONTENT pairs.
|
||||
assert (keys %$spec == 1);
|
||||
my ($filename, $file_contents) = each %$spec;
|
||||
$file_content_pair{$filename} = $file_contents;
|
||||
write_file $filename, $file_contents;
|
||||
push @maint_gen_file, $filename;
|
||||
}
|
||||
|
||||
return {
|
||||
EXPLICIT => \@explicit_file,
|
||||
MAINT_GEN => \@maint_gen_file
|
||||
};
|
||||
EXPLICIT => \@explicit_file,
|
||||
MAINT_GEN => \@maint_gen_file
|
||||
};
|
||||
}
|
||||
|
||||
if (ref $spec)
|
||||
@@ -115,9 +154,7 @@ sub spec_to_list ($$$)
|
||||
my $suffix = (@content_string > 1 ? $i : '');
|
||||
my $maint_gen_file = "$test_name$type$suffix";
|
||||
push (@maint_gen_file, $maint_gen_file);
|
||||
open (F, ">$srcdir/$maint_gen_file") || die "$0: $maint_gen_file: $!\n";
|
||||
print F $file_contents;
|
||||
close (F) || die "$0: $maint_gen_file: $!\n";
|
||||
write_file "$srcdir/$maint_gen_file", $file_contents;
|
||||
++$i;
|
||||
}
|
||||
|
||||
@@ -204,6 +241,9 @@ sub wrap
|
||||
my %e = map {$_ => 1} @exp;
|
||||
@exp = sort keys %e;
|
||||
|
||||
%e = map {$_ => 1} @maint;
|
||||
@maint = sort keys %e;
|
||||
|
||||
my $len = 77;
|
||||
print join (" \\\n", wrap ($len, 'explicit =', @exp)), "\n";
|
||||
print join (" \\\n", wrap ($len, 'maint_gen =', @maint)), "\n";
|
||||
@@ -214,7 +254,7 @@ sub wrap
|
||||
|
||||
print <<EOF1;
|
||||
#! /bin/sh
|
||||
# This script was generated automatically by build-script.
|
||||
# This script was generated automatically by $0.
|
||||
case \$# in
|
||||
0\) xx='$xx';;
|
||||
*\) xx="\$1";;
|
||||
@@ -280,20 +320,30 @@ EOF1
|
||||
|
||||
if ($via eq 'FILE')
|
||||
{
|
||||
$cmd = "\$xx $flags $file_args > $out 2> $err_output";
|
||||
$cmd = "\$xx $flags \$filename_args > $out 2> $err_output";
|
||||
}
|
||||
elsif ($via eq 'PIPE')
|
||||
{
|
||||
$via_msg = "|$val" if $val;
|
||||
$val ||= 'cat';
|
||||
$cmd = "$val $file_args | \$xx $flags > $out 2> $err_output";
|
||||
$cmd = "$val \$filename_args | \$xx $flags > $out 2> $err_output";
|
||||
}
|
||||
else
|
||||
{
|
||||
assert (@srcdir_rel_in_file == 1);
|
||||
$cmd = "\$xx $flags < $file_args > $out 2> $err_output";
|
||||
$cmd = "\$xx $flags < \$filename_args > $out 2> $err_output";
|
||||
}
|
||||
|
||||
my $use_fileargs_copying_code =
|
||||
(defined $Test::copy_fileargs{"$test_name-$via"}
|
||||
? $Test::copy_fileargs{"$test_name-$via"}
|
||||
: (defined $Test::copy_fileargs{$test_name}
|
||||
? $Test::copy_fileargs{$test_name}
|
||||
: (defined $Test::copy_fileargs_default
|
||||
? $Test::copy_fileargs_default
|
||||
: 0)));
|
||||
my $copy_args = ($use_fileargs_copying_code
|
||||
? $sh_copy_args_from_srcdir : '');
|
||||
my $env = $Test::env{$test_name} || $Test::env_default || [''];
|
||||
my $e;
|
||||
foreach $e (@$env)
|
||||
@@ -305,6 +355,8 @@ EOF1
|
||||
my $e_cmd = ($e ? "$e " : '');
|
||||
++$n_tests;
|
||||
print <<EOF;
|
||||
filename_args="$file_args"
|
||||
$copy_args
|
||||
$e_cmd$cmd
|
||||
code=\$?
|
||||
if test \$code != $e_ret_code ; then
|
||||
|
||||
Reference in New Issue
Block a user