8 use File::Basename qw(fileparse basename dirname);
13 print +(defined(&basename) && !defined(&fileparse_set_fstype) ?
14 '' : 'not '),"ok 1\n";
16 # set fstype -- should replace non-null default
17 print +(length(File::Basename::fileparse_set_fstype('unix')) ?
18 '' : 'not '),"ok 2\n";
21 ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7','\.book\d+');
22 if ($base eq 'draft' and $path eq '/virgil/aeneid/' and $type eq '.book7') {
26 print "not ok 3 |$base|$path|$type|\n";
28 print +(basename('/arma/virumque.cano') eq 'virumque.cano' ?
29 '' : 'not '),"ok 4\n";
30 print +(dirname('/arma/virumque.cano') eq '/arma' ? '' : 'not '),"ok 5\n";
31 print +(dirname('arma/') eq '.' ? '' : 'not '),"ok 6\n";
32 print +(dirname('/') eq '/' ? '' : 'not '),"ok 7\n";
35 # set fstype -- should replace non-null default
36 print +(File::Basename::fileparse_set_fstype('VMS') eq 'unix' ?
37 '' : 'not '),"ok 8\n";
40 ($base,$path,$type) = fileparse('virgil:[aeneid]draft.book7','\.book\d+');
41 if ($base eq 'draft' and $path eq 'virgil:[aeneid]' and $type eq '.book7') {
45 print "not ok 9 |$base|$path|$type|\n";
47 print +(basename('arma:[virumque]cano.trojae') eq 'cano.trojae' ?
48 '' : 'not '),"ok 10\n";
49 print +(dirname('arma:[virumque]cano.trojae') eq 'arma:[virumque]' ?
50 '' : 'not '),"ok 11\n";
51 print +(dirname('arma:<virumque>cano.trojae') eq 'arma:<virumque>' ?
52 '' : 'not '),"ok 12\n";
53 print +(dirname('arma:virumque.cano') eq 'arma:' ? '' : 'not '),"ok 13\n";
54 print +(dirname('virumque.cano') eq $ENV{DEFAULT} ? '' : 'not '),"ok 14\n";
55 print +(dirname('arma/') eq '.' ? '' : 'not '),"ok 15\n";
57 # set fstype -- should replace non-null default
58 print +(File::Basename::fileparse_set_fstype('MSDOS') eq 'VMS' ?
59 '' : 'not '),"ok 16\n";
62 ($base,$path,$type) = fileparse('C:\\virgil\\aeneid\\draft.book7','\.book\d+');
63 if ($base eq 'draft' and $path eq 'C:\\virgil\\aeneid\\' and $type eq '.book7') {
67 print "not ok 17 |$base|$path|$type|\n";
69 print +(basename('A:virumque\\cano.trojae') eq 'cano.trojae' ?
70 '' : 'not '),"ok 18\n";
71 print +(dirname('A:\\virumque\\cano.trojae') eq 'A:\\virumque' ?
72 '' : 'not '),"ok 19\n";
73 print +(dirname('A:\\') eq 'A:\\' ? '' : 'not '),"ok 20\n";
74 print +(dirname('arma\\') eq '.' ? '' : 'not '),"ok 21\n";
76 # Yes "/" is a legal path separator under MSDOS
77 basename("lib/File/Basename.pm") eq "Basename.pm" or print "not ";
82 # set fstype -- should replace non-null default
83 print +(File::Basename::fileparse_set_fstype('MacOS') eq 'MSDOS' ?
84 '' : 'not '),"ok 23\n";
87 ($base,$path,$type) = fileparse('virgil:aeneid:draft.book7','\.book\d+');
88 if ($base eq 'draft' and $path eq 'virgil:aeneid:' and $type eq '.book7') {
92 print "not ok 24 |$base|$path|$type|\n";
94 print +(basename(':arma:virumque:cano.trojae') eq 'cano.trojae' ?
95 '' : 'not '),"ok 25\n";
96 print +(dirname(':arma:virumque:cano.trojae') eq ':arma:virumque:' ?
97 '' : 'not '),"ok 26\n";
98 print +(dirname('arma:') eq 'arma:' ? '' : 'not '),"ok 27\n";
99 print +(dirname(':') eq ':' ? '' : 'not '),"ok 28\n";
102 # Check quoting of metacharacters in suffix arg by basename()
103 print +(basename(':arma:virumque:cano.trojae','.trojae') eq 'cano' ?
104 '' : 'not '),"ok 29\n";
105 print +(basename(':arma:virumque:cano_trojae','.trojae') eq 'cano_trojae' ?
106 '' : 'not '),"ok 30\n";
108 # extra tests for a few specific bugs
110 File::Basename::fileparse_set_fstype 'MSDOS';
111 # perl5.003_18 gives C:/perl/.\
112 print +((fileparse 'C:/perl/lib')[1] eq 'C:/perl/' ? '' : 'not '), "ok 31\n";
113 # perl5.003_18 gives C:\perl\
114 print +(dirname('C:\\perl\\lib\\') eq 'C:\\perl' ? '' : 'not '), "ok 32\n";
116 File::Basename::fileparse_set_fstype 'UNIX';
117 # perl5.003_18 gives '.'
118 print +(dirname('/perl/') eq '/' ? '' : 'not '), "ok 33\n";
119 # perl5.003_18 gives '/perl/lib'
120 print +(dirname('/perl/lib//') eq '/perl' ? '' : 'not '), "ok 34\n";