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 | |
12 | my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0; |
8a220075 |
13 | my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/; |
10ac9278 |
14 | my $total_tests = 43; |
15 | my $ebcdic_utf8_skips = 3; |
16 | if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= $ebcdic_utf8_skips; } |
d2f5bb60 |
17 | print "1..$total_tests\n"; |
f46d017c |
18 | |
19 | sub do_require { |
20 | %INC = (); |
4a9ae47a |
21 | write_file('bleah.pm',@_); |
f46d017c |
22 | eval { require "bleah.pm" }; |
23 | my @a; # magic guard for scope violations (must be first lexical in file) |
24 | } |
25 | |
4a9ae47a |
26 | sub write_file { |
27 | my $f = shift; |
28 | open(REQ,">$f") or die "Can't write '$f': $!"; |
9f82a649 |
29 | binmode REQ; |
7d59b7e4 |
30 | use bytes; |
4a9ae47a |
31 | print REQ @_; |
d1e4d418 |
32 | close REQ or die "Could not close $f: $!"; |
4a9ae47a |
33 | } |
34 | |
9f3d182e |
35 | eval {require 5.005}; |
36 | print "# $@\nnot " if $@; |
37 | print "ok ",$i++,"\n"; |
38 | |
39 | eval { require 5.005 }; |
40 | print "# $@\nnot " if $@; |
41 | print "ok ",$i++,"\n"; |
42 | |
43 | eval { require 5.005; }; |
44 | print "# $@\nnot " if $@; |
45 | print "ok ",$i++,"\n"; |
46 | |
47 | eval { |
48 | require 5.005 |
49 | }; |
50 | print "# $@\nnot " if $@; |
51 | print "ok ",$i++,"\n"; |
52 | |
a7cb1f99 |
53 | # new style version numbers |
54 | |
55 | eval { require v5.5.630; }; |
56 | print "# $@\nnot " if $@; |
57 | print "ok ",$i++,"\n"; |
58 | |
dd629d5b |
59 | eval { require 10.0.2; }; |
a7cb1f99 |
60 | print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; |
61 | print "ok ",$i++,"\n"; |
62 | |
63 | eval q{ use v5.5.630; }; |
64 | print "# $@\nnot " if $@; |
65 | print "ok ",$i++,"\n"; |
66 | |
dd629d5b |
67 | eval q{ use 10.0.2; }; |
a7cb1f99 |
68 | print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; |
69 | print "ok ",$i++,"\n"; |
70 | |
44dcb63b |
71 | my $ver = 5.005_63; |
a7cb1f99 |
72 | eval { require $ver; }; |
73 | print "# $@\nnot " if $@; |
74 | print "ok ",$i++,"\n"; |
75 | |
44dcb63b |
76 | # check inaccurate fp |
dbe7b177 |
77 | $ver = 10.2; |
78 | eval { require $ver; }; |
d7aa5382 |
79 | print "# $@\nnot " unless $@ =~ /^Perl v10\.200 required/; |
dbe7b177 |
80 | print "ok ",$i++,"\n"; |
44dcb63b |
81 | |
82 | $ver = 10.000_02; |
a7cb1f99 |
83 | eval { require $ver; }; |
44dcb63b |
84 | print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.20 required/; |
a7cb1f99 |
85 | print "ok ",$i++,"\n"; |
86 | |
dd629d5b |
87 | print "not " unless 5.5.1 gt v5.5; |
a7cb1f99 |
88 | print "ok ",$i++,"\n"; |
89 | |
a7cb1f99 |
90 | { |
a7cb1f99 |
91 | print "not " unless v5.5.640 eq "\x{5}\x{5}\x{280}"; |
92 | print "ok ",$i++,"\n"; |
93 | |
94 | print "not " unless v7.15 eq "\x{7}\x{f}"; |
95 | print "ok ",$i++,"\n"; |
96 | |
97 | print "not " |
98 | unless v1.20.300.4000.50000.600000 eq "\x{1}\x{14}\x{12c}\x{fa0}\x{c350}\x{927c0}"; |
99 | print "ok ",$i++,"\n"; |
100 | } |
101 | |
4a9ae47a |
102 | # interaction with pod (see the eof) |
103 | write_file('bleah.pm', "print 'ok $i\n'; 1;\n"); |
104 | require "bleah.pm"; |
105 | $i++; |
106 | |
f46d017c |
107 | # run-time failure in require |
108 | do_require "0;\n"; |
109 | print "# $@\nnot " unless $@ =~ /did not return a true/; |
110 | print "ok ",$i++,"\n"; |
111 | |
4d8b06f1 |
112 | print "not " if exists $INC{'bleah.pm'}; |
113 | print "ok ",$i++,"\n"; |
114 | |
115 | my $flag_file = 'bleah.flg'; |
116 | # run-time error in require |
117 | for my $expected_compile (1,0) { |
118 | write_file($flag_file, 1); |
119 | print "not " unless -e $flag_file; |
120 | print "ok ",$i++,"\n"; |
121 | write_file('bleah.pm', "unlink '$flag_file' or die; \$a=0; \$b=1/\$a; 1;\n"); |
122 | print "# $@\nnot " if eval { require 'bleah.pm' }; |
123 | print "ok ",$i++,"\n"; |
124 | print "not " unless -e $flag_file xor $expected_compile; |
125 | print "ok ",$i++,"\n"; |
4d8b06f1 |
126 | } |
127 | |
f46d017c |
128 | # compile-time failure in require |
129 | do_require "1)\n"; |
f0ec1f9a |
130 | # bison says 'parse error' instead of 'syntax error', |
d91e2bdb |
131 | # various yaccs may or may not capitalize 'syntax'. |
f0ec1f9a |
132 | print "# $@\nnot " unless $@ =~ /(syntax|parse) error/mi; |
f46d017c |
133 | print "ok ",$i++,"\n"; |
134 | |
4d8b06f1 |
135 | write_file($flag_file, 1); |
136 | write_file('bleah.pm', "unlink '$flag_file'; 1"); |
137 | print "# $@\nnot " if eval { require 'bleah.pm' }; |
138 | print "ok ",$i++,"\n"; |
139 | print "# $@\nnot " unless $@ =~ /Compilation failed/i; |
140 | print "ok ",$i++,"\n"; |
141 | print "not " unless -e $flag_file; |
142 | print "ok ",$i++,"\n"; |
10ac9278 |
143 | # [perl #31924] |
144 | eval { $INC{'bleah.pm'} = 'bleah.pm' }; |
145 | print "# $@\nnot " if $@; |
146 | print "ok ",$i++,"\n"; |
147 | print "not " unless $INC{'bleah.pm'} eq 'bleah.pm'; |
4d8b06f1 |
148 | print "ok ",$i++,"\n"; |
149 | |
f46d017c |
150 | # successful require |
151 | do_require "1"; |
152 | print "# $@\nnot " if $@; |
153 | print "ok ",$i++,"\n"; |
10ac9278 |
154 | print "not " unless $INC{'bleah.pm'} eq 'bleah.pm'; |
155 | print "ok ",$i++,"\n"; |
f46d017c |
156 | |
faa7e5bb |
157 | # do FILE shouldn't see any outside lexicals |
158 | my $x = "ok $i\n"; |
159 | write_file("bleah.do", <<EOT); |
160 | \$x = "not ok $i\\n"; |
161 | EOT |
162 | do "bleah.do"; |
163 | dofile(); |
164 | sub dofile { do "bleah.do"; }; |
165 | print $x; |
faa7e5bb |
166 | |
a89be09a |
167 | # Test that scalar context is forced for require |
168 | |
169 | write_file('bleah.pm', <<'**BLEAH**' |
170 | print "not " if !defined wantarray || wantarray ne ''; |
0c58d367 |
171 | print "ok $i - require() context\n"; |
a89be09a |
172 | 1; |
173 | **BLEAH** |
174 | ); |
175 | delete $INC{"bleah.pm"}; ++$::i; |
176 | $foo = eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
177 | @foo = eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
178 | eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
0c58d367 |
179 | eval q{$_=$_+2;require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
a89be09a |
180 | $foo = eval {require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
181 | @foo = eval {require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
182 | eval {require bleah}; |
183 | |
8a220075 |
184 | # UTF-encoded things - skipped on EBCDIC machines and on UTF-8 input |
d2f5bb60 |
185 | |
8a220075 |
186 | if ($Is_EBCDIC || $Is_UTF8) { exit; } |
d2f5bb60 |
187 | |
b250498f |
188 | my $utf8 = chr(0xFEFF); |
dea0fc0b |
189 | |
190 | $i++; do_require(qq(${utf8}print "ok $i\n"; 1;\n)); |
191 | |
192 | sub bytes_to_utf16 { |
193 | my $utf16 = pack("$_[0]*", unpack("C*", $_[1])); |
7d59b7e4 |
194 | return @_ == 3 && $_[2] ? pack("$_[0]", 0xFEFF) . $utf16 : $utf16; |
dea0fc0b |
195 | } |
196 | |
197 | $i++; do_require(bytes_to_utf16('n', qq(print "ok $i\\n"; 1;\n), 1)); # BE |
198 | $i++; do_require(bytes_to_utf16('v', qq(print "ok $i\\n"; 1;\n), 1)); # LE |
b250498f |
199 | |
4d8b06f1 |
200 | END { |
201 | 1 while unlink 'bleah.pm'; |
202 | 1 while unlink 'bleah.do'; |
203 | 1 while unlink 'bleah.flg'; |
204 | } |
4a9ae47a |
205 | |
206 | # ***interaction with pod (don't put any thing after here)*** |
207 | |
208 | =pod |