tests/ls-2/tests

   1 #!/bin/sh
   2
   3 : ${PERL=perl}
   4 : ${srcdir=.}
   5
   6 $PERL -e 1 > /dev/null 2>&1 || {
   7   echo 1>&2 "$0: configure didn't find a usable version of Perl," \
   8     "so can't run this test"
   9   exit 77
  10 }
  11
  12 exec $PERL -w -I$srcdir/.. -MFetish -- - << \EOF
  13 require 5.003;
  14 use strict;
  15
  16 (my $program_name = $0) =~ s|.*/||;
  17
  18 # Turn off localisation of executable's ouput.
  19 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
  20
  21 warn "PATH=$ENV{PATH}\n";
  22
  23 my $mkdir = {PRE => sub {mkdir 'd',0755 or die "d: $!\n"}};
  24 my $rmdir = {POST => sub {rmdir 'd' or die "d: $!\n"}};
  25
  26 my $mkdir2 = {PRE => sub {mkdir 'd',0755 or die "d: $!\n";
  27                           mkdir 'd/e',0755 or die "d/e: $!\n" }};
  28 my $rmdir2 = {POST => sub {rmdir 'd/e' or die "d/e: $!\n";
  29                            rmdir 'd' or die "d: $!\n" }};
  30
  31 my $slink_d = {PRE => sub {symlink '/', 'd' or die "d: $!\n";
  32                            $ENV{LS_COLORS}='ln=01;36:di=01;34:or=40;31;01'
  33                            }};
  34 my $unlink_d = {POST => sub {unlink 'd' or die "d: $!\n"}};
  35
  36 sub make_j_d ()
  37 {
  38   mkdir 'j', 0700 or die "creating j: $!\n";
  39   (open F, '>j/d') && close F or die "creating j/d: $!\n";
  40   chmod 0555, 'j/d' or die "making j/d executable: $!\n";
  41 }
  42
  43 my $exe_in_subdir = {PRE => sub { make_j_d (); $ENV{LS_COLORS}='ex=01;32' }};
  44 my $remove_j = {POST => sub {unlink 'j/d' or die "j/d: $!\n";
  45                              rmdir 'j' or die "j: $!\n" }};
  46
  47 my $q_bell = {IN => {"q\a" => ''}};
  48 my @Tests =
  49     (
  50      # test-name options input expected-output
  51      #
  52      # quoting tests............................................
  53      ['q-',        $q_bell, {OUT => "q\a\n"}, {EXIT => 0}],
  54      ['q-N', '-N', $q_bell, {OUT => "q\a\n"}, {ERR => ''}],
  55      ['q-q', '-q', $q_bell, {OUT => "q?\n"}],
  56      ['q-Q', '-Q', $q_bell, {OUT => "\"q\\a\"\n"}],
  57
  58      ['q-lit-q', '--quoting=literal -q',     $q_bell, {OUT => "q?\n"}],
  59      ['q-qs-lit', '--quoting=literal',       $q_bell, {OUT => "q\a\n"}],
  60      ['q-qs-sh', '--quoting=shell',          $q_bell, {OUT => "q\a\n"}],
  61      ['q-qs-sh-a', '--quoting=shell-always', $q_bell, {OUT => "'q\a'\n"}],
  62      ['q-qs-c', '--quoting=c',               $q_bell, {OUT => "\"q\\a\"\n"}],
  63      ['q-qs-esc', '--quoting=escape',        $q_bell, {OUT => "q\\a\n"}],
  64      ['q-qs-c-1', '--quoting=c',
  65       {IN => {"t\004" => ''}}, {OUT => "\"t\\004\"\n"}],
  66
  67      ['emptydir', 'd',  {OUT => ''}, $mkdir, $rmdir],
  68      ['emptydir-x2', 'd d',  {OUT => "d:\n\nd:\n"}, $mkdir, $rmdir],
  69      ['emptydir-R', '-R d',  {OUT => "d:\n"}, $mkdir, $rmdir],
  70
  71      # test `ls -R .' ............................................
  72      ['R-dot', '--ignore="[a-ce-zA-Z]*" -R .',  {OUT => ".:\nd\n\n\./d:\n"},
  73       $mkdir, $rmdir],
  74
  75      ['slink-dir-F',     '-F d', {OUT => "d@\n"}, $slink_d, $unlink_d],
  76      ['slink-dir-dF',   '-dF d', {OUT => "d@\n"}, $slink_d, $unlink_d],
  77      ['slinkdir-dFH',  '-dFH d', {OUT => "d/\n"}, $slink_d, $unlink_d],
  78      ['slinkdir-dFL',  '-dFL d', {OUT => "d/\n"}, $slink_d, $unlink_d],
  79
  80      # Test for a bug that was fixed in coreutils-4.5.4.
  81      ['sl-F-color', '-F --color=always d',
  82                                  {OUT => "\e[0m\e[01;36md\e[0m\@\n\e[m"},
  83                                   $slink_d, $unlink_d],
  84      ['sl-dF-color', '-dF --color=always d',
  85                                  {OUT => "\e[0m\e[01;36md\e[0m\@\n\e[m"},
  86                                   $slink_d, $unlink_d],
  87
  88      # Test for a bug that was introduced in coreutils-4.5.4; fixed in 4.5.5.
  89      # To demonstrate it, the file in question (with executable bit set)
  90      # must not be a command line argument.
  91      ['color-exe1', '--color=always j',
  92                                  {OUT => "\e[0m\e[01;32md\e[0m\n\e[m"},
  93                                   $exe_in_subdir, $remove_j],
  94
  95      # From Stéphane Chazelas.
  96      ['no-a-isdir-b', 'no-dir d',
  97          {OUT => "d:\n"},
  98          {ERR => "ls: no-dir: No such file or directory\n"},
  99          $mkdir, $rmdir, {EXIT => 1}],
 100
 101      ['recursive-2', '-R d', {OUT => "d:\ne\n\nd/e:\n"}, $mkdir2, $rmdir2],
 102     );
 103
 104 my $save_temps = $ENV{SAVE_TEMPS};
 105 my $verbose = $ENV{VERBOSE};
 106
 107 my $prog = $ENV{PROG} || die "$0: \$PROG not specified in environment\n";
 108 my $fail = run_tests ($program_name, $prog, \@Tests, $save_temps, $verbose);
 109 exit $fail;
 110 EOF