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