This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Tests for the .pmc functionality.
[perl5.git] / t / comp / require.t
CommitLineData
f46d017c
GS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61
MG
5 @INC = '.';
6 push @INC, '../lib';
f46d017c
GS
7}
8
9# don't make this lexical
10$i = 1;
d2f5bb60 11
b0927e10
NC
12my @fjles_to_delete = qw (bleah.pm bleah.do bleah.flg urkkk.pm urkkk.pmc
13krunch.pm krunch.pmc whap.pm whap.pmc);
14
15
d2f5bb60 16my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
8a220075 17my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/;
b0927e10 18my $total_tests = 49;
76b0784a 19if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= 3; }
d2f5bb60 20print "1..$total_tests\n";
f46d017c
GS
21
22sub do_require {
23 %INC = ();
4a9ae47a 24 write_file('bleah.pm',@_);
f46d017c
GS
25 eval { require "bleah.pm" };
26 my @a; # magic guard for scope violations (must be first lexical in file)
27}
28
4a9ae47a
GS
29sub 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
GS
36}
37
9f3d182e
GS
38eval {require 5.005};
39print "# $@\nnot " if $@;
40print "ok ",$i++,"\n";
41
42eval { require 5.005 };
43print "# $@\nnot " if $@;
44print "ok ",$i++,"\n";
45
46eval { require 5.005; };
47print "# $@\nnot " if $@;
48print "ok ",$i++,"\n";
49
50eval {
51 require 5.005
52};
53print "# $@\nnot " if $@;
54print "ok ",$i++,"\n";
55
a7cb1f99
GS
56# new style version numbers
57
58eval { require v5.5.630; };
59print "# $@\nnot " if $@;
60print "ok ",$i++,"\n";
61
dd629d5b 62eval { require 10.0.2; };
a7cb1f99
GS
63print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/;
64print "ok ",$i++,"\n";
65
66eval q{ use v5.5.630; };
67print "# $@\nnot " if $@;
68print "ok ",$i++,"\n";
69
dd629d5b 70eval q{ use 10.0.2; };
a7cb1f99
GS
71print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/;
72print "ok ",$i++,"\n";
73
44dcb63b 74my $ver = 5.005_63;
a7cb1f99
GS
75eval { require $ver; };
76print "# $@\nnot " if $@;
77print "ok ",$i++,"\n";
78
44dcb63b 79# check inaccurate fp
dbe7b177
GS
80$ver = 10.2;
81eval { require $ver; };
9137345a 82print "# $@\nnot " unless $@ =~ /^Perl v10\.200.0 required/;
dbe7b177 83print "ok ",$i++,"\n";
44dcb63b
GS
84
85$ver = 10.000_02;
a7cb1f99 86eval { require $ver; };
44dcb63b 87print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.20 required/;
a7cb1f99
GS
88print "ok ",$i++,"\n";
89
dd629d5b 90print "not " unless 5.5.1 gt v5.5;
a7cb1f99
GS
91print "ok ",$i++,"\n";
92
a7cb1f99 93{
a7cb1f99
GS
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
GS
105# interaction with pod (see the eof)
106write_file('bleah.pm', "print 'ok $i\n'; 1;\n");
107require "bleah.pm";
108$i++;
109
f46d017c
GS
110# run-time failure in require
111do_require "0;\n";
112print "# $@\nnot " unless $@ =~ /did not return a true/;
113print "ok ",$i++,"\n";
114
4d8b06f1
RD
115print "not " if exists $INC{'bleah.pm'};
116print "ok ",$i++,"\n";
117
118my $flag_file = 'bleah.flg';
119# run-time error in require
120for 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
RGS
129 print "not " unless exists $INC{'bleah.pm'};
130 print "ok ",$i++,"\n";
4d8b06f1
RD
131}
132
f46d017c
GS
133# compile-time failure in require
134do_require "1)\n";
f0ec1f9a 135# bison says 'parse error' instead of 'syntax error',
d91e2bdb 136# various yaccs may or may not capitalize 'syntax'.
f0ec1f9a 137print "# $@\nnot " unless $@ =~ /(syntax|parse) error/mi;
f46d017c
GS
138print "ok ",$i++,"\n";
139
27bcc0a7
RGS
140# previous failure cached in %INC
141print "not " unless exists $INC{'bleah.pm'};
142print "ok ",$i++,"\n";
4d8b06f1
RD
143write_file($flag_file, 1);
144write_file('bleah.pm', "unlink '$flag_file'; 1");
145print "# $@\nnot " if eval { require 'bleah.pm' };
146print "ok ",$i++,"\n";
147print "# $@\nnot " unless $@ =~ /Compilation failed/i;
148print "ok ",$i++,"\n";
149print "not " unless -e $flag_file;
150print "ok ",$i++,"\n";
27bcc0a7 151print "not " unless exists $INC{'bleah.pm'};
4d8b06f1
RD
152print "ok ",$i++,"\n";
153
f46d017c
GS
154# successful require
155do_require "1";
156print "# $@\nnot " if $@;
157print "ok ",$i++,"\n";
158
faa7e5bb
GS
159# do FILE shouldn't see any outside lexicals
160my $x = "ok $i\n";
161write_file("bleah.do", <<EOT);
162\$x = "not ok $i\\n";
163EOT
e81465be 164do "bleah.do" or die $@;
faa7e5bb 165dofile();
e81465be 166sub dofile { do "bleah.do" or die $@; };
faa7e5bb 167print $x;
faa7e5bb 168
a89be09a
RGS
169# Test that scalar context is forced for require
170
171write_file('bleah.pm', <<'**BLEAH**'
172print "not " if !defined wantarray || wantarray ne '';
0c58d367 173print "ok $i - require() context\n";
a89be09a
RGS
1741;
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
RGS
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
NC
186# Test for fix of RT #24404 : "require $scalar" may load a directory
187my $r = "threads";
188eval { require $r };
189$i++;
6b845e56 190if($@ =~ /Can't locate threads in \@INC/) {
2d6f15ea
NC
191 print "ok $i\n";
192} else {
193 print "not ok $i\n";
194}
195
57f3ff92
NC
196
197write_file('bleah.pm', qq(die "This is an expected error";\n));
198delete $INC{"bleah.pm"}; ++$::i;
199eval { CORE::require bleah; };
200if ($@ =~ /^This is an expected error/) {
201 print "ok $i\n";
202} else {
203 print "not ok $i\n";
204}
205
b0927e10
NC
206sub 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";
211EOT
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
d20ea72b
RGS
261##########################################
262# What follows are UTF-8 specific tests. #
263# Add generic tests before this point. #
264##########################################
2d6f15ea 265
8a220075 266# UTF-encoded things - skipped on EBCDIC machines and on UTF-8 input
d2f5bb60 267
8a220075 268if ($Is_EBCDIC || $Is_UTF8) { exit; }
d2f5bb60 269
b250498f 270my $utf8 = chr(0xFEFF);
dea0fc0b
JH
271
272$i++; do_require(qq(${utf8}print "ok $i\n"; 1;\n));
273
274sub bytes_to_utf16 {
275 my $utf16 = pack("$_[0]*", unpack("C*", $_[1]));
7d59b7e4 276 return @_ == 3 && $_[2] ? pack("$_[0]", 0xFEFF) . $utf16 : $utf16;
dea0fc0b
JH
277}
278
279$i++; do_require(bytes_to_utf16('n', qq(print "ok $i\\n"; 1;\n), 1)); # BE
280$i++; do_require(bytes_to_utf16('v', qq(print "ok $i\\n"; 1;\n), 1)); # LE
b250498f 281
4d8b06f1 282END {
b0927e10
NC
283 foreach my $file (@fjles_to_delete) {
284 1 while unlink $file;
285 }
4d8b06f1 286}
4a9ae47a
GS
287
288# ***interaction with pod (don't put any thing after here)***
289
290=pod