tests/misc/basename

   1 #!/bin/sh
   2 # -*-perl-*-
   3
   4 # Copyright (C) 2006 Free Software Foundation, Inc.
   5
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  19 # 02110-1301, USA.
  20
  21 : ${PERL=perl}
  22 : ${srcdir=.}
  23
  24 $PERL -e 1 > /dev/null 2>&1 || {
  25   echo 1>&2 "$0: configure didn't find a usable version of Perl," \
  26     "so can't run this test"
  27   exit 77
  28 }
  29
  30 d=$srcdir/..
  31 exec $PERL -w -I$d -MCoreutils -- - << \EOF
  32 require 5.003;
  33 use strict;
  34 use File::stat;
  35
  36 (my $program_name = $0) =~ s|.*/||;
  37
  38 # Turn off localisation of executable's ouput.
  39 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
  40
  41 my $stat_single = stat('/');
  42 my $stat_double = stat('//');
  43 my $double_slash = ($stat_single->dev == $stat_double->dev
  44                     && $stat_single->ino == $stat_double->ino) ? '/' : '//';
  45
  46 my $prog = $ENV{PROG} || die "$0: \$PROG not specified in environment\n";
  47
  48 my @Tests =
  49     (
  50      ['fail-1', {ERR => "$prog: missing operand\n"
  51        . "Try `$prog --help' for more information.\n"}, {EXIT => '1'}],
  52      ['fail-2', qw(a b c), {ERR => "$prog: extra operand `c'\n"
  53        . "Try `$prog --help' for more information.\n"}, {EXIT => '1'}],
  54
  55      ['a', qw(d/f),        {OUT => 'f'}],
  56      ['b', qw(/d/f),       {OUT => 'f'}],
  57      ['c', qw(d/f/),       {OUT => 'f'}],
  58      ['d', qw(d/f//),      {OUT => 'f'}],
  59      ['e', qw(f),          {OUT => 'f'}],
  60      ['f', qw(/),          {OUT => '/'}],
  61      ['g', qw(//),         {OUT => "$double_slash"}],
  62      ['h', qw(///),        {OUT => '/'}],
  63      ['i', qw(///a///),    {OUT => 'a'}],
  64      ['j', qw(''),         {OUT => ''}],
  65      ['1', qw(f.s .s),     {OUT => 'f'}],
  66      ['2', qw(fs s),       {OUT => 'f'}],
  67      ['3', qw(fs fs),      {OUT => 'fs'}],
  68      ['4', qw(fs/ s),      {OUT => 'f'}],
  69      ['5', qw(dir/file.suf .suf),      {OUT => 'file'}],
  70      ['6', qw(// /),       {OUT => "$double_slash"}],
  71      ['7', qw(// //),      {OUT => "$double_slash"}],
  72      ['8', qw(fs x),       {OUT => 'fs'}],
  73      ['9', qw(fs ''),      {OUT => 'fs'}],
  74      ['10', qw(fs/ s/),    {OUT => 'fs'}],
  75    );
  76
  77 # Append a newline to end of each expected `OUT' string.
  78 my $t;
  79 foreach $t (@Tests)
  80   {
  81     my $arg1 = $t->[1];
  82     my $e;
  83     foreach $e (@$t)
  84       {
  85         $e->{OUT} = "$e->{OUT}\n"
  86           if ref $e eq 'HASH' and exists $e->{OUT};
  87       }
  88   }
  89
  90 my $save_temps = $ENV{SAVE_TEMPS};
  91 my $verbose = $ENV{VERBOSE};
  92
  93 my $fail = run_tests ($program_name, $prog, \@Tests, $save_temps, $verbose);
  94 exit $fail;
  95 EOF