Commit | Line | Data |
---|---|---|
a687059c LW |
1 | #!./perl |
2 | ||
72b16652 GS |
3 | BEGIN { |
4 | chdir 't' if -d 't'; | |
9b38b307 | 5 | @INC = qw(. ../lib); |
93b2dae1 | 6 | require 'test.pl'; |
72b16652 | 7 | } |
a687059c | 8 | |
ca49a3da | 9 | plan( tests => 18 ); |
a687059c | 10 | |
0a753a76 | 11 | @oops = @ops = <op/*>; |
a687059c | 12 | |
68dc0745 | 13 | if ($^O eq 'MSWin32') { |
3cd616b9 | 14 | map { $files{lc($_)}++ } <op/*>; |
6d0cc0d7 | 15 | map { delete $files{"op/$_"} } split /[\s\n]/, `dir /b /l op & dir /b /l /ah op 2>nul`, |
68dc0745 | 16 | } |
0405c3f2 CB |
17 | elsif ($^O eq 'VMS') { |
18 | map { $files{lc($_)}++ } <[.op]*>; | |
19 | map { s/;.*$//; delete $files{lc($_)}; } split /[\n]/, `directory/noheading/notrailing/versions=1 [.op]`, | |
20 | } | |
68dc0745 | 21 | else { |
3cd616b9 | 22 | map { $files{$_}++ } <op/*>; |
f922571b | 23 | map { delete $files{$_} } split /\n/, `ls op/* | cat`; |
68dc0745 | 24 | } |
9b38b307 | 25 | ok( !(keys(%files)),'leftover op/* files' ) or diag(join(' ',sort keys %files)); |
a687059c | 26 | |
9b38b307 | 27 | cmp_ok($/,'eq',"\n",'sane input record separator'); |
a687059c | 28 | |
9b38b307 | 29 | $not = ''; |
7b903762 RGS |
30 | while (<jskdfjskdfj* op/* jskdjfjkosvk*>) { |
31 | $not = "not " unless $_ eq shift @ops; | |
32 | $not = "not at all " if $/ eq "\0"; | |
a687059c | 33 | } |
9b38b307 | 34 | ok(!$not,"glob amid garbage [$not]"); |
a687059c | 35 | |
9b38b307 | 36 | cmp_ok($/,'eq',"\n",'input record separator still sane'); |
0a753a76 | 37 | |
7b903762 | 38 | $_ = "op/*"; |
0a753a76 | 39 | @glops = glob $_; |
9b38b307 | 40 | cmp_ok("@glops",'eq',"@oops",'glob operator 1'); |
0a753a76 | 41 | |
42 | @glops = glob; | |
9b38b307 | 43 | cmp_ok("@glops",'eq',"@oops",'glob operator 2'); |
ba112943 BS |
44 | |
45 | # glob should still work even after the File::Glob stash has gone away | |
46 | # (this used to dump core) | |
47 | my $i = 0; | |
48 | for (1..2) { | |
49 | eval "<.>"; | |
9b38b307 | 50 | ok(!length($@),"eval'ed a glob $_"); |
1bb8785a | 51 | local %File::Glob::; |
ba112943 BS |
52 | ++$i; |
53 | } | |
4984aa34 FC |
54 | cmp_ok($i,'==',2,'remove File::Glob stash'); |
55 | ||
56 | # a more sinister version of the same test (crashes from 5.8 to 5.13.1) | |
57 | { | |
1bb8785a | 58 | local %File::Glob::; |
4984aa34 FC |
59 | local %CORE::GLOBAL::; |
60 | eval "<.>"; | |
61 | ok(!length($@),"remove File::Glob stash *and* CORE::GLOBAL::glob"); | |
62 | } | |
d67594ff FC |
63 | # Also try undeffing the typeglob itself, instead of hiding it |
64 | { | |
65 | local *CORE::GLOBAL::glob; | |
66 | ok eval { glob("0"); 1 }, | |
67 | 'undefined *CORE::GLOBAL::glob{CODE} at run time'; | |
68 | } | |
69 | # And hide the typeglob without hiding File::Glob (crashes from 5.8 | |
70 | # to 5.15.4) | |
71 | { | |
72 | local %CORE::GLOBAL::; | |
73 | ok eval q{ glob("0"); 1 }, | |
74 | 'undefined *CORE::GLOBAL::glob{CODE} at compile time'; | |
75 | } | |
fe4a5e1f | 76 | |
48beb55f RH |
77 | # ... while ($var = glob(...)) should test definedness not truth |
78 | ||
9b38b307 DL |
79 | SKIP: { |
80 | skip('no File::Glob to emulate Unix-ism', 1) | |
81 | unless $INC{'File/Glob.pm'}; | |
82 | my $ok = 0; | |
83 | $ok = 1 while my $var = glob("0"); | |
84 | ok($ok,'define versus truth'); | |
6ffa69ae | 85 | } |
ed2962a1 RH |
86 | |
87 | # The formerly-broken test for the situation above would accidentally | |
88 | # test definedness for an assignment with a LOGOP on the right: | |
33cec765 | 89 | { |
9b38b307 DL |
90 | my $f = 0; |
91 | my $ok = 1; | |
92 | $ok = 0, undef $f while $x = $f||$f; | |
93 | ok($ok,'test definedness with LOGOP'); | |
33cec765 | 94 | } |
9b38b307 DL |
95 | |
96 | cmp_ok(scalar(@oops),'>',0,'glob globbed something'); | |
93b2dae1 | 97 | |
4218a421 FC |
98 | SKIP: { |
99 | skip "~ globbing returns nothing on VMS", 1 if $^O eq 'VMS'; | |
100 | # This test exists mainly for miniperl, to test that external calls to | |
101 | # csh, which clear %ENV first, leave $ENV{HOME}. | |
102 | # On Windows, external glob uses File::DosGlob which returns "~", so | |
103 | # this should pass anyway. | |
104 | ok <~>, '~ works'; | |
105 | } | |
d67594ff FC |
106 | |
107 | { | |
108 | my $called; | |
109 | local *CORE::GLOBAL::glob = sub { ++$called }; | |
110 | eval 'CORE::glob("0")'; | |
111 | ok !$called, 'CORE::glob bypasses overrides'; | |
112 | } | |
ca49a3da BF |
113 | |
114 | ######## glob() bug Mon, 01 Sep 2003 02:25:41 -0700 <200309010925.h819Pf0X011457@smtp3.ActiveState.com> | |
115 | ||
116 | SKIP: { | |
117 | use Config; | |
118 | skip("glob() works when cross-compiling, but this test doesn't", 1) | |
119 | if $Config{usecrosscompile}; | |
120 | ||
121 | my $switches = [qw(-lw)]; | |
122 | my $expected = "ok1\nok2\n"; | |
123 | my $name = "Make sure the presence of the CORE::GLOBAL::glob typeglob does not affect whether File::Glob::csh_glob is called."; | |
124 | ||
125 | fresh_perl_is(<<'EOP', $expected, { switches => $switches }, $name); | |
126 | if ($^O eq 'VMS') { | |
127 | # A pattern with a double quote in it is a syntax error to LIB$FIND_FILE | |
128 | # Should we strip quotes in Perl_vms_start_glob the way csh_glob() does? | |
129 | print "ok1\nok2\n"; | |
130 | } | |
131 | else { | |
132 | ++$INC{"File/Glob.pm"}; # prevent it from loading | |
133 | my $called1 = 0; | |
134 | my $called2 = 0; | |
135 | *File::Glob::csh_glob = sub { ++$called1 }; | |
136 | my $output1 = eval q{ glob(q(./"TEST")) }; | |
137 | undef *CORE::GLOBAL::glob; # but leave the typeglob itself there | |
138 | ++$CORE::GLOBAL::glob if 0; # "used only once" | |
139 | undef *File::Glob::csh_glob; # avoid redefinition warnings | |
140 | *File::Glob::csh_glob = sub { ++$called2 }; | |
141 | my $output2 = eval q{ glob(q(./"TEST")) }; | |
142 | print "ok1" if $called1 eq $called2; | |
143 | print "ok2" if $output1 eq $output2; | |
144 | } | |
145 | EOP | |
146 | } |