]> git.ipfire.org Git - thirdparty/coreutils.git/commitdiff
half-hearted attempt to support file name quoting
authorJim Meyering <jim@meyering.net>
Mon, 5 Oct 1998 04:20:12 +0000 (04:20 +0000)
committerJim Meyering <jim@meyering.net>
Mon, 5 Oct 1998 04:20:12 +0000 (04:20 +0000)
tests/mk-script

index 0f360ac301c82c466281f2dc3615b18801bb783f..579e373be0b72bd71b044c2caf966bf1db4761ae 100755 (executable)
@@ -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