Commit | Line | Data |
---|---|---|
d9641052 | 1 | #!./perl -Tw |
78201403 | 2 | |
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
20822f61 | 5 | @INC = '../lib'; |
78201403 | 6 | } |
7 | ||
356677e3 | 8 | use Test::More tests => 64; |
78201403 | 9 | |
d9641052 | 10 | BEGIN { use_ok 'File::Basename' } |
78201403 | 11 | |
12 | # import correctly? | |
d9641052 NC |
13 | can_ok( __PACKAGE__, qw( basename fileparse dirname fileparse_set_fstype ) ); |
14 | ||
15 | ### Testing Unix | |
16 | { | |
17 | ok length fileparse_set_fstype('unix'), 'set fstype to unix'; | |
356677e3 | 18 | is( fileparse_set_fstype(), 'Unix', 'get fstype' ); |
d9641052 NC |
19 | |
20 | my($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7', | |
21 | qr'\.book\d+'); | |
22 | is($base, 'draft'); | |
23 | is($path, '/virgil/aeneid/'); | |
24 | is($type, '.book7'); | |
25 | ||
26 | is(basename('/arma/virumque.cano'), 'virumque.cano'); | |
27 | is(dirname ('/arma/virumque.cano'), '/arma'); | |
28 | is(dirname('arma/'), '.'); | |
d9641052 | 29 | } |
78201403 | 30 | |
78201403 | 31 | |
d9641052 NC |
32 | ### Testing VMS |
33 | { | |
356677e3 | 34 | is(fileparse_set_fstype('VMS'), 'Unix', 'set fstype to VMS'); |
78201403 | 35 | |
d9641052 NC |
36 | my($base,$path,$type) = fileparse('virgil:[aeneid]draft.book7', |
37 | qr{\.book\d+}); | |
38 | is($base, 'draft'); | |
39 | is($path, 'virgil:[aeneid]'); | |
40 | is($type, '.book7'); | |
78201403 | 41 | |
d9641052 NC |
42 | is(basename('arma:[virumque]cano.trojae'), 'cano.trojae'); |
43 | is(dirname('arma:[virumque]cano.trojae'), 'arma:[virumque]'); | |
44 | is(dirname('arma:<virumque>cano.trojae'), 'arma:<virumque>'); | |
45 | is(dirname('arma:virumque.cano'), 'arma:'); | |
78201403 | 46 | |
d9641052 NC |
47 | { |
48 | local $ENV{DEFAULT} = '' unless exists $ENV{DEFAULT}; | |
49 | is(dirname('virumque.cano'), $ENV{DEFAULT}); | |
50 | is(dirname('arma/'), '.'); | |
51 | } | |
78201403 | 52 | } |
78201403 | 53 | |
78201403 | 54 | |
356677e3 | 55 | ### Testing DOS |
d9641052 | 56 | { |
356677e3 | 57 | is(fileparse_set_fstype('DOS'), 'VMS', 'set fstype to DOS'); |
78201403 | 58 | |
d9641052 NC |
59 | my($base,$path,$type) = fileparse('C:\\virgil\\aeneid\\draft.book7', |
60 | '\.book\d+'); | |
61 | is($base, 'draft'); | |
62 | is($path, 'C:\\virgil\\aeneid\\'); | |
63 | is($type, '.book7'); | |
78201403 | 64 | |
d9641052 NC |
65 | is(basename('A:virumque\\cano.trojae'), 'cano.trojae'); |
66 | is(dirname('A:\\virumque\\cano.trojae'), 'A:\\virumque'); | |
67 | is(dirname('A:\\'), 'A:\\'); | |
68 | is(dirname('arma\\'), '.'); | |
78201403 | 69 | |
356677e3 | 70 | # Yes "/" is a legal path separator under DOS |
d9641052 | 71 | is(basename("lib/File/Basename.pm"), "Basename.pm"); |
356677e3 NC |
72 | |
73 | # $^O for DOS is "dos" not "MSDOS" but "MSDOS" is left in for | |
74 | # backward bug compat. | |
75 | is(fileparse_set_fstype('MSDOS'), 'DOS'); | |
76 | is( dirname("\\foo\\bar\\baz"), "\\foo\\bar" ); | |
78201403 | 77 | } |
d9641052 NC |
78 | |
79 | ||
80 | ### Testing MacOS | |
81 | { | |
82 | is(fileparse_set_fstype('MacOS'), 'MSDOS', 'set fstype to MacOS'); | |
83 | ||
84 | my($base,$path,$type) = fileparse('virgil:aeneid:draft.book7', | |
85 | '\.book\d+'); | |
86 | is($base, 'draft'); | |
87 | is($path, 'virgil:aeneid:'); | |
88 | is($type, '.book7'); | |
89 | ||
90 | is(basename(':arma:virumque:cano.trojae'), 'cano.trojae'); | |
91 | is(dirname(':arma:virumque:cano.trojae'), ':arma:virumque:'); | |
92 | is(dirname(':arma:virumque:'), ':arma:'); | |
93 | is(dirname(':arma:virumque'), ':arma:'); | |
94 | is(dirname(':arma:'), ':'); | |
95 | is(dirname(':arma'), ':'); | |
96 | is(dirname('arma:'), 'arma:'); | |
97 | is(dirname('arma'), ':'); | |
98 | is(dirname(':'), ':'); | |
99 | ||
100 | ||
101 | # Check quoting of metacharacters in suffix arg by basename() | |
102 | is(basename(':arma:virumque:cano.trojae','.trojae'), 'cano'); | |
103 | is(basename(':arma:virumque:cano_trojae','.trojae'), 'cano_trojae'); | |
b3eb6a9b | 104 | } |
d9641052 NC |
105 | |
106 | ||
107 | ### extra tests for a few specific bugs | |
108 | { | |
356677e3 | 109 | fileparse_set_fstype 'DOS'; |
d9641052 NC |
110 | # perl5.003_18 gives C:/perl/.\ |
111 | is((fileparse 'C:/perl/lib')[1], 'C:/perl/'); | |
112 | # perl5.003_18 gives C:\perl\ | |
113 | is(dirname('C:\\perl\\lib\\'), 'C:\\perl'); | |
114 | ||
115 | fileparse_set_fstype 'UNIX'; | |
116 | # perl5.003_18 gives '.' | |
117 | is(dirname('/perl/'), '/'); | |
118 | # perl5.003_18 gives '/perl/lib' | |
119 | is(dirname('/perl/lib//'), '/perl'); | |
b3eb6a9b GS |
120 | } |
121 | ||
356677e3 NC |
122 | ### rt.perl.org 22236 |
123 | { | |
124 | is(basename('a/'), 'a'); | |
125 | is(basename('/usr/lib//'), 'lib'); | |
126 | ||
127 | fileparse_set_fstype 'MSWin32'; | |
128 | is(basename('a\\'), 'a'); | |
129 | is(basename('\\usr\\lib\\\\'), 'lib'); | |
130 | } | |
131 | ||
132 | ||
133 | ### rt.cpan.org 36477 | |
134 | { | |
135 | fileparse_set_fstype('Unix'); | |
136 | is(dirname('/'), '/'); | |
137 | is(basename('/'), '/'); | |
138 | ||
139 | fileparse_set_fstype('DOS'); | |
140 | is(dirname('\\'), '\\'); | |
141 | is(basename('\\'), '\\'); | |
142 | } | |
143 | ||
144 | ||
145 | ### basename(1) sez: "The suffix is not stripped if it is identical to the | |
146 | ### remaining characters in string" | |
147 | { | |
148 | fileparse_set_fstype('Unix'); | |
149 | is(basename('.foo'), '.foo'); | |
150 | is(basename('.foo', '.foo'), '.foo'); | |
151 | is(basename('.foo.bar', '.foo'), '.foo.bar'); | |
152 | is(basename('.foo.bar', '.bar'), '.foo'); | |
153 | } | |
154 | ||
d9641052 NC |
155 | |
156 | ### Test tainting | |
157 | { | |
158 | # The empty tainted value, for tainting strings | |
159 | my $TAINT = substr($^X, 0, 0); | |
160 | ||
161 | # How to identify taint when you see it | |
162 | sub any_tainted (@) { | |
163 | return ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 }; | |
164 | } | |
165 | ||
166 | sub tainted ($) { | |
167 | any_tainted @_; | |
168 | } | |
169 | ||
170 | sub all_tainted (@) { | |
171 | for (@_) { return 0 unless tainted $_ } | |
172 | 1; | |
173 | } | |
174 | ||
356677e3 | 175 | fileparse_set_fstype 'Unix'; |
d9641052 NC |
176 | ok tainted(dirname($TAINT.'/perl/lib//')); |
177 | ok all_tainted(fileparse($TAINT.'/dir/draft.book7','\.book\d+')); | |
178 | } |