1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
#!/bin/sh
: ${PERL=perl}
: ${srcdir=.}
case "$PERL" in
*'missing perl')
echo 1>&2 "$0: configure didn't find a usable version of Perl, so can't run this test"
exit 77
;;
esac
exec $PERL -w -I$srcdir/.. -MFetish -- - << \EOF
require 5.003;
use strict;
(my $program_name = $0) =~ s|.*/||;
# Turn off localisation of executable's ouput.
@ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
my $mkdir = {PRE => sub {mkdir 'd',0755 or die "d: $!\n"}};
my $rmdir = {POST => sub {rmdir 'd' or die "d: $!\n"}};
my $mkdir2 = {PRE => sub {mkdir 'd',0755 or die "d: $!\n";
mkdir 'd/e',0755 or die "d/e: $!\n" }};
my $rmdir2 = {POST => sub {rmdir 'd/e' or die "d/e: $!\n";
rmdir 'd' or die "d: $!\n" }};
my $slink_d = {PRE => sub {symlink '/', 'd' or die "d: $!\n"}};
my $unlink_d = {POST => sub {unlink 'd' or die "d: $!\n"}};
my $q_bell = {IN => {"q\a" => ''}};
my @Tests =
(
# test-name options input expected-output
#
# quoting tests............................................
['q-', $q_bell, {OUT => "q\a\n"}, {EXIT => 0}],
['q-N', '-N', $q_bell, {OUT => "q\a\n"}, {ERR => ''}],
['q-q', '-q', $q_bell, {OUT => "q?\n"}],
['q-Q', '-Q', $q_bell, {OUT => "\"q\\a\"\n"}],
['q-lit-q', '--quoting=literal -q', $q_bell, {OUT => "q?\n"}],
['q-qs-lit', '--quoting=literal', $q_bell, {OUT => "q\a\n"}],
['q-qs-sh', '--quoting=shell', $q_bell, {OUT => "q\a\n"}],
['q-qs-sh-a', '--quoting=shell-always', $q_bell, {OUT => "'q\a'\n"}],
['q-qs-c', '--quoting=c', $q_bell, {OUT => "\"q\\a\"\n"}],
['q-qs-esc', '--quoting=escape', $q_bell, {OUT => "q\\a\n"}],
['q-qs-c-1', '--quoting=c',
{IN => {"t\004" => ''}}, {OUT => "\"t\\004\"\n"}],
['emptydir', 'd', {OUT => ''}, $mkdir, $rmdir],
['emptydir-x2', 'd d', {OUT => "d:\n\nd:\n"}, $mkdir, $rmdir],
['emptydir-R', '-R d', {OUT => "d:\n"}, $mkdir, $rmdir],
# test `ls -R .' ............................................
['R-dot', '--ignore="[a-ce-zA-Z]*" -R .', {OUT => ".:\nd\n\n\./d:\n"},
$mkdir, $rmdir],
['slink-dir-F', '-F d', {OUT => "d@\n"}, $slink_d, $unlink_d],
['slink-dir-dF', '-dF d', {OUT => "d@\n"}, $slink_d, $unlink_d],
['slinkdir-dFH', '-dFH d', {OUT => "d/\n"}, $slink_d, $unlink_d],
['slinkdir-dFL', '-dFL d', {OUT => "d/\n"}, $slink_d, $unlink_d],
# From Stéphane Chazelas.
['no-a-isdir-b', 'no-dir d',
{OUT => "d:\n"},
{ERR => "ls: no-dir: No such file or directory\n"},
$mkdir, $rmdir, {EXIT => 1}],
['recursive-2', '-R d', {OUT => "d:\ne\n\nd/e:\n"}, $mkdir2, $rmdir2],
);
my $save_temps = $ENV{SAVE_TEMPS};
my $verbose = $ENV{VERBOSE};
my $prog = $ENV{PROG} || die "$0: \$PROG not specified in environment\n";
my $fail = run_tests ($program_name, $prog, \@Tests, $save_temps, $verbose);
exit $fail;
EOF
|
