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";