1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 $INC{"feature.pm"} = 1; # so we don't attempt to load feature.pm 7} 8 9print "1..63\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 } else { 26 die "Unexpected type '$type'$name"; 27 } 28 if ($result) { 29 if ($name) { 30 print "ok $test - $name\n"; 31 } else { 32 print "ok $test\n"; 33 } 34 } else { 35 if ($name) { 36 print "not ok $test - $name\n"; 37 } else { 38 print "not ok $test\n"; 39 } 40 my @caller = caller(2); 41 print "# Failed test at $caller[1] line $caller[2]\n"; 42 print "# Got '$got'\n"; 43 if ($type eq 'is') { 44 print "# Expected '$expected'\n"; 45 } elsif ($type eq 'isnt') { 46 print "# Expected not '$expected'\n"; 47 } elsif ($type eq 'like') { 48 print "# Expected $expected\n"; 49 } 50 } 51 $test = $test + 1; 52 $result; 53} 54 55sub like ($$;$) { 56 _ok ('like', @_); 57} 58sub is ($$;$) { 59 _ok ('is', @_); 60} 61sub isnt ($$;$) { 62 _ok ('isnt', @_); 63} 64 65eval "use 5.000"; # implicit semicolon 66is ($@, ''); 67 68eval "use 5.000;"; 69is ($@, ''); 70 71eval "use 6.000;"; 72like ($@, qr/Perl v6\.0\.0 required--this is only \Q$^V\E, stopped/); 73 74eval "no 6.000;"; 75is ($@, ''); 76 77eval "no 5.000;"; 78like ($@, qr/Perls since v5\.0\.0 too modern--this is \Q$^V\E, stopped/); 79 80eval "use 5.6;"; 81like ($@, qr/Perl v5\.600\.0 required \(did you mean v5\.6\.0\?\)--this is only \Q$^V\E, stopped/); 82 83eval "use 5.8;"; 84like ($@, qr/Perl v5\.800\.0 required \(did you mean v5\.8\.0\?\)--this is only \Q$^V\E, stopped/); 85 86eval "use 5.9;"; 87like ($@, qr/Perl v5\.900\.0 required \(did you mean v5\.9\.0\?\)--this is only \Q$^V\E, stopped/); 88 89eval "use 5.10;"; 90like ($@, qr/Perl v5\.100\.0 required \(did you mean v5\.10\.0\?\)--this is only \Q$^V\E, stopped/); 91 92eval sprintf "use %.6f;", $]; 93is ($@, ''); 94 95 96eval sprintf "use %.6f;", $] - 0.000001; 97is ($@, ''); 98 99eval sprintf("use %.6f;", $] + 1); 100like ($@, qr/Perl v6.\d+.\d+ required--this is only \Q$^V\E, stopped/); 101 102eval sprintf "use %.6f;", $] + 0.00001; 103like ($@, qr/Perl v5.\d+.\d+ required--this is only \Q$^V\E, stopped/); 104 105{ use lib } # check that subparse saves pending tokens 106 107local $lib::VERSION = 1.0; 108 109eval "use lib 0.9"; 110is ($@, ''); 111 112eval "use lib 1.0"; 113is ($@, ''); 114 115eval "use lib 1.01"; 116isnt ($@, ''); 117 118 119eval "use lib 0.9 qw(fred)"; 120is ($@, ''); 121 122if ($^O eq 'MacOS') { 123 is($INC[0], ":fred:"); 124} else { 125 is($INC[0], "fred"); 126} 127 128eval "use lib 1.0 qw(joe)"; 129is ($@, ''); 130 131 132if ($^O eq 'MacOS') { 133 is($INC[0], ":joe:"); 134} else { 135 is($INC[0], "joe"); 136} 137 138 139eval "use lib 1.01 qw(freda)"; 140isnt($@, ''); 141 142if ($^O eq 'MacOS') { 143 isnt($INC[0], ":freda:"); 144} else { 145 isnt($INC[0], "freda"); 146} 147 148{ 149 local $lib::VERSION = 35.36; 150 eval "use lib v33.55"; 151 is ($@, ''); 152 153 eval "use lib v100.105"; 154 like ($@, qr/lib version v100.105.0 required--this is only version v35\.360\.0/); 155 156 eval "use lib 33.55"; 157 is ($@, ''); 158 159 eval "use lib 100.105"; 160 like ($@, qr/lib version 100.105 required--this is only version 35.36/); 161 162 local $lib::VERSION = '35.36'; 163 eval "use lib v33.55"; 164 like ($@, ''); 165 166 eval "use lib v100.105"; 167 like ($@, qr/lib version v100.105.0 required--this is only version v35\.360\.0/); 168 169 eval "use lib 33.55"; 170 is ($@, ''); 171 172 eval "use lib 100.105"; 173 like ($@, qr/lib version 100.105 required--this is only version 35.36/); 174 175 local $lib::VERSION = v35.36; 176 eval "use lib v33.55"; 177 is ($@, ''); 178 179 eval "use lib v100.105"; 180 like ($@, qr/lib version v100.105.0 required--this is only version v35\.36\.0/); 181 182 eval "use lib 33.55"; 183 is ($@, ''); 184 185 eval "use lib 100.105"; 186 like ($@, qr/lib version 100.105 required--this is only version v35.36/); 187} 188 189 190{ 191 # Regression test for patch 14937: 192 # Check that a .pm file with no package or VERSION doesn't core. 193 open F, ">xxx$$.pm" or die "Cannot open xxx$$.pm: $!\n"; 194 print F "1;\n"; 195 close F; 196 eval "use lib '.'; use xxx$$ 3;"; 197 like ($@, qr/^xxx$$ defines neither package nor VERSION--version check failed at/); 198 unlink "xxx$$.pm"; 199} 200 201my @ver = split /\./, sprintf "%vd", $^V; 202 203foreach my $index (-3..+3) { 204 foreach my $v (0, 1) { 205 my @parts = @ver; 206 if ($index) { 207 if ($index < 0) { 208 # Jiggle one of the parts down 209 --$parts[-$index - 1]; 210 if ($parts[-$index - 1] < 0) { 211 # perl's version number ends with '.0' 212 $parts[-$index - 1] = 0; 213 $parts[-$index - 2] -= 2; 214 } 215 } else { 216 # Jiggle one of the parts up 217 ++$parts[$index - 1]; 218 } 219 } 220 my $v_version = sprintf "v%d.%d.%d", @parts; 221 my $version; 222 if ($v) { 223 $version = $v_version; 224 } else { 225 $version = $parts[0] + $parts[1] / 1000 + $parts[2] / 1000000; 226 } 227 228 eval "use $version"; 229 if ($index > 0) { 230 # The future 231 like ($@, 232 qr/Perl $v_version required--this is only \Q$^V\E, stopped/, 233 "use $version"); 234 } else { 235 # The present or past 236 is ($@, '', "use $version"); 237 } 238 239 eval "no $version"; 240 if ($index <= 0) { 241 # The present or past 242 like ($@, 243 qr/Perls since $v_version too modern--this is \Q$^V\E, stopped/, 244 "no $version"); 245 } else { 246 # future 247 is ($@, '', "no $version"); 248 } 249 } 250} 251 252