1#!/usr/bin/perl 2# Test basename. 3# Copyright (C) 2006-2023 Free Software Foundation, Inc. 4 5# This program is free software: you can redistribute it and/or modify 6# it under the terms of the GNU General Public License as published by 7# the Free Software Foundation, either version 3 of the License, or 8# (at your option) any later version. 9 10# This program is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# GNU General Public License for more details. 14 15# You should have received a copy of the GNU General Public License 16# along with this program. If not, see <https://www.gnu.org/licenses/>. 17 18use strict; 19use File::stat; 20 21(my $program_name = $0) =~ s|.*/||; 22 23# Turn off localization of executable's output. 24@ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3; 25 26my $stat_single = stat('/'); 27my $stat_double = stat('//'); 28my $double_slash = ($stat_single->dev == $stat_double->dev 29 && $stat_single->ino == $stat_double->ino) ? '/' : '//'; 30 31my $prog = 'basename'; 32 33my @Tests = 34 ( 35 ['fail-1', {ERR => "$prog: missing operand\n" 36 . "Try '$prog --help' for more information.\n"}, {EXIT => '1'}], 37 ['fail-2', qw(a b c), {ERR => "$prog: extra operand 'c'\n" 38 . "Try '$prog --help' for more information.\n"}, {EXIT => '1'}], 39 40 ['a', qw(d/f), {OUT => 'f'}], 41 ['b', qw(/d/f), {OUT => 'f'}], 42 ['c', qw(d/f/), {OUT => 'f'}], 43 ['d', qw(d/f//), {OUT => 'f'}], 44 ['e', qw(f), {OUT => 'f'}], 45 ['f', qw(/), {OUT => '/'}], 46 ['g', qw(//), {OUT => "$double_slash"}], 47 ['h', qw(///), {OUT => '/'}], 48 ['i', qw(///a///), {OUT => 'a'}], 49 ['j', qw(''), {OUT => ''}], 50 ['k', qw(aa a), {OUT => 'a'}], 51 ['l', qw(-a a b), {OUT => "a\nb"}], 52 ['m', qw(-s a aa ba ab), {OUT => "a\nb\nab"}], 53 ['n', qw(a-a -a), {OUT => 'a'}], 54 ['1', qw(f.s .s), {OUT => 'f'}], 55 ['2', qw(fs s), {OUT => 'f'}], 56 ['3', qw(fs fs), {OUT => 'fs'}], 57 ['4', qw(fs/ s), {OUT => 'f'}], 58 ['5', qw(dir/file.suf .suf), {OUT => 'file'}], 59 ['6', qw(// /), {OUT => "$double_slash"}], 60 ['7', qw(// //), {OUT => "$double_slash"}], 61 ['8', qw(fs x), {OUT => 'fs'}], 62 ['9', qw(fs ''), {OUT => 'fs'}], 63 ['10', qw(fs/ s/), {OUT => 'fs'}], 64 65 # Exercise -z option. 66 ['z0', qw(-z a), {OUT => "a\0"}], 67 ['z1', qw(--zero a), {OUT => "a\0"}], 68 ['z2', qw(-za a b), {OUT => "a\0b\0"}], 69 ['z3', qw(-z ba a), {OUT => "b\0"}], 70 ['z4', qw(-z -s a ba), {OUT => "b\0"}], 71 ); 72 73# Append a newline to end of each expected 'OUT' string. 74# Skip -z tests, i.e., those whose 'OUT' string has a trailing '\0'. 75my $t; 76foreach $t (@Tests) 77 { 78 my $arg1 = $t->[1]; 79 my $e; 80 foreach $e (@$t) 81 { 82 $e->{OUT} = "$e->{OUT}\n" 83 if ref $e eq 'HASH' and exists $e->{OUT} 84 and not $e->{OUT} =~ /\0$/; 85 } 86 } 87 88my $save_temps = $ENV{SAVE_TEMPS}; 89my $verbose = $ENV{VERBOSE}; 90 91my $fail = run_tests ($program_name, $prog, \@Tests, $save_temps, $verbose); 92exit $fail; 93