1*0Sstevel@tonic-gate#!./perl -T 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate} 7*0Sstevel@tonic-gate 8*0Sstevel@tonic-gateuse File::Basename qw(fileparse basename dirname); 9*0Sstevel@tonic-gate 10*0Sstevel@tonic-gateprint "1..41\n"; 11*0Sstevel@tonic-gate 12*0Sstevel@tonic-gate# import correctly? 13*0Sstevel@tonic-gateprint +(defined(&basename) && !defined(&fileparse_set_fstype) ? 14*0Sstevel@tonic-gate '' : 'not '),"ok 1\n"; 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gate# set fstype -- should replace non-null default 17*0Sstevel@tonic-gateprint +(length(File::Basename::fileparse_set_fstype('unix')) ? 18*0Sstevel@tonic-gate '' : 'not '),"ok 2\n"; 19*0Sstevel@tonic-gate 20*0Sstevel@tonic-gate# Unix syntax tests 21*0Sstevel@tonic-gate($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7',qr'\.book\d+'); 22*0Sstevel@tonic-gateif ($base eq 'draft' and $path eq '/virgil/aeneid/' and $type eq '.book7') { 23*0Sstevel@tonic-gate print "ok 3\n"; 24*0Sstevel@tonic-gate} 25*0Sstevel@tonic-gateelse { 26*0Sstevel@tonic-gate print "not ok 3 |$base|$path|$type|\n"; 27*0Sstevel@tonic-gate} 28*0Sstevel@tonic-gateprint +(basename('/arma/virumque.cano') eq 'virumque.cano' ? 29*0Sstevel@tonic-gate '' : 'not '),"ok 4\n"; 30*0Sstevel@tonic-gateprint +(dirname('/arma/virumque.cano') eq '/arma' ? '' : 'not '),"ok 5\n"; 31*0Sstevel@tonic-gateprint +(dirname('arma/') eq '.' ? '' : 'not '),"ok 6\n"; 32*0Sstevel@tonic-gateprint +(dirname('/') eq '/' ? '' : 'not '),"ok 7\n"; 33*0Sstevel@tonic-gate 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gate# set fstype -- should replace non-null default 36*0Sstevel@tonic-gateprint +(File::Basename::fileparse_set_fstype('VMS') eq 'unix' ? 37*0Sstevel@tonic-gate '' : 'not '),"ok 8\n"; 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gate# VMS syntax tests 40*0Sstevel@tonic-gate($base,$path,$type) = fileparse('virgil:[aeneid]draft.book7',qr{\.book\d+}); 41*0Sstevel@tonic-gateif ($base eq 'draft' and $path eq 'virgil:[aeneid]' and $type eq '.book7') { 42*0Sstevel@tonic-gate print "ok 9\n"; 43*0Sstevel@tonic-gate} 44*0Sstevel@tonic-gateelse { 45*0Sstevel@tonic-gate print "not ok 9 |$base|$path|$type|\n"; 46*0Sstevel@tonic-gate} 47*0Sstevel@tonic-gateprint +(basename('arma:[virumque]cano.trojae') eq 'cano.trojae' ? 48*0Sstevel@tonic-gate '' : 'not '),"ok 10\n"; 49*0Sstevel@tonic-gateprint +(dirname('arma:[virumque]cano.trojae') eq 'arma:[virumque]' ? 50*0Sstevel@tonic-gate '' : 'not '),"ok 11\n"; 51*0Sstevel@tonic-gateprint +(dirname('arma:<virumque>cano.trojae') eq 'arma:<virumque>' ? 52*0Sstevel@tonic-gate '' : 'not '),"ok 12\n"; 53*0Sstevel@tonic-gateprint +(dirname('arma:virumque.cano') eq 'arma:' ? '' : 'not '),"ok 13\n"; 54*0Sstevel@tonic-gate$ENV{DEFAULT} = '' unless exists $ENV{DEFAULT}; 55*0Sstevel@tonic-gateprint +(dirname('virumque.cano') eq $ENV{DEFAULT} ? '' : 'not '),"ok 14\n"; 56*0Sstevel@tonic-gateprint +(dirname('arma/') eq '.' ? '' : 'not '),"ok 15\n"; 57*0Sstevel@tonic-gate 58*0Sstevel@tonic-gate# set fstype -- should replace non-null default 59*0Sstevel@tonic-gateprint +(File::Basename::fileparse_set_fstype('MSDOS') eq 'VMS' ? 60*0Sstevel@tonic-gate '' : 'not '),"ok 16\n"; 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gate# MSDOS syntax tests 63*0Sstevel@tonic-gate($base,$path,$type) = fileparse('C:\\virgil\\aeneid\\draft.book7','\.book\d+'); 64*0Sstevel@tonic-gateif ($base eq 'draft' and $path eq 'C:\\virgil\\aeneid\\' and $type eq '.book7') { 65*0Sstevel@tonic-gate print "ok 17\n"; 66*0Sstevel@tonic-gate} 67*0Sstevel@tonic-gateelse { 68*0Sstevel@tonic-gate print "not ok 17 |$base|$path|$type|\n"; 69*0Sstevel@tonic-gate} 70*0Sstevel@tonic-gateprint +(basename('A:virumque\\cano.trojae') eq 'cano.trojae' ? 71*0Sstevel@tonic-gate '' : 'not '),"ok 18\n"; 72*0Sstevel@tonic-gateprint +(dirname('A:\\virumque\\cano.trojae') eq 'A:\\virumque' ? 73*0Sstevel@tonic-gate '' : 'not '),"ok 19\n"; 74*0Sstevel@tonic-gateprint +(dirname('A:\\') eq 'A:\\' ? '' : 'not '),"ok 20\n"; 75*0Sstevel@tonic-gateprint +(dirname('arma\\') eq '.' ? '' : 'not '),"ok 21\n"; 76*0Sstevel@tonic-gate 77*0Sstevel@tonic-gate# Yes "/" is a legal path separator under MSDOS 78*0Sstevel@tonic-gatebasename("lib/File/Basename.pm") eq "Basename.pm" or print "not "; 79*0Sstevel@tonic-gateprint "ok 22\n"; 80*0Sstevel@tonic-gate 81*0Sstevel@tonic-gate 82*0Sstevel@tonic-gate 83*0Sstevel@tonic-gate# set fstype -- should replace non-null default 84*0Sstevel@tonic-gateprint +(File::Basename::fileparse_set_fstype('MacOS') eq 'MSDOS' ? 85*0Sstevel@tonic-gate '' : 'not '),"ok 23\n"; 86*0Sstevel@tonic-gate 87*0Sstevel@tonic-gate# MacOS syntax tests 88*0Sstevel@tonic-gate($base,$path,$type) = fileparse('virgil:aeneid:draft.book7','\.book\d+'); 89*0Sstevel@tonic-gateif ($base eq 'draft' and $path eq 'virgil:aeneid:' and $type eq '.book7') { 90*0Sstevel@tonic-gate print "ok 24\n"; 91*0Sstevel@tonic-gate} 92*0Sstevel@tonic-gateelse { 93*0Sstevel@tonic-gate print "not ok 24 |$base|$path|$type|\n"; 94*0Sstevel@tonic-gate} 95*0Sstevel@tonic-gateprint +(basename(':arma:virumque:cano.trojae') eq 'cano.trojae' ? 96*0Sstevel@tonic-gate '' : 'not '),"ok 25\n"; 97*0Sstevel@tonic-gateprint +(dirname(':arma:virumque:cano.trojae') eq ':arma:virumque:' ? 98*0Sstevel@tonic-gate '' : 'not '),"ok 26\n"; 99*0Sstevel@tonic-gateprint +(dirname(':arma:virumque:') eq ':arma:' ? '' : 'not '),"ok 27\n"; 100*0Sstevel@tonic-gateprint +(dirname(':arma:virumque') eq ':arma:' ? '' : 'not '),"ok 28\n"; 101*0Sstevel@tonic-gateprint +(dirname(':arma:') eq ':' ? '' : 'not '),"ok 29\n"; 102*0Sstevel@tonic-gateprint +(dirname(':arma') eq ':' ? '' : 'not '),"ok 30\n"; 103*0Sstevel@tonic-gateprint +(dirname('arma:') eq 'arma:' ? '' : 'not '),"ok 31\n"; 104*0Sstevel@tonic-gateprint +(dirname('arma') eq ':' ? '' : 'not '),"ok 32\n"; 105*0Sstevel@tonic-gateprint +(dirname(':') eq ':' ? '' : 'not '),"ok 33\n"; 106*0Sstevel@tonic-gate 107*0Sstevel@tonic-gate 108*0Sstevel@tonic-gate# Check quoting of metacharacters in suffix arg by basename() 109*0Sstevel@tonic-gateprint +(basename(':arma:virumque:cano.trojae','.trojae') eq 'cano' ? 110*0Sstevel@tonic-gate '' : 'not '),"ok 34\n"; 111*0Sstevel@tonic-gateprint +(basename(':arma:virumque:cano_trojae','.trojae') eq 'cano_trojae' ? 112*0Sstevel@tonic-gate '' : 'not '),"ok 35\n"; 113*0Sstevel@tonic-gate 114*0Sstevel@tonic-gate# extra tests for a few specific bugs 115*0Sstevel@tonic-gate 116*0Sstevel@tonic-gateFile::Basename::fileparse_set_fstype 'MSDOS'; 117*0Sstevel@tonic-gate# perl5.003_18 gives C:/perl/.\ 118*0Sstevel@tonic-gateprint +((fileparse 'C:/perl/lib')[1] eq 'C:/perl/' ? '' : 'not '), "ok 36\n"; 119*0Sstevel@tonic-gate# perl5.003_18 gives C:\perl\ 120*0Sstevel@tonic-gateprint +(dirname('C:\\perl\\lib\\') eq 'C:\\perl' ? '' : 'not '), "ok 37\n"; 121*0Sstevel@tonic-gate 122*0Sstevel@tonic-gateFile::Basename::fileparse_set_fstype 'UNIX'; 123*0Sstevel@tonic-gate# perl5.003_18 gives '.' 124*0Sstevel@tonic-gateprint +(dirname('/perl/') eq '/' ? '' : 'not '), "ok 38\n"; 125*0Sstevel@tonic-gate# perl5.003_18 gives '/perl/lib' 126*0Sstevel@tonic-gateprint +(dirname('/perl/lib//') eq '/perl' ? '' : 'not '), "ok 39\n"; 127*0Sstevel@tonic-gate 128*0Sstevel@tonic-gate# The empty tainted value, for tainting strings 129*0Sstevel@tonic-gatemy $TAINT = substr($^X, 0, 0); 130*0Sstevel@tonic-gate# How to identify taint when you see it 131*0Sstevel@tonic-gatesub any_tainted (@) { 132*0Sstevel@tonic-gate not eval { join("",@_), kill 0; 1 }; 133*0Sstevel@tonic-gate} 134*0Sstevel@tonic-gatesub tainted ($) { 135*0Sstevel@tonic-gate any_tainted @_; 136*0Sstevel@tonic-gate} 137*0Sstevel@tonic-gatesub all_tainted (@) { 138*0Sstevel@tonic-gate for (@_) { return 0 unless tainted $_ } 139*0Sstevel@tonic-gate 1; 140*0Sstevel@tonic-gate} 141*0Sstevel@tonic-gate 142*0Sstevel@tonic-gateprint +(tainted(dirname($TAINT.'/perl/lib//')) ? '' : 'not '), "ok 40\n"; 143*0Sstevel@tonic-gateprint +(all_tainted(fileparse($TAINT.'/dir/draft.book7','\.book\d+')) 144*0Sstevel@tonic-gate ? '' : 'not '), "ok 41\n"; 145