Commit | Line | Data |
---|---|---|
8ebc5c01 | 1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
dd90d555 | 5 | @INC = ('../lib', 'lib'); |
2246ee03 | 6 | $INC{"feature.pm"} = 1; # so we don't attempt to load feature.pm |
8ebc5c01 | 7 | } |
8 | ||
7e294c40 | 9 | print "1..83\n"; |
8ebc5c01 | 10 | |
6a4a49dd NC |
11 | # Can't require test.pl, as we're testing the use/require mechanism here. |
12 | ||
13 | my $test = 1; | |
14 | ||
15 | sub _ok { | |
16 | my ($type, $got, $expected, $name) = @_; | |
17 | ||
6a4a49dd NC |
18 | my $result; |
19 | if ($type eq 'is') { | |
20 | $result = $got eq $expected; | |
21 | } elsif ($type eq 'isnt') { | |
22 | $result = $got ne $expected; | |
23 | } elsif ($type eq 'like') { | |
24 | $result = $got =~ $expected; | |
7e294c40 FC |
25 | } elsif ($type eq 'ok') { |
26 | $result = not not $got; | |
6a4a49dd NC |
27 | } else { |
28 | die "Unexpected type '$type'$name"; | |
29 | } | |
30 | if ($result) { | |
3cacfbb9 NC |
31 | if ($name) { |
32 | print "ok $test - $name\n"; | |
33 | } else { | |
34 | print "ok $test\n"; | |
35 | } | |
6a4a49dd | 36 | } else { |
3cacfbb9 NC |
37 | if ($name) { |
38 | print "not ok $test - $name\n"; | |
39 | } else { | |
40 | print "not ok $test\n"; | |
41 | } | |
dd90d555 | 42 | my @caller = caller(1); |
3cacfbb9 | 43 | print "# Failed test at $caller[1] line $caller[2]\n"; |
6a4a49dd NC |
44 | print "# Got '$got'\n"; |
45 | if ($type eq 'is') { | |
46 | print "# Expected '$expected'\n"; | |
47 | } elsif ($type eq 'isnt') { | |
48 | print "# Expected not '$expected'\n"; | |
49 | } elsif ($type eq 'like') { | |
50 | print "# Expected $expected\n"; | |
7e294c40 FC |
51 | } elsif ($type eq 'ok') { |
52 | print "# Expected a true value\n"; | |
6a4a49dd NC |
53 | } |
54 | } | |
55 | $test = $test + 1; | |
56 | $result; | |
9f3d182e | 57 | } |
8ebc5c01 | 58 | |
6a4a49dd NC |
59 | sub like ($$;$) { |
60 | _ok ('like', @_); | |
61 | } | |
62 | sub is ($$;$) { | |
63 | _ok ('is', @_); | |
64 | } | |
65 | sub isnt ($$;$) { | |
66 | _ok ('isnt', @_); | |
8ebc5c01 | 67 | } |
7e294c40 FC |
68 | sub ok($;$) { |
69 | _ok ('ok', shift, undef, @_); | |
70 | } | |
6a4a49dd | 71 | |
17c59fdf VP |
72 | eval "use 5"; # implicit semicolon |
73 | is ($@, ''); | |
74 | ||
75 | eval "use 5;"; | |
76 | is ($@, ''); | |
77 | ||
78 | eval "{use 5}"; # [perl #70884] | |
79 | is ($@, ''); | |
80 | ||
81 | eval "{use 5 }"; # [perl #70884] | |
82 | is ($@, ''); | |
83 | ||
f2a3bb21 NC |
84 | # new style version numbers |
85 | ||
86 | eval q{ use v5.5.630; }; | |
87 | is ($@, ''); | |
88 | ||
89 | eval q{ use 10.0.2; }; | |
90 | like ($@, qr/^Perl v10\.0\.2 required/); | |
91 | ||
6a4a49dd NC |
92 | eval "use 5.000"; # implicit semicolon |
93 | is ($@, ''); | |
94 | ||
95 | eval "use 5.000;"; | |
96 | is ($@, ''); | |
8ebc5c01 | 97 | |
468aa647 | 98 | eval "use 6.000;"; |
6a4a49dd | 99 | like ($@, qr/Perl v6\.0\.0 required--this is only \Q$^V\E, stopped/); |
468aa647 RGS |
100 | |
101 | eval "no 6.000;"; | |
6a4a49dd | 102 | is ($@, ''); |
468aa647 RGS |
103 | |
104 | eval "no 5.000;"; | |
6a4a49dd | 105 | like ($@, qr/Perls since v5\.0\.0 too modern--this is \Q$^V\E, stopped/); |
468aa647 | 106 | |
d1029faa JP |
107 | eval "use 5.6;"; |
108 | like ($@, qr/Perl v5\.600\.0 required \(did you mean v5\.6\.0\?\)--this is only \Q$^V\E, stopped/); | |
109 | ||
110 | eval "use 5.8;"; | |
111 | like ($@, qr/Perl v5\.800\.0 required \(did you mean v5\.8\.0\?\)--this is only \Q$^V\E, stopped/); | |
112 | ||
113 | eval "use 5.9;"; | |
114 | like ($@, qr/Perl v5\.900\.0 required \(did you mean v5\.9\.0\?\)--this is only \Q$^V\E, stopped/); | |
115 | ||
116 | eval "use 5.10;"; | |
117 | like ($@, qr/Perl v5\.100\.0 required \(did you mean v5\.10\.0\?\)--this is only \Q$^V\E, stopped/); | |
118 | ||
53eb19dd S |
119 | eval "use 5.11;"; |
120 | like ($@, qr/Perl v5\.110\.0 required \(did you mean v5\.11\.0\?\)--this is only \Q$^V\E, stopped/); | |
121 | ||
6d2c9499 | 122 | eval sprintf "use %.6f;", $]; |
6a4a49dd | 123 | is ($@, ''); |
8ebc5c01 | 124 | |
125 | ||
6d2c9499 | 126 | eval sprintf "use %.6f;", $] - 0.000001; |
6a4a49dd | 127 | is ($@, ''); |
8ebc5c01 | 128 | |
6d2c9499 | 129 | eval sprintf("use %.6f;", $] + 1); |
6a4a49dd | 130 | like ($@, qr/Perl v6.\d+.\d+ required--this is only \Q$^V\E, stopped/); |
8ebc5c01 | 131 | |
6d2c9499 | 132 | eval sprintf "use %.6f;", $] + 0.00001; |
6a4a49dd | 133 | like ($@, qr/Perl v5.\d+.\d+ required--this is only \Q$^V\E, stopped/); |
8ebc5c01 | 134 | |
53eb19dd S |
135 | # check that "use 5.11.0" (and higher) loads strictures |
136 | eval 'use 5.11.0; ${"foo"} = "bar";'; | |
137 | like ($@, qr/Can't use string \("foo"\) as a SCALAR ref while "strict refs" in use/); | |
5cc917d6 RGS |
138 | # but that they can be disabled |
139 | eval 'use 5.11.0; no strict "refs"; ${"foo"} = "bar";'; | |
140 | is ($@, ""); | |
141 | # and they are properly scoped | |
142 | eval '{use 5.11.0;} ${"foo"} = "bar";'; | |
143 | is ($@, ""); | |
b50b2058 FC |
144 | eval 'no strict; use 5.012; ${"foo"} = "bar"'; |
145 | is $@, "", 'explicit "no strict" overrides later ver decl'; | |
146 | eval 'use strict; use 5.01; ${"foo"} = "bar"'; | |
147 | like $@, qr/^Can't use string/, | |
148 | 'explicit use strict overrides later use 5.01'; | |
149 | eval 'use strict "subs"; use 5.012; ${"foo"} = "bar"'; | |
150 | like $@, qr/^Can't use string/, | |
151 | 'explicit use strict "subs" does not stop ver decl from enabling refs'; | |
152 | eval 'use 5.012; use 5.01; ${"foo"} = "bar"'; | |
153 | is $@, "", 'use 5.01 overrides implicit strict from prev ver decl'; | |
7e294c40 FC |
154 | eval 'no strict "subs"; use 5.012; ${"foo"} = "bar"'; |
155 | ok $@, 'no strict subs allows ver decl to enable refs'; | |
156 | eval 'no strict "subs"; use 5.012; $nonexistent_pack_var'; | |
157 | ok $@, 'no strict subs allows ver decl to enable vars'; | |
158 | eval 'no strict "refs"; use 5.012; fancy_bareword'; | |
159 | ok $@, 'no strict refs allows ver decl to enable subs'; | |
160 | eval 'no strict "refs"; use 5.012; $nonexistent_pack_var'; | |
161 | ok $@, 'no strict refs allows ver decl to enable subs'; | |
162 | eval 'no strict "vars"; use 5.012; ${"foo"} = "bar"'; | |
163 | ok $@, 'no strict vars allows ver decl to enable refs'; | |
164 | eval 'no strict "vars"; use 5.012; ursine_word'; | |
165 | ok $@, 'no strict vars allows ver decl to enable subs'; | |
b50b2058 | 166 | |
53eb19dd | 167 | |
dd90d555 | 168 | { use test_use } # check that subparse saves pending tokens |
8ebc5c01 | 169 | |
dd90d555 | 170 | local $test_use::VERSION = 1.0; |
8ebc5c01 | 171 | |
dd90d555 | 172 | eval "use test_use 0.9"; |
6a4a49dd | 173 | is ($@, ''); |
8ebc5c01 | 174 | |
dd90d555 | 175 | eval "use test_use 1.0"; |
6a4a49dd | 176 | is ($@, ''); |
8ebc5c01 | 177 | |
dd90d555 | 178 | eval "use test_use 1.01"; |
6a4a49dd | 179 | isnt ($@, ''); |
8ebc5c01 | 180 | |
dd90d555 | 181 | eval "use test_use 0.9 qw(fred)"; |
6a4a49dd | 182 | is ($@, ''); |
8ebc5c01 | 183 | |
dd90d555 | 184 | is("@test_use::got", "fred"); |
8ebc5c01 | 185 | |
dd90d555 | 186 | eval "use test_use 1.0 qw(joe)"; |
6a4a49dd NC |
187 | is ($@, ''); |
188 | ||
dd90d555 | 189 | is("@test_use::got", "joe"); |
8ebc5c01 | 190 | |
dd90d555 | 191 | eval "use test_use 1.01 qw(freda)"; |
6a4a49dd | 192 | isnt($@, ''); |
8ebc5c01 | 193 | |
dd90d555 | 194 | is("@test_use::got", "joe"); |
1571675a GS |
195 | |
196 | { | |
dd90d555 NC |
197 | local $test_use::VERSION = 35.36; |
198 | eval "use test_use v33.55"; | |
6a4a49dd | 199 | is ($@, ''); |
1571675a | 200 | |
dd90d555 NC |
201 | eval "use test_use v100.105"; |
202 | like ($@, qr/test_use version v100.105.0 required--this is only version v35\.360\.0/); | |
1571675a | 203 | |
dd90d555 | 204 | eval "use test_use 33.55"; |
6a4a49dd | 205 | is ($@, ''); |
1571675a | 206 | |
dd90d555 NC |
207 | eval "use test_use 100.105"; |
208 | like ($@, qr/test_use version 100.105 required--this is only version 35.36/); | |
1571675a | 209 | |
dd90d555 NC |
210 | local $test_use::VERSION = '35.36'; |
211 | eval "use test_use v33.55"; | |
6a4a49dd | 212 | like ($@, ''); |
1571675a | 213 | |
dd90d555 NC |
214 | eval "use test_use v100.105"; |
215 | like ($@, qr/test_use version v100.105.0 required--this is only version v35\.360\.0/); | |
1571675a | 216 | |
dd90d555 | 217 | eval "use test_use 33.55"; |
6a4a49dd | 218 | is ($@, ''); |
1571675a | 219 | |
dd90d555 NC |
220 | eval "use test_use 100.105"; |
221 | like ($@, qr/test_use version 100.105 required--this is only version 35.36/); | |
1571675a | 222 | |
dd90d555 NC |
223 | local $test_use::VERSION = v35.36; |
224 | eval "use test_use v33.55"; | |
6a4a49dd | 225 | is ($@, ''); |
1571675a | 226 | |
dd90d555 NC |
227 | eval "use test_use v100.105"; |
228 | like ($@, qr/test_use version v100.105.0 required--this is only version v35\.36\.0/); | |
1571675a | 229 | |
dd90d555 | 230 | eval "use test_use 33.55"; |
6a4a49dd | 231 | is ($@, ''); |
1571675a | 232 | |
dd90d555 NC |
233 | eval "use test_use 100.105"; |
234 | like ($@, qr/test_use version 100.105 required--this is only version v35.36/); | |
1571675a | 235 | } |
8312d5ee PM |
236 | |
237 | ||
238 | { | |
239 | # Regression test for patch 14937: | |
240 | # Check that a .pm file with no package or VERSION doesn't core. | |
b1739762 NC |
241 | # (git commit 2658f4d9934aba5f8b23afcc078dc12b3a40223) |
242 | eval "use test_use_14937 3"; | |
243 | like ($@, qr/^test_use_14937 defines neither package nor VERSION--version check failed at/); | |
8312d5ee | 244 | } |
3cacfbb9 NC |
245 | |
246 | my @ver = split /\./, sprintf "%vd", $^V; | |
247 | ||
248 | foreach my $index (-3..+3) { | |
249 | foreach my $v (0, 1) { | |
250 | my @parts = @ver; | |
251 | if ($index) { | |
252 | if ($index < 0) { | |
253 | # Jiggle one of the parts down | |
254 | --$parts[-$index - 1]; | |
8c5f6936 RGS |
255 | if ($parts[-$index - 1] < 0) { |
256 | # perl's version number ends with '.0' | |
257 | $parts[-$index - 1] = 0; | |
258 | $parts[-$index - 2] -= 2; | |
259 | } | |
3cacfbb9 NC |
260 | } else { |
261 | # Jiggle one of the parts up | |
262 | ++$parts[$index - 1]; | |
263 | } | |
264 | } | |
265 | my $v_version = sprintf "v%d.%d.%d", @parts; | |
266 | my $version; | |
267 | if ($v) { | |
268 | $version = $v_version; | |
269 | } else { | |
270 | $version = $parts[0] + $parts[1] / 1000 + $parts[2] / 1000000; | |
271 | } | |
272 | ||
273 | eval "use $version"; | |
274 | if ($index > 0) { | |
275 | # The future | |
276 | like ($@, | |
277 | qr/Perl $v_version required--this is only \Q$^V\E, stopped/, | |
278 | "use $version"); | |
279 | } else { | |
280 | # The present or past | |
281 | is ($@, '', "use $version"); | |
282 | } | |
283 | ||
284 | eval "no $version"; | |
285 | if ($index <= 0) { | |
286 | # The present or past | |
287 | like ($@, | |
288 | qr/Perls since $v_version too modern--this is \Q$^V\E, stopped/, | |
289 | "no $version"); | |
290 | } else { | |
291 | # future | |
292 | is ($@, '', "no $version"); | |
293 | } | |
294 | } | |
295 | } | |
296 |