This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #117265] safesyscalls: check embedded nul in syscall args
[perl5.git] / 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/^<> 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 pathname for require: lib\\0invalid/unknown\.pm 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