tests/ls-2/tests

   1 #!/bin/sh
   2 # -*- perl -*-
   3
   4 # Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free
   5 # Software Foundation, Inc.
   6
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 2 of the License, or
  10 # (at your option) any later version.
  11
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  20 # 02110-1301, USA.
  21
  22 : ${PERL=perl}
  23 : ${srcdir=.}
  24
  25 $PERL -e 1 > /dev/null 2>&1 || {
  26   echo 1>&2 "$0: configure didn't find a usable version of Perl," \
  27     "so can't run this test"
  28   exit 77
  29 }
  30
  31 # Set up files used by the setuid-etc tests; skip this entire test if
  32 # that cannot be done for some reason.
  33 test=../../src/test
  34 touch setuid && chmod u+s setuid && $test -u setuid &&
  35 touch setgid && chmod g+s setgid && $test -g setgid &&
  36 mkdir sticky && chmod +t sticky  && $test -k sticky &&
  37 mkdir owt    && chmod +t,o+w owt && $test -k owt &&
  38 mkdir owr    && chmod o+w owr || {
  39   echo 1>&2 "$0: cannot create setuid/setgid/sticky files," \
  40     "so can't run this test"
  41   exit 77
  42 }
  43
  44 exec $PERL -w -I$srcdir/.. -MCoreutils -- - << \EOF
  45 require 5.003;
  46 use strict;
  47
  48 (my $program_name = $0) =~ s|.*/||;
  49
  50 # Turn off localisation of executable's ouput.
  51 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
  52
  53 my $mkdir = {PRE => sub {mkdir 'd',0755 or die "d: $!\n"}};
  54 my $rmdir = {POST => sub {rmdir 'd' or die "d: $!\n"}};
  55
  56 my $mkdir2 = {PRE => sub {mkdir 'd',0755 or die "d: $!\n";
  57                           mkdir 'd/e',0755 or die "d/e: $!\n" }};
  58 my $rmdir2 = {POST => sub {rmdir 'd/e' or die "d/e: $!\n";
  59                            rmdir 'd' or die "d: $!\n" }};
  60
  61 my $slink_d = {PRE => sub {symlink '/', 'd' or die "d: $!\n";
  62                            $ENV{LS_COLORS}='ln=01;36:di=01;34:or=40;31;01'
  63                            }};
  64 my $unlink_d = {POST => sub {unlink 'd' or die "d: $!\n"}};
  65
  66 my $mkdir_d_slink = {PRE => sub {mkdir 'd',0755 or die "d: $!\n";
  67                                  symlink '/', 'd/s' or die "d/s: $!\n" }};
  68 my $rmdir_d_slink = {POST => sub {unlink 'd/s' or die "d/s: $!\n";
  69                                   rmdir 'd' or die "d: $!\n" }};
  70
  71 sub make_j_d ()
  72 {
  73   mkdir 'j', 0700 or die "creating j: $!\n";
  74   (open F, '>j/d') && close F or die "creating j/d: $!\n";
  75   chmod 0555, 'j/d' or die "making j/d executable: $!\n";
  76 }
  77
  78 my $exe_in_subdir = {PRE => sub { make_j_d (); $ENV{LS_COLORS}='ex=01;32' }};
  79 my $remove_j = {POST => sub {unlink 'j/d' or die "j/d: $!\n";
  80                              rmdir 'j' or die "j: $!\n" }};
  81
  82 my $q_bell = {IN => {"q\a" => ''}};
  83 my @Tests =
  84     (
  85      # test-name options input expected-output
  86      #
  87      # quoting tests............................................
  88      ['q-',        $q_bell, {OUT => "q\a\n"}, {EXIT => 0}],
  89      ['q-N', '-N', $q_bell, {OUT => "q\a\n"}, {ERR => ''}],
  90      ['q-q', '-q', $q_bell, {OUT => "q?\n"}],
  91      ['q-Q', '-Q', $q_bell, {OUT => "\"q\\a\"\n"}],
  92
  93      ['q-lit-q', '--quoting=literal -q',     $q_bell, {OUT => "q?\n"}],
  94      ['q-qs-lit', '--quoting=literal',       $q_bell, {OUT => "q\a\n"}],
  95      ['q-qs-sh', '--quoting=shell',          $q_bell, {OUT => "q\a\n"}],
  96      ['q-qs-sh-a', '--quoting=shell-always', $q_bell, {OUT => "'q\a'\n"}],
  97      ['q-qs-c', '--quoting=c',               $q_bell, {OUT => "\"q\\a\"\n"}],
  98      ['q-qs-esc', '--quoting=escape',        $q_bell, {OUT => "q\\a\n"}],
  99      ['q-qs-c-1', '--quoting=c',
 100       {IN => {"t\004" => ''}}, {OUT => "\"t\\004\"\n"}],
 101
 102      ['emptydir', 'd',  {OUT => ''}, $mkdir, $rmdir],
 103      ['emptydir-x2', 'd d',  {OUT => "d:\n\nd:\n"}, $mkdir, $rmdir],
 104      ['emptydir-R', '-R d',  {OUT => "d:\n"}, $mkdir, $rmdir],
 105
 106      # test `ls -R .' ............................................
 107      ['R-dot', '--ignore="[a-ce-zA-Z]*" -R .',  {OUT => ".:\nd\n\n\./d:\n"},
 108       $mkdir, $rmdir],
 109
 110      ['slink-dir-F',     '-F d', {OUT => "d@\n"}, $slink_d, $unlink_d],
 111      ['slink-dir-dF',   '-dF d', {OUT => "d@\n"}, $slink_d, $unlink_d],
 112      ['slinkdir-dFH',  '-dFH d', {OUT => "d/\n"}, $slink_d, $unlink_d],
 113      ['slinkdir-dFL',  '-dFL d', {OUT => "d/\n"}, $slink_d, $unlink_d],
 114
 115      # Test for a bug that was fixed in coreutils-4.5.4.
 116      ['sl-F-color', '-F --color=always d',
 117                                  {OUT => "\e[0m\e[01;36md\e[0m\@\n\e[m"},
 118                                   $slink_d, $unlink_d],
 119      ['sl-dF-color', '-dF --color=always d',
 120                                  {OUT => "\e[0m\e[01;36md\e[0m\@\n\e[m"},
 121                                   $slink_d, $unlink_d],
 122
 123      # Test for a bug that was introduced in coreutils-4.5.4; fixed in 4.5.5.
 124      # To demonstrate it, the file in question (with executable bit set)
 125      # must not be a command line argument.
 126      ['color-exe1', '--color=always j',
 127                                  {OUT => "\e[0m\e[01;32md\e[0m\n\e[m"},
 128                                   $exe_in_subdir, $remove_j],
 129
 130      # From Stéphane Chazelas.
 131      ['no-a-isdir-b', 'no-dir d',
 132          {OUT => "d:\n"},
 133          {ERR => "ls: cannot access no-dir: No such file or directory\n"},
 134          $mkdir, $rmdir, {EXIT => 2}],
 135
 136      ['recursive-2', '-R d', {OUT => "d:\ne\n\nd/e:\n"}, $mkdir2, $rmdir2],
 137
 138      ['setuid-etc', '-1 -d --color=always owr owt setgid setuid sticky',
 139          {OUT =>
 140             "\e[0m\e[34;42mowr\e[0m\n"
 141             . "\e[30;42mowt\e[0m\n"
 142             . "\e[30;43msetgid\e[0m\n"
 143             . "\e[37;41msetuid\e[0m\n"
 144             . "\e[37;44msticky\e[0m\n"
 145             . "\e[m"
 146          },
 147
 148         {POST => sub {
 149          unlink qw(setuid setgid);
 150          foreach my $dir (qw(owr owt sticky)) {rmdir $dir} }},
 151          ],
 152
 153      # For 5.97 and earlier, --file-type acted like --indicator-style=slash.
 154      ['file-type', '--file-type d', {OUT => "s@\n"},
 155       $mkdir_d_slink, $rmdir_d_slink],
 156     );
 157
 158 my $save_temps = $ENV{SAVE_TEMPS};
 159 my $verbose = $ENV{VERBOSE};
 160
 161 my $prog = $ENV{PROG} || die "$0: \$PROG not specified in environment\n";
 162 my $fail = run_tests ($program_name, $prog, \@Tests, $save_temps, $verbose);
 163 exit $fail;
 164 EOF