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