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