1#!perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc( qw(../lib) );
7}
8
9use strict;
10use warnings;
11
12plan(tests => 57);
13
14my $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
19for 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
127eval "require ::$nonfile";
128
129like $@, qr/^Bareword in require must not start with a double-colon:/,
130        "correct error message for require ::$nonfile";
131
132eval {
133    require "$nonfile.ph";
134};
135
136like $@, qr/^Can't locate $nonfile\.ph in \@INC \(did you run h2ph\?\) \(\@INC contains: @INC\) at/;
137
138for 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
147for 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
156eval 'require <foom>';
157like $@, qr/^<> at require-statement should be quotes at /, 'require <> error';
158
159my $module   = tempfile();
160my $mod_file = "$module.pm";
161
162open my $module_fh, ">", $mod_file or die $!;
163print { $module_fh } "print 1; 1;\n";
164close $module_fh;
165
166chmod 0333, $mod_file;
167
168SKIP: {
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
2081 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
215eval { no warnings 'syscalls'; require "strict.pm\0invalid"; };
216like $@, 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}
242eval "require strict\0::invalid;";
243like $@, 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].
247eval { no warnings 'syscalls'; require eval "qr/\0/" };
248like $@, qr/^Can't locate \(\?\^:\\0\):/,
249    'require ref that stringifies with embedded null';
250eval { no strict; no warnings 'syscalls'; require *{"\0a"} };
251like $@, qr/^Can't locate \*main::\\0a:/,
252    'require ref that stringifies with embedded null';
253
254eval { require undef };
255like $@, qr/^Missing or undefined argument to require /;
256
257eval { do undef };
258like $@, qr/^Missing or undefined argument to do /;
259
260eval { require "" };
261like $@, qr/^Missing or undefined argument to require /;
262
263eval { do "" };
264like $@, qr/^Missing or undefined argument to do /;
265
266# non-searchable pathnames shouldn't mention @INC in the error
267
268my $nonsearch = "./no_such_file.pm";
269
270eval "require \"$nonsearch\"";
271
272like $@, qr/^Can't locate \Q$nonsearch\E at/,
273        "correct error message for require $nonsearch";
274
275{
276    # make sure require doesn't treat a non-PL_sv_undef undef as
277    # success in %INC
278    # GH #17428
279    push @INC, "lib";
280    ok(!eval { require CannotParse; }, "should fail to load");
281    local %INC = %INC; # copies \&PL_sv_undef into a new undef
282    ok(!eval { require CannotParse; },
283       "check the second attempt also fails");
284    like $@, qr/Attempt to reload/, "check we failed for the right reason";
285}
286