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