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 => 73);
  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;
  19
  20 my $nonfile = tempfile();
  21
  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
  30     like $@, qr/^Can't locate $file in \@INC \(\@INC[\w ]+: \Q@INC\E\) at/,
  31         "correct error message for require '$file'";
  32 }
  33
  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             }
  94             $exp .= " (\@INC entries checked: @INC) at";
  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
 131
 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";
 137
 138 eval {
 139     require "$nonfile.ph";
 140 };
 141
 142 like $@, qr/^Can't locate $nonfile\.ph in \@INC \(did you run h2ph\?\) \(\@INC[\w ]+: @INC\) at/;
 143
 144 for my $file ("$nonfile.h", ".h") {
 145     eval {
 146         require $file
 147     };
 148
 149     like $@, qr/^Can't locate \Q$file\E in \@INC \(change \.h to \.ph maybe\?\) \(did you run h2ph\?\) \(\@INC[\w ]+: @INC\) at/,
 150         "correct error message for require '$file'";
 151 }
 152
 153 for my $file ("$nonfile.ph", ".ph") {
 154     eval {
 155         require $file
 156     };
 157
 158     like $@, qr/^Can't locate \Q$file\E in \@INC \(did you run h2ph\?\) \(\@INC[\w ]+: @INC\) at/,
 159         "correct error message for require '$file'";
 160 }
 161
 162 eval 'require <foom>';
 163 like $@, qr/^<> at require-statement should be quotes at /, 'require <> error';
 164
 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
 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     }
 209
 210     # switch uid back (may not be implemented)
 211     eval { $> = $olduid; };
 212 }
 213
 214 1 while unlink $mod_file;
 215
 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?)
 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]';
 223 {
 224   my $WARN;
 225   local $SIG{__WARN__} = sub { $WARN = shift };
 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';
 234     like $WARN, qr{^Invalid \\0 character in pathname for do: strict\.pm\\0invalid at }, 'do nulstring warning';
 235   }
 236
 237   $WARN = '';
 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;
 244   set_up_inc( "lib\0invalid" );
 245   eval { require "unknown.pm" };
 246   like $WARN, qr{^Invalid \\0 character in \@INC entry for require: lib\\0invalid at }, 'nul warning';
 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
 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';
 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 /;
 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";
 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
 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 }
 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 }
 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(
 306         'use lib qq(./lib); BEGIN{ unshift @INC, '
 307        .'sub { if ($_[1] eq "CannotParse.pm" and !$seen++) { '
 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 }
 313 {
 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 $@',
 318         qr!\(\@INC[\w ]+: CODE\(0x[A-Fa-f0-9]+\) b\)!,
 319         { }, 'INC hooks do not segfault when overwritten');
 320 }
 321 {
 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 $@',
 329         qr!\(\@INC[\w ]+: CODE\(0x[A-Fa-f0-9]+\) b\)!,
 330         { }, 'INC hooks that overwrite @INC continue as expected (skips a and z)');
 331 }
 332 {
 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 $@',
 337         qr!\(\@INC[\w ]+: CODE\(0x[A-Fa-f0-9]+\) a b\)!,
 338         { }, 'INC hooks that overwrite @INC and undef $INC continue at start');
 339 }
 340 {
 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 $@',
 346         qr!\(\@INC[\w ]+: a CB=HASH\(0x[A-Fa-f0-9]+\) b c d e\)!,
 347         { }, 'INCDIR works as expected');
 348 }
 349 {
 350     # as of 5.37.7
 351     fresh_perl_like(
 352         '@INC = ("a",bless({},"CB"),"e");'
 353        .'eval "require Frobnitz" or print $@',
 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');
 372 }
 373 {
 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 $@',
 379         qr!\(\@INC[\w ]+: a blorg e\)!,
 380         { }, 'Objects with overload and no INC or INCDIR method are stringified');
 381 }
 382 {
 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 $@',
 387         qr!blessed sub called.*\(\@INC[\w ]+: a CB=CODE\(0x[a-fA-F0-9]+\) e\)!s,
 388         { }, 'Blessed subs with no hook methods are executed');
 389 }
 390 {
 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 {
 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 {
 408     # as of 5.37.7
 409     fresh_perl_like(
 410         '@INC = ("a",[bless([],"CB"),1],"e");'
 411        .'eval "require Frobnitz" or print $@',
 412         qr!Can't locate object method "INC", nor "INCDIR" nor string overload via package "CB" in object in ARRAY hook in \@INC!s,
 413         { }, 'Blessed objects with no hook methods in array form produce expected exception');
 414 }
 415 {
 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 $@',
 421         qr!\(\@INC[\w ]+: a CB=CODE\(0x[a-fA-F0-9]+\) i CB2=CODE\(0x[a-fA-F0-9]+\) e\)!s,
 422         { }, 'Blessed subs with INCDIR methods call INCDIR');
 423 }
 424 {
 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 $@',
 430         qr!\(\@INC[\w ]+: a ARRAY\(0x[a-fA-F0-9]+\) CB=ARRAY\(0x[a-fA-F0-9]+\) b c\)!s,
 431         { }, 'INCDIR ref returns are stringified');
 432 }