Commit | Line | Data |
---|---|---|
686c4ca0 | 1 | #!perl |
686c4ca0 NC |
2 | |
3 | BEGIN { | |
a817e89d | 4 | chdir 't' if -d 't'; |
686c4ca0 | 5 | require './test.pl'; |
624c42e2 | 6 | set_up_inc( qw(../lib) ); |
686c4ca0 NC |
7 | } |
8 | ||
0b1b7115 JH |
9 | use strict; |
10 | use warnings; | |
11 | ||
0d370d41 | 12 | plan(tests => 73); |
1a55cc50 YO |
13 | |
14 | ||
15 | # Dedupe @INC. In a future patch we /may/ refuse to process items | |
16 | # more than once and deduping here will prevent the tests from failing | |
17 | # should we make that change. | |
18 | my %seen; @INC = grep {!$seen{$_}++} @INC; | |
686c4ca0 NC |
19 | |
20 | my $nonfile = tempfile(); | |
21 | ||
2fc7dfcb NC |
22 | # The tests for ' ' and '.h' never did fail, but previously the error reporting |
23 | # code would read memory before the start of the SV's buffer | |
24 | ||
25 | for my $file ($nonfile, ' ') { | |
26 | eval { | |
27 | require $file; | |
28 | }; | |
29 | ||
901d80aa | 30 | like $@, qr/^Can't locate $file in \@INC \(\@INC[\w ]+: \Q@INC\E\) at/, |
2fc7dfcb NC |
31 | "correct error message for require '$file'"; |
32 | } | |
686c4ca0 | 33 | |
d31614f5 DM |
34 | # Check that the "(you may need to install..) hint is included in the |
35 | # error message where (and only where) appropriate. | |
36 | # | |
37 | # Basically the hint should be issued for any filename where converting | |
38 | # back from Foo/Bar.pm to Foo::Bar gives you a legal bare word which could | |
39 | # follow "require" in source code. | |
40 | ||
41 | { | |
42 | ||
43 | # may be any letter of an identifier | |
44 | my $I = "\x{393}"; # "\N{GREEK CAPITAL LETTER GAMMA}" | |
45 | # Continuation char: may only be 2nd+ letter of an identifier | |
46 | my $C = "\x{387}"; # "\N{GREEK ANO TELEIA}" | |
47 | ||
48 | for my $test_data ( | |
49 | # thing to require pathname in err mesg err includes hint? | |
50 | [ "No::Such::Module1", "No/Such/Module1.pm", 1 ], | |
51 | [ "'No/Such/Module1.pm'", "No/Such/Module1.pm", 1 ], | |
52 | [ "_No::Such::Module1", "_No/Such/Module1.pm", 1 ], | |
53 | [ "'_No/Such/Module1.pm'", "_No/Such/Module1.pm", 1 ], | |
54 | [ "'No/Such./Module.pm'", "No/Such./Module.pm", 0 ], | |
55 | [ "No::1Such::Module", "No/1Such/Module.pm", 1 ], | |
56 | [ "'No/1Such/Module.pm'", "No/1Such/Module.pm", 1 ], | |
57 | [ "1No::Such::Module", undef, 0 ], | |
58 | [ "'1No/Such/Module.pm'", "1No/Such/Module.pm", 0 ], | |
59 | ||
60 | # utf8 variants | |
61 | [ "No::Such${I}::Module1", "No/Such${I}/Module1.pm", 1 ], | |
62 | [ "'No/Such${I}/Module1.pm'", "No/Such${I}/Module1.pm", 1 ], | |
63 | [ "_No::Such${I}::Module1", "_No/Such${I}/Module1.pm", 1 ], | |
64 | [ "'_No/Such${I}/Module1.pm'", "_No/Such${I}/Module1.pm", 1 ], | |
65 | [ "'No/Such${I}./Module.pm'", "No/Such${I}./Module.pm", 0 ], | |
66 | [ "No::1Such${I}::Module", "No/1Such${I}/Module.pm", 1 ], | |
67 | [ "'No/1Such${I}/Module.pm'", "No/1Such${I}/Module.pm", 1 ], | |
68 | [ "1No::Such${I}::Module", undef, 0 ], | |
69 | [ "'1No/Such${I}/Module.pm'", "1No/Such${I}/Module.pm", 0 ], | |
70 | ||
71 | # utf8 with continuation char in 1st position | |
72 | [ "No::${C}Such::Module1", undef, 0 ], | |
73 | [ "'No/${C}Such/Module1.pm'", "No/${C}Such/Module1.pm", 0 ], | |
74 | [ "_No::${C}Such::Module1", undef, 0 ], | |
75 | [ "'_No/${C}Such/Module1.pm'", "_No/${C}Such/Module1.pm", 0 ], | |
76 | [ "'No/${C}Such./Module.pm'", "No/${C}Such./Module.pm", 0 ], | |
77 | [ "No::${C}1Such::Module", undef, 0 ], | |
78 | [ "'No/${C}1Such/Module.pm'", "No/${C}1Such/Module.pm", 0 ], | |
79 | [ "1No::${C}Such::Module", undef, 0 ], | |
80 | [ "'1No/${C}Such/Module.pm'", "1No/${C}Such/Module.pm", 0 ], | |
81 | ||
82 | ) { | |
83 | my ($require_arg, $err_path, $has_hint) = @$test_data; | |
84 | ||
85 | my $exp; | |
86 | if (defined $err_path) { | |
87 | $exp = "Can't locate $err_path in \@INC"; | |
88 | if ($has_hint) { | |
89 | my $hint = $err_path; | |
90 | $hint =~ s{/}{::}g; | |
91 | $hint =~ s/\.pm$//; | |
92 | $exp .= " (you may need to install the $hint module)"; | |
93 | } | |
901d80aa | 94 | $exp .= " (\@INC entries checked: @INC) at"; |
d31614f5 DM |
95 | } |
96 | else { | |
97 | # undef implies a require which doesn't compile, | |
98 | # rather than one which triggers a run-time error. | |
99 | # We'll set exp to a suitable value later; | |
100 | $exp = ""; | |
101 | } | |
102 | ||
103 | my $err; | |
104 | { | |
105 | no warnings qw(syntax utf8); | |
106 | if ($require_arg =~ /[^\x00-\xff]/) { | |
107 | eval "require $require_arg"; | |
108 | $err = $@; | |
109 | utf8::decode($err); | |
110 | } | |
111 | else { | |
112 | eval "require $require_arg"; | |
113 | $err = $@; | |
114 | } | |
115 | } | |
116 | ||
117 | for ($err, $exp, $require_arg) { | |
118 | s/([^\x00-\xff])/sprintf"\\x{%x}",ord($1)/ge; | |
119 | } | |
120 | if (length $exp) { | |
121 | $exp = qr/^\Q$exp\E/; | |
122 | } | |
123 | else { | |
124 | $exp = qr/syntax error at|Unrecognized character/; | |
125 | } | |
126 | like $err, $exp, | |
127 | "err for require $require_arg"; | |
128 | } | |
129 | } | |
130 | ||
2fc7dfcb | 131 | |
5bad2b39 DM |
132 | |
133 | eval "require ::$nonfile"; | |
134 | ||
135 | like $@, qr/^Bareword in require must not start with a double-colon:/, | |
136 | "correct error message for require ::$nonfile"; | |
686c4ca0 NC |
137 | |
138 | eval { | |
139 | require "$nonfile.ph"; | |
140 | }; | |
141 | ||
901d80aa | 142 | like $@, qr/^Can't locate $nonfile\.ph in \@INC \(did you run h2ph\?\) \(\@INC[\w ]+: @INC\) at/; |
686c4ca0 | 143 | |
2fc7dfcb NC |
144 | for my $file ("$nonfile.h", ".h") { |
145 | eval { | |
146 | require $file | |
147 | }; | |
686c4ca0 | 148 | |
901d80aa | 149 | like $@, qr/^Can't locate \Q$file\E in \@INC \(change \.h to \.ph maybe\?\) \(did you run h2ph\?\) \(\@INC[\w ]+: @INC\) at/, |
2fc7dfcb NC |
150 | "correct error message for require '$file'"; |
151 | } | |
686c4ca0 | 152 | |
e9ce9c73 PJ |
153 | for my $file ("$nonfile.ph", ".ph") { |
154 | eval { | |
155 | require $file | |
156 | }; | |
157 | ||
901d80aa | 158 | like $@, qr/^Can't locate \Q$file\E in \@INC \(did you run h2ph\?\) \(\@INC[\w ]+: @INC\) at/, |
e9ce9c73 PJ |
159 | "correct error message for require '$file'"; |
160 | } | |
161 | ||
32437794 | 162 | eval 'require <foom>'; |
808cb9e9 | 163 | like $@, qr/^<> at require-statement should be quotes at /, 'require <> error'; |
32437794 | 164 | |
2433d39e BF |
165 | my $module = tempfile(); |
166 | my $mod_file = "$module.pm"; | |
167 | ||
168 | open my $module_fh, ">", $mod_file or die $!; | |
169 | print { $module_fh } "print 1; 1;\n"; | |
170 | close $module_fh; | |
171 | ||
172 | chmod 0333, $mod_file; | |
173 | ||
174 | SKIP: { | |
175 | skip_if_miniperl("these modules may not be available to miniperl", 2); | |
176 | ||
177 | push @INC, '../lib'; | |
178 | require Cwd; | |
179 | require File::Spec::Functions; | |
180 | if ($^O eq 'cygwin') { | |
181 | require Win32; | |
182 | } | |
183 | ||
184 | # Going to try to switch away from root. Might not work. | |
185 | # (stolen from t/op/stat.t) | |
186 | my $olduid = $>; | |
187 | eval { $> = 1; }; | |
188 | skip "Can't test permissions meaningfully if you're superuser", 2 | |
189 | if ($^O eq 'cygwin' ? Win32::IsAdminUser() : $> == 0); | |
190 | ||
191 | local @INC = "."; | |
192 | eval "use $module"; | |
193 | like $@, | |
194 | qr<^\QCan't locate $mod_file:>, | |
195 | "special error message if the file exists but can't be opened"; | |
196 | ||
6e0a4ea0 JL |
197 | SKIP: { |
198 | skip "Can't make the path absolute", 1 | |
199 | if !defined(Cwd::getcwd()); | |
200 | ||
201 | my $file = File::Spec::Functions::catfile(Cwd::getcwd(), $mod_file); | |
202 | eval { | |
203 | require($file); | |
204 | }; | |
205 | like $@, | |
206 | qr<^\QCan't locate $file:>, | |
207 | "...even if we use a full path"; | |
208 | } | |
2433d39e BF |
209 | |
210 | # switch uid back (may not be implemented) | |
211 | eval { $> = $olduid; }; | |
212 | } | |
213 | ||
214 | 1 while unlink $mod_file; | |
215 | ||
686c4ca0 NC |
216 | # I can't see how to test the EMFILE case |
217 | # I can't see how to test the case of not displaying @INC in the message. | |
218 | # (and does that only happen on VMS?) | |
c8028aa6 TC |
219 | |
220 | # fail and print the full filename | |
221 | eval { no warnings 'syscalls'; require "strict.pm\0invalid"; }; | |
222 | like $@, qr/^Can't locate strict\.pm\\0invalid: /, 'require nul check [perl #117265]'; | |
c8028aa6 TC |
223 | { |
224 | my $WARN; | |
225 | local $SIG{__WARN__} = sub { $WARN = shift }; | |
a1b60c8d LM |
226 | { |
227 | my $ret = do "strict.pm\0invalid"; | |
228 | my $exc = $@; | |
229 | my $err = $!; | |
230 | is $ret, undef, 'do nulstring returns undef'; | |
231 | is $exc, '', 'do nulstring clears $@'; | |
232 | $! = $err; | |
233 | ok $!{ENOENT}, 'do nulstring fails with ENOENT'; | |
33fe1955 | 234 | like $WARN, qr{^Invalid \\0 character in pathname for do: strict\.pm\\0invalid at }, 'do nulstring warning'; |
a1b60c8d LM |
235 | } |
236 | ||
237 | $WARN = ''; | |
c8028aa6 TC |
238 | eval { require "strict.pm\0invalid"; }; |
239 | like $WARN, qr{^Invalid \\0 character in pathname for require: strict\.pm\\0invalid at }, 'nul warning'; | |
240 | like $@, qr{^Can't locate strict\.pm\\0invalid: }, 'nul error'; | |
241 | ||
242 | $WARN = ''; | |
243 | local @INC = @INC; | |
624c42e2 | 244 | set_up_inc( "lib\0invalid" ); |
c8028aa6 | 245 | eval { require "unknown.pm" }; |
ddc65b67 | 246 | like $WARN, qr{^Invalid \\0 character in \@INC entry for require: lib\\0invalid at }, 'nul warning'; |
c8028aa6 TC |
247 | } |
248 | eval "require strict\0::invalid;"; | |
249 | like $@, qr/^syntax error at \(eval \d+\) line 1/, 'parse error with \0 in barewords module names'; | |
250 | ||
08f800f8 FC |
251 | # Refs and globs that stringify with embedded nulls |
252 | # These crashed from 5.20 to 5.24 [perl #128182]. | |
253 | eval { no warnings 'syscalls'; require eval "qr/\0/" }; | |
254 | like $@, qr/^Can't locate \(\?\^:\\0\):/, | |
255 | 'require ref that stringifies with embedded null'; | |
256 | eval { no strict; no warnings 'syscalls'; require *{"\0a"} }; | |
257 | like $@, qr/^Can't locate \*main::\\0a:/, | |
258 | 'require ref that stringifies with embedded null'; | |
33fe1955 LM |
259 | |
260 | eval { require undef }; | |
261 | like $@, qr/^Missing or undefined argument to require /; | |
262 | ||
263 | eval { do undef }; | |
264 | like $@, qr/^Missing or undefined argument to do /; | |
265 | ||
266 | eval { require "" }; | |
267 | like $@, qr/^Missing or undefined argument to require /; | |
268 | ||
269 | eval { do "" }; | |
270 | like $@, qr/^Missing or undefined argument to do /; | |
4b62894a DM |
271 | |
272 | # non-searchable pathnames shouldn't mention @INC in the error | |
273 | ||
274 | my $nonsearch = "./no_such_file.pm"; | |
275 | ||
276 | eval "require \"$nonsearch\""; | |
277 | ||
278 | like $@, qr/^Can't locate \Q$nonsearch\E at/, | |
279 | "correct error message for require $nonsearch"; | |
50f6cde6 TC |
280 | |
281 | { | |
282 | # make sure require doesn't treat a non-PL_sv_undef undef as | |
283 | # success in %INC | |
284 | # GH #17428 | |
285 | push @INC, "lib"; | |
286 | ok(!eval { require CannotParse; }, "should fail to load"); | |
287 | local %INC = %INC; # copies \&PL_sv_undef into a new undef | |
50f6cde6 TC |
288 | ok(!eval { require CannotParse; }, |
289 | "check the second attempt also fails"); | |
290 | like $@, qr/Attempt to reload/, "check we failed for the right reason"; | |
291 | } | |
cb4eaf3c YO |
292 | |
293 | { | |
294 | fresh_perl_like( | |
295 | 'unshift @INC, sub { sub { 0 } }; require "asdasd";', | |
296 | qr/asdasd did not return a true value/, | |
297 | { }, '@INC hook blocks do not cause segfault'); | |
298 | } | |
4d6de2e9 YO |
299 | |
300 | { | |
301 | # make sure that modifications to %INC during an INC hooks lifetime | |
302 | # don't result in us having an empty string for the cop_file. | |
303 | # Older perls will output "error at line 1". | |
304 | ||
305 | fresh_perl_like( | |
1a55cc50 YO |
306 | 'use lib qq(./lib); BEGIN{ unshift @INC, ' |
307 | .'sub { if ($_[1] eq "CannotParse.pm" and !$seen++) { ' | |
4d6de2e9 YO |
308 | .'eval q(require $_[1]); warn $@; my $code= qq[die qq(error)];' |
309 | .'open my $fh,"<", q(lib/Dies.pm); return $fh } } } require CannotParse;', | |
310 | qr!\Asyntax error.*?^error at /loader/0x[A-Fa-f0-9]+/CannotParse\.pm line 1\.!ms, | |
311 | { }, 'Inc hooks have the correct cop_file'); | |
312 | } | |
1a55cc50 | 313 | { |
1a55cc50 YO |
314 | # this can segfault or assert prior to @INC hardening. |
315 | fresh_perl_like( | |
316 | 'unshift @INC, sub { *INC=["a","b"] }; ' | |
317 | .'eval "require Frobnitz" or print $@', | |
901d80aa | 318 | qr!\(\@INC[\w ]+: CODE\(0x[A-Fa-f0-9]+\) b\)!, |
1a55cc50 YO |
319 | { }, 'INC hooks do not segfault when overwritten'); |
320 | } | |
321 | { | |
1a55cc50 YO |
322 | # this is the defined behavior, but in older perls the error message |
323 | # would lie and say "contains: a b", which is true in the sense that | |
324 | # it is the value of @INC after the require, but not the directory | |
325 | # list that was looked at. | |
326 | fresh_perl_like( | |
327 | '@INC = (sub { @INC=("a","b"); () }, "z"); ' | |
328 | .'eval "require Frobnitz" or print $@', | |
901d80aa | 329 | qr!\(\@INC[\w ]+: CODE\(0x[A-Fa-f0-9]+\) b\)!, |
1a55cc50 YO |
330 | { }, 'INC hooks that overwrite @INC continue as expected (skips a and z)'); |
331 | } | |
332 | { | |
1a55cc50 YO |
333 | # as of 5.37.7 |
334 | fresh_perl_like( | |
335 | '@INC = (sub { @INC=qw(a b); undef $INC }, "z"); ' | |
336 | .'eval "require Frobnitz" or print $@', | |
901d80aa | 337 | qr!\(\@INC[\w ]+: CODE\(0x[A-Fa-f0-9]+\) a b\)!, |
1a55cc50 YO |
338 | { }, 'INC hooks that overwrite @INC and undef $INC continue at start'); |
339 | } | |
340 | { | |
1a55cc50 YO |
341 | # as of 5.37.7 |
342 | fresh_perl_like( | |
343 | 'sub CB::INCDIR { return "b", "c","d" }; ' | |
344 | .'@INC = ("a",bless({},"CB"),"e");' | |
345 | .'eval "require Frobnitz" or print $@', | |
901d80aa | 346 | qr!\(\@INC[\w ]+: a CB=HASH\(0x[A-Fa-f0-9]+\) b c d e\)!, |
1a55cc50 YO |
347 | { }, 'INCDIR works as expected'); |
348 | } | |
349 | { | |
1a55cc50 YO |
350 | # as of 5.37.7 |
351 | fresh_perl_like( | |
352 | '@INC = ("a",bless({},"CB"),"e");' | |
353 | .'eval "require Frobnitz" or print $@', | |
0d370d41 YO |
354 | qr!Can't locate object method "INC", nor "INCDIR" nor string overload via package "CB" in object hook in \@INC!, |
355 | { }, 'Objects with no INC or INCDIR method and no overload throw an error'); | |
356 | } | |
357 | { | |
358 | # as of 5.37.7 | |
359 | fresh_perl_like( | |
360 | 'package CB { use overload q("") => sub { "Fnorble" };} @INC = ("a",bless({},"CB"),"e");' | |
361 | .'eval "require Frobnitz" or print $@', | |
362 | qr!\(\@INC[\w ]+: a Fnorble e\)!, | |
363 | { }, 'Objects with no INC or INCDIR method but with an overload are stringified'); | |
364 | } | |
365 | { | |
366 | # as of 5.37.7 | |
367 | fresh_perl_like( | |
368 | 'package CB { use overload q(0+) => sub { 12345 }, fallback=>1;} @INC = ("a",bless({},"CB"),"e");' | |
369 | .'eval "require Frobnitz" or print $@', | |
370 | qr!\(\@INC[\w ]+: a 12345 e\)!, | |
371 | { }, 'Objects with no INC or INCDIR method but with an overload with fallback are stringified'); | |
1a55cc50 YO |
372 | } |
373 | { | |
1a55cc50 YO |
374 | # as of 5.37.7 |
375 | fresh_perl_like( | |
376 | '{package CB; use overload qw("")=>sub { "blorg"};} ' | |
377 | .'@INC = ("a",bless({},"CB"),"e");' | |
378 | .'eval "require Frobnitz" or print $@', | |
901d80aa | 379 | qr!\(\@INC[\w ]+: a blorg e\)!, |
1a55cc50 YO |
380 | { }, 'Objects with overload and no INC or INCDIR method are stringified'); |
381 | } | |
382 | { | |
1a55cc50 YO |
383 | # as of 5.37.7 |
384 | fresh_perl_like( | |
385 | '@INC = ("a",bless(sub { warn "blessed sub called" },"CB"),"e");' | |
386 | .'eval "require Frobnitz" or print $@', | |
901d80aa | 387 | qr!blessed sub called.*\(\@INC[\w ]+: a CB=CODE\(0x[a-fA-F0-9]+\) e\)!s, |
1a55cc50 YO |
388 | { }, 'Blessed subs with no hook methods are executed'); |
389 | } | |
390 | { | |
1a55cc50 YO |
391 | # as of 5.37.7 |
392 | fresh_perl_like( | |
393 | '@INC = ("a",bless(sub { die "blessed sub called" },"CB"),"e");' | |
394 | .'eval "require Frobnitz" or print $@', | |
395 | qr!INC sub hook died--halting \@INC search!s, | |
396 | { }, 'Blessed subs that die produce expected extra message'); | |
397 | } | |
398 | { | |
1a55cc50 YO |
399 | # as of 5.37.7 |
400 | fresh_perl_like( | |
401 | 'sub CB::INC { die "bad mojo" } ' | |
402 | .'@INC = ("a",bless(sub { die "blessed sub called" },"CB"),"e");' | |
403 | .'eval "require Frobnitz" or print $@', | |
404 | qr!bad mojo.*INC method hook died--halting \@INC search!s, | |
405 | { }, 'Blessed subs with methods call method and produce expected message'); | |
406 | } | |
407 | { | |
1a55cc50 YO |
408 | # as of 5.37.7 |
409 | fresh_perl_like( | |
410 | '@INC = ("a",[bless([],"CB"),1],"e");' | |
411 | .'eval "require Frobnitz" or print $@', | |
0d370d41 | 412 | qr!Can't locate object method "INC", nor "INCDIR" nor string overload via package "CB" in object in ARRAY hook in \@INC!s, |
1a55cc50 YO |
413 | { }, 'Blessed objects with no hook methods in array form produce expected exception'); |
414 | } | |
415 | { | |
1a55cc50 YO |
416 | # as of 5.37.7 |
417 | fresh_perl_like( | |
418 | 'sub CB::INCDIR { "i" } sub CB2::INCDIR { }' | |
419 | .'@INC = ("a",bless(sub{"b"},"CB"),bless(sub{"c"},"CB2"),"e");' | |
420 | .'eval "require Frobnitz" or print $@', | |
901d80aa | 421 | qr!\(\@INC[\w ]+: a CB=CODE\(0x[a-fA-F0-9]+\) i CB2=CODE\(0x[a-fA-F0-9]+\) e\)!s, |
1a55cc50 YO |
422 | { }, 'Blessed subs with INCDIR methods call INCDIR'); |
423 | } | |
424 | { | |
1a55cc50 YO |
425 | # as of 5.37.7 |
426 | fresh_perl_like( | |
427 | 'sub CB::INCDIR { return @{$_[2]} }' | |
428 | .'@INC = ("a",[bless([],"CB"),"b"],"c");' | |
429 | .'eval "require Frobnitz" or print $@', | |
901d80aa | 430 | qr!\(\@INC[\w ]+: a ARRAY\(0x[a-fA-F0-9]+\) CB=ARRAY\(0x[a-fA-F0-9]+\) b c\)!s, |
1a55cc50 YO |
431 | { }, 'INCDIR ref returns are stringified'); |
432 | } |