tests/misc/dirname

   1 #!/bin/sh
   2 # -*-perl-*-
   3 # Test "dirname".
   4
   5 # Copyright (C) 2006 Free 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 d=$srcdir/..
  32 exec $PERL -w -I$d -MCoreutils -- - << \EOF
  33 require 5.003;
  34 use strict;
  35 use File::stat;
  36
  37 (my $program_name = $0) =~ s|.*/||;
  38
  39 # Turn off localisation of executable's ouput.
  40 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
  41
  42 my $stat_single = stat('/');
  43 my $stat_double = stat('//');
  44 my $double_slash = ($stat_single->dev == $stat_double->dev
  45                     && $stat_single->ino == $stat_double->ino) ? '/' : '//';
  46
  47 my $prog = $ENV{PROG} || die "$0: \$PROG not specified in environment\n";
  48
  49 my @Tests =
  50     (
  51      ['fail-1', {ERR => "$prog: missing operand\n"
  52        . "Try `$prog --help' for more information.\n"}, {EXIT => '1'}],
  53      ['fail-2', qw(a b), {ERR => "$prog: extra operand `b'\n"
  54        . "Try `$prog --help' for more information.\n"}, {EXIT => '1'}],
  55
  56      ['a', qw(d/f),        {OUT => 'd'}],
  57      ['b', qw(/d/f),       {OUT => '/d'}],
  58      ['c', qw(d/f/),       {OUT => 'd'}],
  59      ['d', qw(d/f//),      {OUT => 'd'}],
  60      ['e', qw(f),          {OUT => '.'}],
  61      ['f', qw(/),          {OUT => '/'}],
  62      ['g', qw(//),         {OUT => "$double_slash"}],
  63      ['h', qw(///),        {OUT => '/'}],
  64      ['i', qw(//a//),      {OUT => "$double_slash"}],
  65      ['j', qw(///a///),    {OUT => '/'}],
  66      ['k', qw(///a///b),   {OUT => '///a'}],
  67      ['l', qw(///a//b/),   {OUT => '///a'}],
  68      ['m', qw(''),         {OUT => '.'}],
  69     );
  70
  71 # Append a newline to end of each expected `OUT' string.
  72 my $t;
  73 foreach $t (@Tests)
  74   {
  75     my $arg1 = $t->[1];
  76     my $e;
  77     foreach $e (@$t)
  78       {
  79         $e->{OUT} = "$e->{OUT}\n"
  80           if ref $e eq 'HASH' and exists $e->{OUT};
  81       }
  82   }
  83
  84 my $save_temps = $ENV{SAVE_TEMPS};
  85 my $verbose = $ENV{VERBOSE};
  86
  87 my $fail = run_tests ($program_name, $prog, \@Tests, $save_temps, $verbose);
  88 exit $fail;
  89 EOF