they seek him here, they seek him there
[perl.git] / t / op / require_errors.t
1 #!perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc( qw(../lib) );
7 }
8
9 use strict;
10 use warnings;
11
12 plan(tests => 54);
13
14 my $nonfile = tempfile();
15
16 # The tests for ' ' and '.h' never did fail, but previously the error reporting
17 # code would read memory before the start of the SV's buffer
18
19 for my $file ($nonfile, ' ') {
20     eval {
21         require $file;
22     };
23
24     like $@, qr/^Can't locate $file in \@INC \(\@INC contains: @INC\) at/,
25         "correct error message for require '$file'";
26 }
27
28 # Check that the "(you may need to install..) hint is included in the
29 # error message where (and only where) appropriate.
30 #
31 # Basically the hint should be issued for any filename where converting
32 # back from Foo/Bar.pm to Foo::Bar gives you a legal bare word which could
33 # follow "require" in source code.
34
35 {
36
37     # may be any letter of an identifier
38     my $I = "\x{393}";  # "\N{GREEK CAPITAL LETTER GAMMA}"
39     # Continuation char: may only be 2nd+ letter of an identifier
40     my $C = "\x{387}";  # "\N{GREEK ANO TELEIA}"
41
42     for my $test_data (
43         # thing to require        pathname in err mesg     err includes hint?
44         [ "No::Such::Module1",          "No/Such/Module1.pm",       1 ],
45         [ "'No/Such/Module1.pm'",       "No/Such/Module1.pm",       1 ],
46         [ "_No::Such::Module1",         "_No/Such/Module1.pm",      1 ],
47         [ "'_No/Such/Module1.pm'",      "_No/Such/Module1.pm",      1 ],
48         [ "'No/Such./Module.pm'",       "No/Such./Module.pm",       0 ],
49         [ "No::1Such::Module",          "No/1Such/Module.pm",       1 ],
50         [ "'No/1Such/Module.pm'",       "No/1Such/Module.pm",       1 ],
51         [ "1No::Such::Module",           undef,                     0 ],
52         [ "'1No/Such/Module.pm'",       "1No/Such/Module.pm",       0 ],
53
54         # utf8 variants
55         [ "No::Such${I}::Module1",      "No/Such${I}/Module1.pm",   1 ],
56         [ "'No/Such${I}/Module1.pm'",   "No/Such${I}/Module1.pm",   1 ],
57         [ "_No::Such${I}::Module1",     "_No/Such${I}/Module1.pm",  1 ],
58         [ "'_No/Such${I}/Module1.pm'",  "_No/Such${I}/Module1.pm",  1 ],
59         [ "'No/Such${I}./Module.pm'",   "No/Such${I}./Module.pm",   0 ],
60         [ "No::1Such${I}::Module",      "No/1Such${I}/Module.pm",   1 ],
61         [ "'No/1Such${I}/Module.pm'",   "No/1Such${I}/Module.pm",   1 ],
62         [ "1No::Such${I}::Module",       undef,                     0 ],
63         [ "'1No/Such${I}/Module.pm'",   "1No/Such${I}/Module.pm",   0 ],
64
65         # utf8 with continuation char in 1st position
66         [ "No::${C}Such::Module1",      undef,                      0 ],
67         [ "'No/${C}Such/Module1.pm'",   "No/${C}Such/Module1.pm",   0 ],
68         [ "_No::${C}Such::Module1",     undef,                      0 ],
69         [ "'_No/${C}Such/Module1.pm'",  "_No/${C}Such/Module1.pm",  0 ],
70         [ "'No/${C}Such./Module.pm'",   "No/${C}Such./Module.pm",   0 ],
71         [ "No::${C}1Such::Module",      undef,                      0 ],
72         [ "'No/${C}1Such/Module.pm'",   "No/${C}1Such/Module.pm",   0 ],
73         [ "1No::${C}Such::Module",      undef,                      0 ],
74         [ "'1No/${C}Such/Module.pm'",   "1No/${C}Such/Module.pm",   0 ],
75
76     ) {
77         my ($require_arg, $err_path, $has_hint) = @$test_data;
78
79         my $exp;
80         if (defined $err_path) {
81             $exp = "Can't locate $err_path in \@INC";
82             if ($has_hint) {
83                 my $hint = $err_path;
84                 $hint =~ s{/}{::}g;
85                 $hint =~ s/\.pm$//;
86                 $exp .= " (you may need to install the $hint module)";
87             }
88             $exp .= " (\@INC contains: @INC) at";
89         }
90         else {
91             # undef implies a require which doesn't compile,
92             # rather than one which triggers a run-time error.
93             # We'll set exp to a suitable value later;
94             $exp = "";
95         }
96
97         my $err;
98         {
99             no warnings qw(syntax utf8);
100             if ($require_arg =~ /[^\x00-\xff]/) {
101                 eval "require $require_arg";
102                 $err = $@;
103                 utf8::decode($err);
104             }
105             else {
106                 eval "require $require_arg";
107                 $err = $@;
108             }
109         }
110
111         for ($err, $exp, $require_arg) {
112             s/([^\x00-\xff])/sprintf"\\x{%x}",ord($1)/ge;
113         }
114         if (length $exp) {
115             $exp = qr/^\Q$exp\E/;
116         }
117         else {
118             $exp = qr/syntax error at|Unrecognized character/;
119         }
120         like $err, $exp,
121                 "err for require $require_arg";
122     }
123 }
124
125
126
127 eval "require ::$nonfile";
128
129 like $@, qr/^Bareword in require must not start with a double-colon:/,
130         "correct error message for require ::$nonfile";
131
132 eval {
133     require "$nonfile.ph";
134 };
135
136 like $@, qr/^Can't locate $nonfile\.ph in \@INC \(did you run h2ph\?\) \(\@INC contains: @INC\) at/;
137
138 for my $file ("$nonfile.h", ".h") {
139     eval {
140         require $file
141     };
142
143     like $@, qr/^Can't locate \Q$file\E in \@INC \(change \.h to \.ph maybe\?\) \(did you run h2ph\?\) \(\@INC contains: @INC\) at/,
144         "correct error message for require '$file'";
145 }
146
147 for my $file ("$nonfile.ph", ".ph") {
148     eval {
149         require $file
150     };
151
152     like $@, qr/^Can't locate \Q$file\E in \@INC \(did you run h2ph\?\) \(\@INC contains: @INC\) at/,
153         "correct error message for require '$file'";
154 }
155
156 eval 'require <foom>';
157 like $@, qr/^<> at require-statement should be quotes at /, 'require <> error';
158
159 my $module   = tempfile();
160 my $mod_file = "$module.pm";
161
162 open my $module_fh, ">", $mod_file or die $!;
163 print { $module_fh } "print 1; 1;\n";
164 close $module_fh;
165
166 chmod 0333, $mod_file;
167
168 SKIP: {
169     skip_if_miniperl("these modules may not be available to miniperl", 2);
170
171     push @INC, '../lib';
172     require Cwd;
173     require File::Spec::Functions;
174     if ($^O eq 'cygwin') {
175         require Win32;
176     }
177
178     # Going to try to switch away from root.  Might not work.
179     # (stolen from t/op/stat.t)
180     my $olduid = $>;
181     eval { $> = 1; };
182     skip "Can't test permissions meaningfully if you're superuser", 2
183         if ($^O eq 'cygwin' ? Win32::IsAdminUser() : $> == 0);
184
185     local @INC = ".";
186     eval "use $module";
187     like $@,
188         qr<^\QCan't locate $mod_file:>,
189         "special error message if the file exists but can't be opened";
190
191     SKIP: {
192         skip "Can't make the path absolute", 1
193             if !defined(Cwd::getcwd());
194
195         my $file = File::Spec::Functions::catfile(Cwd::getcwd(), $mod_file);
196         eval {
197             require($file);
198         };
199         like $@,
200             qr<^\QCan't locate $file:>,
201             "...even if we use a full path";
202     }
203
204     # switch uid back (may not be implemented)
205     eval { $> = $olduid; };
206 }
207
208 1 while unlink $mod_file;
209
210 # I can't see how to test the EMFILE case
211 # I can't see how to test the case of not displaying @INC in the message.
212 # (and does that only happen on VMS?)
213
214 # fail and print the full filename
215 eval { no warnings 'syscalls'; require "strict.pm\0invalid"; };
216 like $@, qr/^Can't locate strict\.pm\\0invalid: /, 'require nul check [perl #117265]';
217 {
218   my $WARN;
219   local $SIG{__WARN__} = sub { $WARN = shift };
220   {
221     my $ret = do "strict.pm\0invalid";
222     my $exc = $@;
223     my $err = $!;
224     is $ret, undef, 'do nulstring returns undef';
225     is $exc, '',    'do nulstring clears $@';
226     $! = $err;
227     ok $!{ENOENT},  'do nulstring fails with ENOENT';
228     like $WARN, qr{^Invalid \\0 character in pathname for do: strict\.pm\\0invalid at }, 'do nulstring warning';
229   }
230
231   $WARN = '';
232   eval { require "strict.pm\0invalid"; };
233   like $WARN, qr{^Invalid \\0 character in pathname for require: strict\.pm\\0invalid at }, 'nul warning';
234   like $@, qr{^Can't locate strict\.pm\\0invalid: }, 'nul error';
235
236   $WARN = '';
237   local @INC = @INC;
238   set_up_inc( "lib\0invalid" );
239   eval { require "unknown.pm" };
240   like $WARN, qr{^Invalid \\0 character in \@INC entry for require: lib\\0invalid at }, 'nul warning';
241 }
242 eval "require strict\0::invalid;";
243 like $@, qr/^syntax error at \(eval \d+\) line 1/, 'parse error with \0 in barewords module names';
244
245 # Refs and globs that stringify with embedded nulls
246 # These crashed from 5.20 to 5.24 [perl #128182].
247 eval { no warnings 'syscalls'; require eval "qr/\0/" };
248 like $@, qr/^Can't locate \(\?\^:\\0\):/,
249     'require ref that stringifies with embedded null';
250 eval { no strict; no warnings 'syscalls'; require *{"\0a"} };
251 like $@, qr/^Can't locate \*main::\\0a:/,
252     'require ref that stringifies with embedded null';
253
254 eval { require undef };
255 like $@, qr/^Missing or undefined argument to require /;
256
257 eval { do undef };
258 like $@, qr/^Missing or undefined argument to do /;
259
260 eval { require "" };
261 like $@, qr/^Missing or undefined argument to require /;
262
263 eval { do "" };
264 like $@, qr/^Missing or undefined argument to do /;
265
266 # non-searchable pathnames shouldn't mention @INC in the error
267
268 my $nonsearch = "./no_such_file.pm";
269
270 eval "require \"$nonsearch\"";
271
272 like $@, qr/^Can't locate \Q$nonsearch\E at/,
273         "correct error message for require $nonsearch";