Commit | Line | Data |
f46d017c |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '.'; |
6 | push @INC, '../lib'; |
f46d017c |
7 | } |
8 | |
9 | # don't make this lexical |
10 | $i = 1; |
d2f5bb60 |
11 | |
b0927e10 |
12 | my @fjles_to_delete = qw (bleah.pm bleah.do bleah.flg urkkk.pm urkkk.pmc |
13 | krunch.pm krunch.pmc whap.pm whap.pmc); |
14 | |
15 | |
d2f5bb60 |
16 | my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0; |
8a220075 |
17 | my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/; |
ca4cfd28 |
18 | my $total_tests = 50; |
76b0784a |
19 | if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= 3; } |
d2f5bb60 |
20 | print "1..$total_tests\n"; |
f46d017c |
21 | |
22 | sub do_require { |
23 | %INC = (); |
4a9ae47a |
24 | write_file('bleah.pm',@_); |
f46d017c |
25 | eval { require "bleah.pm" }; |
26 | my @a; # magic guard for scope violations (must be first lexical in file) |
27 | } |
28 | |
4a9ae47a |
29 | sub write_file { |
30 | my $f = shift; |
31 | open(REQ,">$f") or die "Can't write '$f': $!"; |
9f82a649 |
32 | binmode REQ; |
7d59b7e4 |
33 | use bytes; |
4a9ae47a |
34 | print REQ @_; |
d1e4d418 |
35 | close REQ or die "Could not close $f: $!"; |
4a9ae47a |
36 | } |
37 | |
9f3d182e |
38 | eval {require 5.005}; |
39 | print "# $@\nnot " if $@; |
40 | print "ok ",$i++,"\n"; |
41 | |
42 | eval { require 5.005 }; |
43 | print "# $@\nnot " if $@; |
44 | print "ok ",$i++,"\n"; |
45 | |
46 | eval { require 5.005; }; |
47 | print "# $@\nnot " if $@; |
48 | print "ok ",$i++,"\n"; |
49 | |
50 | eval { |
51 | require 5.005 |
52 | }; |
53 | print "# $@\nnot " if $@; |
54 | print "ok ",$i++,"\n"; |
55 | |
a7cb1f99 |
56 | # new style version numbers |
57 | |
58 | eval { require v5.5.630; }; |
59 | print "# $@\nnot " if $@; |
60 | print "ok ",$i++,"\n"; |
61 | |
dd629d5b |
62 | eval { require 10.0.2; }; |
a7cb1f99 |
63 | print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; |
64 | print "ok ",$i++,"\n"; |
65 | |
66 | eval q{ use v5.5.630; }; |
67 | print "# $@\nnot " if $@; |
68 | print "ok ",$i++,"\n"; |
69 | |
dd629d5b |
70 | eval q{ use 10.0.2; }; |
a7cb1f99 |
71 | print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; |
72 | print "ok ",$i++,"\n"; |
73 | |
44dcb63b |
74 | my $ver = 5.005_63; |
a7cb1f99 |
75 | eval { require $ver; }; |
76 | print "# $@\nnot " if $@; |
77 | print "ok ",$i++,"\n"; |
78 | |
44dcb63b |
79 | # check inaccurate fp |
dbe7b177 |
80 | $ver = 10.2; |
81 | eval { require $ver; }; |
9137345a |
82 | print "# $@\nnot " unless $@ =~ /^Perl v10\.200.0 required/; |
dbe7b177 |
83 | print "ok ",$i++,"\n"; |
44dcb63b |
84 | |
85 | $ver = 10.000_02; |
a7cb1f99 |
86 | eval { require $ver; }; |
44dcb63b |
87 | print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.20 required/; |
a7cb1f99 |
88 | print "ok ",$i++,"\n"; |
89 | |
dd629d5b |
90 | print "not " unless 5.5.1 gt v5.5; |
a7cb1f99 |
91 | print "ok ",$i++,"\n"; |
92 | |
a7cb1f99 |
93 | { |
a7cb1f99 |
94 | print "not " unless v5.5.640 eq "\x{5}\x{5}\x{280}"; |
95 | print "ok ",$i++,"\n"; |
96 | |
97 | print "not " unless v7.15 eq "\x{7}\x{f}"; |
98 | print "ok ",$i++,"\n"; |
99 | |
100 | print "not " |
101 | unless v1.20.300.4000.50000.600000 eq "\x{1}\x{14}\x{12c}\x{fa0}\x{c350}\x{927c0}"; |
102 | print "ok ",$i++,"\n"; |
103 | } |
104 | |
4a9ae47a |
105 | # interaction with pod (see the eof) |
106 | write_file('bleah.pm', "print 'ok $i\n'; 1;\n"); |
107 | require "bleah.pm"; |
108 | $i++; |
109 | |
f46d017c |
110 | # run-time failure in require |
111 | do_require "0;\n"; |
112 | print "# $@\nnot " unless $@ =~ /did not return a true/; |
113 | print "ok ",$i++,"\n"; |
114 | |
4d8b06f1 |
115 | print "not " if exists $INC{'bleah.pm'}; |
116 | print "ok ",$i++,"\n"; |
117 | |
118 | my $flag_file = 'bleah.flg'; |
119 | # run-time error in require |
120 | for my $expected_compile (1,0) { |
121 | write_file($flag_file, 1); |
122 | print "not " unless -e $flag_file; |
123 | print "ok ",$i++,"\n"; |
124 | write_file('bleah.pm', "unlink '$flag_file' or die; \$a=0; \$b=1/\$a; 1;\n"); |
125 | print "# $@\nnot " if eval { require 'bleah.pm' }; |
126 | print "ok ",$i++,"\n"; |
127 | print "not " unless -e $flag_file xor $expected_compile; |
128 | print "ok ",$i++,"\n"; |
27bcc0a7 |
129 | print "not " unless exists $INC{'bleah.pm'}; |
130 | print "ok ",$i++,"\n"; |
4d8b06f1 |
131 | } |
132 | |
f46d017c |
133 | # compile-time failure in require |
134 | do_require "1)\n"; |
f0ec1f9a |
135 | # bison says 'parse error' instead of 'syntax error', |
d91e2bdb |
136 | # various yaccs may or may not capitalize 'syntax'. |
f0ec1f9a |
137 | print "# $@\nnot " unless $@ =~ /(syntax|parse) error/mi; |
f46d017c |
138 | print "ok ",$i++,"\n"; |
139 | |
27bcc0a7 |
140 | # previous failure cached in %INC |
141 | print "not " unless exists $INC{'bleah.pm'}; |
142 | print "ok ",$i++,"\n"; |
4d8b06f1 |
143 | write_file($flag_file, 1); |
144 | write_file('bleah.pm', "unlink '$flag_file'; 1"); |
145 | print "# $@\nnot " if eval { require 'bleah.pm' }; |
146 | print "ok ",$i++,"\n"; |
147 | print "# $@\nnot " unless $@ =~ /Compilation failed/i; |
148 | print "ok ",$i++,"\n"; |
149 | print "not " unless -e $flag_file; |
150 | print "ok ",$i++,"\n"; |
27bcc0a7 |
151 | print "not " unless exists $INC{'bleah.pm'}; |
4d8b06f1 |
152 | print "ok ",$i++,"\n"; |
153 | |
f46d017c |
154 | # successful require |
155 | do_require "1"; |
156 | print "# $@\nnot " if $@; |
157 | print "ok ",$i++,"\n"; |
158 | |
faa7e5bb |
159 | # do FILE shouldn't see any outside lexicals |
160 | my $x = "ok $i\n"; |
161 | write_file("bleah.do", <<EOT); |
162 | \$x = "not ok $i\\n"; |
163 | EOT |
e81465be |
164 | do "bleah.do" or die $@; |
faa7e5bb |
165 | dofile(); |
e81465be |
166 | sub dofile { do "bleah.do" or die $@; }; |
faa7e5bb |
167 | print $x; |
faa7e5bb |
168 | |
a89be09a |
169 | # Test that scalar context is forced for require |
170 | |
171 | write_file('bleah.pm', <<'**BLEAH**' |
172 | print "not " if !defined wantarray || wantarray ne ''; |
0c58d367 |
173 | print "ok $i - require() context\n"; |
a89be09a |
174 | 1; |
175 | **BLEAH** |
176 | ); |
177 | delete $INC{"bleah.pm"}; ++$::i; |
178 | $foo = eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
179 | @foo = eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
180 | eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
0c58d367 |
181 | eval q{$_=$_+2;require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
a89be09a |
182 | $foo = eval {require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
183 | @foo = eval {require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
184 | eval {require bleah}; |
185 | |
2d6f15ea |
186 | # Test for fix of RT #24404 : "require $scalar" may load a directory |
187 | my $r = "threads"; |
188 | eval { require $r }; |
189 | $i++; |
6b845e56 |
190 | if($@ =~ /Can't locate threads in \@INC/) { |
2d6f15ea |
191 | print "ok $i\n"; |
192 | } else { |
193 | print "not ok $i\n"; |
194 | } |
195 | |
57f3ff92 |
196 | |
197 | write_file('bleah.pm', qq(die "This is an expected error";\n)); |
198 | delete $INC{"bleah.pm"}; ++$::i; |
199 | eval { CORE::require bleah; }; |
200 | if ($@ =~ /^This is an expected error/) { |
201 | print "ok $i\n"; |
202 | } else { |
203 | print "not ok $i\n"; |
204 | } |
205 | |
b0927e10 |
206 | sub write_file_not_thing { |
207 | my ($file, $thing, $test) = @_; |
208 | write_file($file, <<"EOT"); |
209 | print "not ok $test\n"; |
210 | die "The $thing file should not be loaded"; |
211 | EOT |
212 | } |
213 | |
214 | { |
215 | # Right. We really really need Config here. |
216 | require Config; |
217 | die "Failed to load Config for some reason" |
218 | unless $Config::Config{version}; |
219 | my $ccflags = $Config::Config{ccflags}; |
220 | die "Failed to get ccflags for some reason" unless defined $ccflags; |
221 | |
222 | my $simple = ++$i; |
223 | my $pmc_older = ++$i; |
224 | my $pmc_dies = ++$i; |
225 | if ($ccflags =~ /(?:^|\s)-DPERL_DISABLE_PMC\b/) { |
226 | print "# .pmc files are ignored, so test that\n"; |
227 | write_file_not_thing('krunch.pmc', '.pmc', $pmc_older); |
228 | write_file('urkkk.pm', qq(print "ok $simple\n")); |
229 | write_file('whap.pmc', qq(die "This is not an expected error")); |
230 | |
231 | print "# Sleeping for 2 seconds before creating some more files\n"; |
232 | sleep 2; |
233 | |
234 | write_file('krunch.pm', qq(print "ok $pmc_older\n")); |
235 | write_file_not_thing('urkkk.pmc', '.pmc', $simple); |
236 | write_file('whap.pm', qq(die "This is an expected error")); |
237 | } else { |
238 | print "# .pmc files should be loaded, so test that\n"; |
239 | write_file('krunch.pmc', qq(print "ok $pmc_older\n";)); |
240 | write_file_not_thing('urkkk.pm', '.pm', $simple); |
241 | write_file('whap.pmc', qq(die "This is an expected error")); |
242 | |
243 | print "# Sleeping for 2 seconds before creating some more files\n"; |
244 | sleep 2; |
245 | |
246 | write_file_not_thing('krunch.pm', '.pm', $pmc_older); |
247 | write_file('urkkk.pmc', qq(print "ok $simple\n";)); |
248 | write_file_not_thing('whap.pm', '.pm', $pmc_dies); |
249 | } |
250 | require urkkk; |
251 | require krunch; |
252 | eval {CORE::require whap; 1} and die; |
253 | |
254 | if ($@ =~ /^This is an expected error/) { |
255 | print "ok $pmc_dies\n"; |
256 | } else { |
257 | print "not ok $pmc_dies\n"; |
258 | } |
259 | } |
260 | |
ca4cfd28 |
261 | # [perl #49472] Attributes + Unkown Error |
262 | |
263 | { |
264 | do_require |
265 | 'use strict;sub MODIFY_CODE_ATTRIBUTE{} sub f:Blah {$nosuchvar}'; |
266 | my $err = $@; |
267 | $err .= "\n" unless $err =~ /\n$/; |
268 | unless ($err =~ /Global symbol "\$nosuchvar" requires /) { |
269 | $err =~ s/^/# /mg; |
270 | print "${err}not "; |
271 | } |
272 | print "ok ", ++$i, " [perl #49472]\n"; |
273 | } |
274 | |
d20ea72b |
275 | ########################################## |
276 | # What follows are UTF-8 specific tests. # |
277 | # Add generic tests before this point. # |
278 | ########################################## |
2d6f15ea |
279 | |
8a220075 |
280 | # UTF-encoded things - skipped on EBCDIC machines and on UTF-8 input |
d2f5bb60 |
281 | |
8a220075 |
282 | if ($Is_EBCDIC || $Is_UTF8) { exit; } |
d2f5bb60 |
283 | |
b250498f |
284 | my $utf8 = chr(0xFEFF); |
dea0fc0b |
285 | |
286 | $i++; do_require(qq(${utf8}print "ok $i\n"; 1;\n)); |
287 | |
288 | sub bytes_to_utf16 { |
289 | my $utf16 = pack("$_[0]*", unpack("C*", $_[1])); |
7d59b7e4 |
290 | return @_ == 3 && $_[2] ? pack("$_[0]", 0xFEFF) . $utf16 : $utf16; |
dea0fc0b |
291 | } |
292 | |
293 | $i++; do_require(bytes_to_utf16('n', qq(print "ok $i\\n"; 1;\n), 1)); # BE |
294 | $i++; do_require(bytes_to_utf16('v', qq(print "ok $i\\n"; 1;\n), 1)); # LE |
b250498f |
295 | |
4d8b06f1 |
296 | END { |
b0927e10 |
297 | foreach my $file (@fjles_to_delete) { |
298 | 1 while unlink $file; |
299 | } |
4d8b06f1 |
300 | } |
4a9ae47a |
301 | |
302 | # ***interaction with pod (don't put any thing after here)*** |
303 | |
304 | =pod |