t/op/require_errors.t

   1 #!perl
   2 use strict;
   3 use warnings;
   4
   5 BEGIN {
   6     chdir 't';
   7     require './test.pl';
   8 }
   9
  10 plan(tests => 17);
  11
  12 my $nonfile = tempfile();
  13
  14 @INC = qw(Perl Rules);
  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 eval "require $nonfile";
  29
  30 like $@, qr/^Can't locate $nonfile\.pm in \@INC \(you may need to install the $nonfile module\) \(\@INC contains: @INC\) at/,
  31     "correct error message for require $nonfile";
  32
  33 eval {
  34     require "$nonfile.ph";
  35 };
  36
  37 like $@, qr/^Can't locate $nonfile\.ph in \@INC \(did you run h2ph\?\) \(\@INC contains: @INC\) at/;
  38
  39 for my $file ("$nonfile.h", ".h") {
  40     eval {
  41         require $file
  42     };
  43
  44     like $@, qr/^Can't locate \Q$file\E in \@INC \(change \.h to \.ph maybe\?\) \(did you run h2ph\?\) \(\@INC contains: @INC\) at/,
  45         "correct error message for require '$file'";
  46 }
  47
  48 for my $file ("$nonfile.ph", ".ph") {
  49     eval {
  50         require $file
  51     };
  52
  53     like $@, qr/^Can't locate \Q$file\E in \@INC \(did you run h2ph\?\) \(\@INC contains: @INC\) at/,
  54         "correct error message for require '$file'";
  55 }
  56
  57 eval 'require <foom>';
  58 like $@, qr/^<> at require-statement should be quotes at /, 'require <> error';
  59
  60 my $module   = tempfile();
  61 my $mod_file = "$module.pm";
  62
  63 open my $module_fh, ">", $mod_file or die $!;
  64 print { $module_fh } "print 1; 1;\n";
  65 close $module_fh;
  66
  67 chmod 0333, $mod_file;
  68
  69 SKIP: {
  70     skip_if_miniperl("these modules may not be available to miniperl", 2);
  71
  72     push @INC, '../lib';
  73     require Cwd;
  74     require File::Spec::Functions;
  75     if ($^O eq 'cygwin') {
  76         require Win32;
  77     }
  78
  79     # Going to try to switch away from root.  Might not work.
  80     # (stolen from t/op/stat.t)
  81     my $olduid = $>;
  82     eval { $> = 1; };
  83     skip "Can't test permissions meaningfully if you're superuser", 2
  84         if ($^O eq 'cygwin' ? Win32::IsAdminUser() : $> == 0);
  85
  86     local @INC = ".";
  87     eval "use $module";
  88     like $@,
  89         qr<^\QCan't locate $mod_file:>,
  90         "special error message if the file exists but can't be opened";
  91
  92     SKIP: {
  93         skip "Can't make the path absolute", 1
  94             if !defined(Cwd::getcwd());
  95
  96         my $file = File::Spec::Functions::catfile(Cwd::getcwd(), $mod_file);
  97         eval {
  98             require($file);
  99         };
 100         like $@,
 101             qr<^\QCan't locate $file:>,
 102             "...even if we use a full path";
 103     }
 104
 105     # switch uid back (may not be implemented)
 106     eval { $> = $olduid; };
 107 }
 108
 109 1 while unlink $mod_file;
 110
 111 # I can't see how to test the EMFILE case
 112 # I can't see how to test the case of not displaying @INC in the message.
 113 # (and does that only happen on VMS?)
 114
 115 # fail and print the full filename
 116 eval { no warnings 'syscalls'; require "strict.pm\0invalid"; };
 117 like $@, qr/^Can't locate strict\.pm\\0invalid: /, 'require nul check [perl #117265]';
 118 eval { no warnings 'syscalls'; do "strict.pm\0invalid"; };
 119 like $@, qr/^Can't locate strict\.pm\\0invalid: /, 'do nul check';
 120 {
 121   my $WARN;
 122   local $SIG{__WARN__} = sub { $WARN = shift };
 123   eval { require "strict.pm\0invalid"; };
 124   like $WARN, qr{^Invalid \\0 character in pathname for require: strict\.pm\\0invalid at }, 'nul warning';
 125   like $@, qr{^Can't locate strict\.pm\\0invalid: }, 'nul error';
 126
 127   $WARN = '';
 128   local @INC = @INC;
 129   unshift @INC, "lib\0invalid";
 130   eval { require "unknown.pm" };
 131   like $WARN, qr{^Invalid \\0 character in \@INC entry for require: lib\\0invalid at }, 'nul warning';
 132 }
 133 eval "require strict\0::invalid;";
 134 like $@, qr/^syntax error at \(eval \d+\) line 1/, 'parse error with \0 in barewords module names';
 135