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

.

Browse Source
This commit is contained in:
Jim Meyering
1998-02-04 18:15:05 +00:00
parent 6e5ac55673
commit ebfdc834f2
3 changed files with 0 additions and 1017 deletions
Download Patch File Download Diff File Expand all files Collapse all files

339
tests/cut/mk-script.pl
View File

@@ -1,339 +0,0 @@
#! @PERL@ -w
# -*- perl -*-
# @configure_input@
my $In = '.I';
my $Out = '.O';
my $Exp = '.X';
my $Err = '.E';
require 5.002;
use strict;
use POSIX qw (assert);
BEGIN { push @INC, '@srcdir@' if '@srcdir@' ne '.'; }
use Test;
my $srcdir = '@srcdir@';
sub validate
{
my %seen;
my $test_vector;
foreach $test_vector (Test::test_vector ())
{
my ($test_name, $flags, $in_spec, $expected, $e_ret_code, $rest) =
@$test_vector;
die "$0: wrong number of elements in test $test_name\n"
if (!defined $e_ret_code || defined $rest);
assert (!ref $test_name);
assert (!ref $flags);
assert (!ref $e_ret_code);
die "$0: duplicate test name \`$test_name'\n"
if (defined $seen{$test_name});
$seen{$test_name} = 1;
}
}
# 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
# a string to be put in a file for a test or the name of an existing file
# depends on how many references have to be traversed to get from
# 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 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
# just like a scalar $SPEC. When a file is created, its name is derived
# from the name TEST_NAME of the corresponding test and the TYPE of file.
# E.g., the inputs for test `3a' would be named t3a.in1 and t3a.in2, and
# the expected output for test `7c' would be named t7c.exp.
#
# Also, return two lists of file names:
# - maintainer-generated files -- names of files created by this function
# - files named explicitly in Test.pm
sub spec_to_list ($$$)
{
my ($spec, $test_name, $type) = @_;
assert ($type eq $In || $type eq $Exp);
my @explicit_file;
my @maint_gen_file;
my @content_string;
# If SPEC is a hash reference, return empty lists.
if (ref $spec eq 'HASH')
{
assert ($type eq $In);
return {
EXPLICIT => \@explicit_file,
MAINT_GEN => \@maint_gen_file
};
}
if (ref $spec)
{
assert (ref $spec eq 'ARRAY' || ref $spec eq 'HASH');
my $file_spec;
foreach $file_spec (@$spec)
{
# A file spec may be a string or a reference.
# If it's a string, that string is to be the contents of a
# generated (by this script) file with name derived from the
# name of this test.
# If it's a reference, then it must be the name of an existing
# file.
if (ref $file_spec)
{
my $r = ref $file_spec;
die "bad test: $test_name is $r\n"
if ref $file_spec ne 'SCALAR';
my $existing_file = $$file_spec;
# FIXME: make sure $existing_file exists somewhere.
push (@explicit_file, $existing_file);
}
else
{
push (@content_string, $file_spec);
}
}
}
else
{
push (@content_string, $spec);
}
my $i = 1;
my $file_contents;
foreach $file_contents (@content_string)
{
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";
++$i;
}
my $n_fail = 0;
foreach $i (@explicit_file, @maint_gen_file)
{
my $max_len = 14;
if (length ($i) > $max_len)
{
warn "$0: $i: generated test file name would be longer than"
. " $max_len characters\n";
++$n_fail;
}
}
exit (1) if $n_fail;
my %h = (
EXPLICIT => \@explicit_file,
MAINT_GEN => \@maint_gen_file
);
return \%h;
}
sub wrap
{
my ($preferred_line_len, @tok) = @_;
assert ($preferred_line_len > 0);
my @lines;
my $line = '';
my $word;
foreach $word (@tok)
{
if ($line && length ($line) + 1 + length ($word) > $preferred_line_len)
{
push (@lines, $line);
$line = $word;
next;
}
my $sp = ($line ? ' ' : '');
$line .= "$sp$word";
}
push (@lines, $line);
return @lines;
}
# ~~~~~~~ main ~~~~~~~~
{
$| = 1;
die "Usage: $0: program-name\n" if @ARGV != 1;
my $xx = $ARGV[0];
if ($xx eq '--list')
{
validate ();
# Output three lists of files:
# EXPLICIT -- file names specified in Test.pm
# MAINT_GEN -- maintainer-generated files
# RUN_GEN -- files created when running the tests
my $test_vector;
my @exp;
my @maint;
my @run;
foreach $test_vector (Test::test_vector ())
{
my ($test_name, $flags, $in_spec, $exp_spec, $e_ret_code)
= @$test_vector;
push (@run, ("$test_name$Out", "$test_name$Err"));
my $in = spec_to_list ($in_spec, $test_name, $In);
push (@exp, @{$in->{EXPLICIT}});
push (@maint, @{$in->{MAINT_GEN}});
my $e = spec_to_list ($exp_spec, $test_name, $Exp);
push (@exp, @{$e->{EXPLICIT}});
push (@maint, @{$e->{MAINT_GEN}});
}
# The list of explicitly mentioned files may contain duplicates.
# Eliminated any duplicates.
my %e = map {$_ => 1} @exp;
@exp = sort keys %e;
my $len = 77;
print join (" \\\n", wrap ($len, 'explicit =', @exp)), "\n";
print join (" \\\n", wrap ($len, 'maint_gen =', @maint)), "\n";
print join (" \\\n", wrap ($len, 'run_gen =', @run)), "\n";
exit 0;
}
print <<EOF1;
#! /bin/sh
# This script was generated automatically by build-script.
case \$# in
0\) xx='$xx';;
*\) xx="\$1";;
esac
test "\$VERBOSE" && echo=echo || echo=:
\$echo testing program: \$xx
errors=0
test "\$srcdir" || srcdir=.
test "\$VERBOSE" && \$xx --version 2> /dev/null
# Make sure we get English translations.
LANGUAGE=C
export LANGUAGE
LC_ALL=C
export LC_ALL
LANG=C
export LANG
EOF1
validate ();
my $n_tests = 0;
my $test_vector;
foreach $test_vector (Test::test_vector ())
{
my ($test_name, $flags, $in_spec, $exp_spec, $e_ret_code)
= @$test_vector;
my $in = spec_to_list ($in_spec, $test_name, $In);
my @srcdir_rel_in_file;
my $f;
foreach $f (@{$in->{EXPLICIT}}, @{$in->{MAINT_GEN}})
{
push (@srcdir_rel_in_file, "\$srcdir/$f");
}
my $exp = spec_to_list ($exp_spec, $test_name, $Exp);
my @all = (@{$exp->{EXPLICIT}}, @{$exp->{MAINT_GEN}});
assert (@all == 1);
my $exp_name = "\$srcdir/$all[0]";
my $out = "$test_name$Out";
my $err_output = "$test_name$Err";
my %valid_via = map {$_ => 1} qw (REDIR FILE PIPE);
my %via_msg_string = (REDIR => '<', FILE => 'F', PIPE => '|');
# Inhibit warnings about `used only once'.
die if 0 && $Test::input_via{$test_name} && $Test::input_via_default;
die if 0 && $Test::env{$test_name} && $Test::env_default;
my $vias = $Test::input_via{$test_name} || $Test::input_via_default
|| {FILE => 0};
my $n_vias = keys %$vias;
my ($via, $val);
while (($via, $val) = each %$vias)
{
my $cmd;
my $via_msg = ($n_vias == 1 ? '' : $via_msg_string{$via});
my $file_args = join (' ', @srcdir_rel_in_file);
if ($via eq 'FILE')
{
$cmd = "\$xx $flags $file_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";
}
else
{
assert (@srcdir_rel_in_file == 1);
$cmd = "\$xx $flags < $file_args > $out 2> $err_output";
}
my $env = $Test::env{$test_name} || $Test::env_default || [''];
my $e;
foreach $e (@$env)
{
my $sep = ($via_msg && $e ? ':' : '');
my $msg = "$e$sep$via_msg";
$msg = "($msg)" if $msg;
my $t_name = "$test_name$msg";
my $e_cmd = ($e ? "$e " : '');
++$n_tests;
print <<EOF;
$e_cmd$cmd
code=\$?
if test \$code != $e_ret_code ; then
\$echo "Test $t_name failed: $xx return code \$code differs from expected value $e_ret_code" 1>&2
errors=`expr \$errors + 1`
else
cmp $out $exp_name > /dev/null 2>&1
case \$? in
0) if test "\$VERBOSE" ; then \$echo "passed $t_name"; fi ;;
1) \$echo "Test $t_name failed: files $out and $exp_name differ" 1>&2;
errors=`expr \$errors + 1` ;;
2) \$echo "Test $t_name may have failed." 1>&2;
\$echo The command \"cmp $out $exp_name\" failed. 1>&2 ;
errors=`expr \$errors + 1` ;;
esac
fi
test -s $err_output || rm -f $err_output
EOF
}
}
}
print <<EOF3 ;
if test \$errors = 0 ; then
\$echo Passed all $n_tests tests. 1>&2
else
\$echo Failed \$errors tests. 1>&2
fi
test \$errors = 0 || errors=1
exit \$errors
EOF3
}