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 | ||
9 | # don't make this lexical | |
10 | $i = 1; | |
d2f5bb60 PP |
11 | |
12 | my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0; | |
8a220075 | 13 | my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/; |
f1913749 | 14 | my $total_tests = 46; |
76b0784a | 15 | if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= 3; } |
d2f5bb60 | 16 | print "1..$total_tests\n"; |
f46d017c GS |
17 | |
18 | sub do_require { | |
19 | %INC = (); | |
4a9ae47a | 20 | write_file('bleah.pm',@_); |
f46d017c GS |
21 | eval { require "bleah.pm" }; |
22 | my @a; # magic guard for scope violations (must be first lexical in file) | |
23 | } | |
24 | ||
4a9ae47a GS |
25 | sub write_file { |
26 | my $f = shift; | |
27 | open(REQ,">$f") or die "Can't write '$f': $!"; | |
9f82a649 | 28 | binmode REQ; |
7d59b7e4 | 29 | use bytes; |
4a9ae47a | 30 | print REQ @_; |
d1e4d418 | 31 | close REQ or die "Could not close $f: $!"; |
4a9ae47a GS |
32 | } |
33 | ||
9f3d182e GS |
34 | eval {require 5.005}; |
35 | print "# $@\nnot " if $@; | |
36 | print "ok ",$i++,"\n"; | |
37 | ||
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 { | |
47 | require 5.005 | |
48 | }; | |
49 | print "# $@\nnot " if $@; | |
50 | print "ok ",$i++,"\n"; | |
51 | ||
a7cb1f99 GS |
52 | # new style version numbers |
53 | ||
54 | eval { require v5.5.630; }; | |
55 | print "# $@\nnot " if $@; | |
56 | print "ok ",$i++,"\n"; | |
57 | ||
dd629d5b | 58 | eval { require 10.0.2; }; |
a7cb1f99 GS |
59 | print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; |
60 | print "ok ",$i++,"\n"; | |
61 | ||
62 | eval q{ use v5.5.630; }; | |
63 | print "# $@\nnot " if $@; | |
64 | print "ok ",$i++,"\n"; | |
65 | ||
dd629d5b | 66 | eval q{ use 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 | ||
4a9ae47a GS |
101 | # interaction with pod (see the eof) |
102 | write_file('bleah.pm', "print 'ok $i\n'; 1;\n"); | |
103 | require "bleah.pm"; | |
104 | $i++; | |
105 | ||
f46d017c GS |
106 | # run-time failure in require |
107 | do_require "0;\n"; | |
108 | print "# $@\nnot " unless $@ =~ /did not return a true/; | |
109 | print "ok ",$i++,"\n"; | |
110 | ||
4d8b06f1 RD |
111 | print "not " if exists $INC{'bleah.pm'}; |
112 | print "ok ",$i++,"\n"; | |
113 | ||
114 | my $flag_file = 'bleah.flg'; | |
115 | # run-time error in require | |
116 | for my $expected_compile (1,0) { | |
117 | write_file($flag_file, 1); | |
118 | print "not " unless -e $flag_file; | |
119 | print "ok ",$i++,"\n"; | |
120 | write_file('bleah.pm', "unlink '$flag_file' or die; \$a=0; \$b=1/\$a; 1;\n"); | |
121 | print "# $@\nnot " if eval { require 'bleah.pm' }; | |
122 | print "ok ",$i++,"\n"; | |
123 | print "not " unless -e $flag_file xor $expected_compile; | |
124 | print "ok ",$i++,"\n"; | |
27bcc0a7 RGS |
125 | print "not " unless exists $INC{'bleah.pm'}; |
126 | print "ok ",$i++,"\n"; | |
4d8b06f1 RD |
127 | } |
128 | ||
f46d017c GS |
129 | # compile-time failure in require |
130 | do_require "1)\n"; | |
f0ec1f9a | 131 | # bison says 'parse error' instead of 'syntax error', |
d91e2bdb | 132 | # various yaccs may or may not capitalize 'syntax'. |
f0ec1f9a | 133 | print "# $@\nnot " unless $@ =~ /(syntax|parse) error/mi; |
f46d017c GS |
134 | print "ok ",$i++,"\n"; |
135 | ||
27bcc0a7 RGS |
136 | # previous failure cached in %INC |
137 | print "not " unless exists $INC{'bleah.pm'}; | |
138 | print "ok ",$i++,"\n"; | |
4d8b06f1 RD |
139 | write_file($flag_file, 1); |
140 | write_file('bleah.pm', "unlink '$flag_file'; 1"); | |
141 | print "# $@\nnot " if eval { require 'bleah.pm' }; | |
142 | print "ok ",$i++,"\n"; | |
143 | print "# $@\nnot " unless $@ =~ /Compilation failed/i; | |
144 | print "ok ",$i++,"\n"; | |
145 | print "not " unless -e $flag_file; | |
146 | print "ok ",$i++,"\n"; | |
27bcc0a7 | 147 | print "not " unless exists $INC{'bleah.pm'}; |
4d8b06f1 RD |
148 | print "ok ",$i++,"\n"; |
149 | ||
f46d017c GS |
150 | # successful require |
151 | do_require "1"; | |
152 | print "# $@\nnot " if $@; | |
153 | print "ok ",$i++,"\n"; | |
154 | ||
faa7e5bb GS |
155 | # do FILE shouldn't see any outside lexicals |
156 | my $x = "ok $i\n"; | |
157 | write_file("bleah.do", <<EOT); | |
158 | \$x = "not ok $i\\n"; | |
159 | EOT | |
160 | do "bleah.do"; | |
161 | dofile(); | |
162 | sub dofile { do "bleah.do"; }; | |
163 | print $x; | |
faa7e5bb | 164 | |
a89be09a RGS |
165 | # Test that scalar context is forced for require |
166 | ||
167 | write_file('bleah.pm', <<'**BLEAH**' | |
168 | print "not " if !defined wantarray || wantarray ne ''; | |
0c58d367 | 169 | print "ok $i - require() context\n"; |
a89be09a RGS |
170 | 1; |
171 | **BLEAH** | |
172 | ); | |
173 | delete $INC{"bleah.pm"}; ++$::i; | |
174 | $foo = eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i; | |
175 | @foo = eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i; | |
176 | eval q{require bleah}; delete $INC{"bleah.pm"}; ++$::i; | |
0c58d367 | 177 | eval q{$_=$_+2;require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
a89be09a RGS |
178 | $foo = eval {require bleah}; delete $INC{"bleah.pm"}; ++$::i; |
179 | @foo = eval {require bleah}; delete $INC{"bleah.pm"}; ++$::i; | |
180 | eval {require bleah}; | |
181 | ||
2d6f15ea NC |
182 | # Test for fix of RT #24404 : "require $scalar" may load a directory |
183 | my $r = "threads"; | |
184 | eval { require $r }; | |
185 | $i++; | |
6b845e56 | 186 | if($@ =~ /Can't locate threads in \@INC/) { |
2d6f15ea NC |
187 | print "ok $i\n"; |
188 | } else { | |
189 | print "not ok $i\n"; | |
190 | } | |
191 | ||
57f3ff92 NC |
192 | |
193 | write_file('bleah.pm', qq(die "This is an expected error";\n)); | |
194 | delete $INC{"bleah.pm"}; ++$::i; | |
195 | eval { CORE::require bleah; }; | |
196 | if ($@ =~ /^This is an expected error/) { | |
197 | print "ok $i\n"; | |
198 | } else { | |
199 | print "not ok $i\n"; | |
200 | } | |
201 | ||
d20ea72b RGS |
202 | ########################################## |
203 | # What follows are UTF-8 specific tests. # | |
204 | # Add generic tests before this point. # | |
205 | ########################################## | |
2d6f15ea | 206 | |
8a220075 | 207 | # UTF-encoded things - skipped on EBCDIC machines and on UTF-8 input |
d2f5bb60 | 208 | |
8a220075 | 209 | if ($Is_EBCDIC || $Is_UTF8) { exit; } |
d2f5bb60 | 210 | |
b250498f | 211 | my $utf8 = chr(0xFEFF); |
dea0fc0b JH |
212 | |
213 | $i++; do_require(qq(${utf8}print "ok $i\n"; 1;\n)); | |
214 | ||
215 | sub bytes_to_utf16 { | |
216 | my $utf16 = pack("$_[0]*", unpack("C*", $_[1])); | |
7d59b7e4 | 217 | return @_ == 3 && $_[2] ? pack("$_[0]", 0xFEFF) . $utf16 : $utf16; |
dea0fc0b JH |
218 | } |
219 | ||
220 | $i++; do_require(bytes_to_utf16('n', qq(print "ok $i\\n"; 1;\n), 1)); # BE | |
221 | $i++; do_require(bytes_to_utf16('v', qq(print "ok $i\\n"; 1;\n), 1)); # LE | |
b250498f | 222 | |
4d8b06f1 RD |
223 | END { |
224 | 1 while unlink 'bleah.pm'; | |
225 | 1 while unlink 'bleah.do'; | |
226 | 1 while unlink 'bleah.flg'; | |
227 | } | |
4a9ae47a GS |
228 | |
229 | # ***interaction with pod (don't put any thing after here)*** | |
230 | ||
231 | =pod |