| 1 | #!./perl |
| 2 | |
| 3 | BEGIN { |
| 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 | |
| 9 | print "1..59\n"; |
| 10 | |
| 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 | |
| 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 | |
| 55 | sub like ($$;$) { |
| 56 | _ok ('like', @_); |
| 57 | } |
| 58 | sub is ($$;$) { |
| 59 | _ok ('is', @_); |
| 60 | } |
| 61 | sub isnt ($$;$) { |
| 62 | _ok ('isnt', @_); |
| 63 | } |
| 64 | |
| 65 | eval "use 5.000"; # implicit semicolon |
| 66 | is ($@, ''); |
| 67 | |
| 68 | eval "use 5.000;"; |
| 69 | is ($@, ''); |
| 70 | |
| 71 | eval "use 6.000;"; |
| 72 | like ($@, qr/Perl v6\.0\.0 required--this is only \Q$^V\E, stopped/); |
| 73 | |
| 74 | eval "no 6.000;"; |
| 75 | is ($@, ''); |
| 76 | |
| 77 | eval "no 5.000;"; |
| 78 | like ($@, qr/Perls since v5\.0\.0 too modern--this is \Q$^V\E, stopped/); |
| 79 | |
| 80 | eval sprintf "use %.6f;", $]; |
| 81 | is ($@, ''); |
| 82 | |
| 83 | |
| 84 | eval sprintf "use %.6f;", $] - 0.000001; |
| 85 | is ($@, ''); |
| 86 | |
| 87 | eval sprintf("use %.6f;", $] + 1); |
| 88 | like ($@, qr/Perl v6.\d+.\d+ required--this is only \Q$^V\E, stopped/); |
| 89 | |
| 90 | eval sprintf "use %.6f;", $] + 0.00001; |
| 91 | like ($@, qr/Perl v5.\d+.\d+ required--this is only \Q$^V\E, stopped/); |
| 92 | |
| 93 | { use lib } # check that subparse saves pending tokens |
| 94 | |
| 95 | local $lib::VERSION = 1.0; |
| 96 | |
| 97 | eval "use lib 0.9"; |
| 98 | is ($@, ''); |
| 99 | |
| 100 | eval "use lib 1.0"; |
| 101 | is ($@, ''); |
| 102 | |
| 103 | eval "use lib 1.01"; |
| 104 | isnt ($@, ''); |
| 105 | |
| 106 | |
| 107 | eval "use lib 0.9 qw(fred)"; |
| 108 | is ($@, ''); |
| 109 | |
| 110 | if ($^O eq 'MacOS') { |
| 111 | is($INC[0], ":fred:"); |
| 112 | } else { |
| 113 | is($INC[0], "fred"); |
| 114 | } |
| 115 | |
| 116 | eval "use lib 1.0 qw(joe)"; |
| 117 | is ($@, ''); |
| 118 | |
| 119 | |
| 120 | if ($^O eq 'MacOS') { |
| 121 | is($INC[0], ":joe:"); |
| 122 | } else { |
| 123 | is($INC[0], "joe"); |
| 124 | } |
| 125 | |
| 126 | |
| 127 | eval "use lib 1.01 qw(freda)"; |
| 128 | isnt($@, ''); |
| 129 | |
| 130 | if ($^O eq 'MacOS') { |
| 131 | isnt($INC[0], ":freda:"); |
| 132 | } else { |
| 133 | isnt($INC[0], "freda"); |
| 134 | } |
| 135 | |
| 136 | { |
| 137 | local $lib::VERSION = 35.36; |
| 138 | eval "use lib v33.55"; |
| 139 | is ($@, ''); |
| 140 | |
| 141 | eval "use lib v100.105"; |
| 142 | like ($@, qr/lib version 100.105 \(v100\.105\.0\) required--this is only version 35.360 \(v35\.360\.0\)/); |
| 143 | |
| 144 | eval "use lib 33.55"; |
| 145 | is ($@, ''); |
| 146 | |
| 147 | eval "use lib 100.105"; |
| 148 | like ($@, qr/lib version 100.105 \(v100\.105\.0\) required--this is only version 35.360 \(v35\.360\.0\)/); |
| 149 | |
| 150 | local $lib::VERSION = '35.36'; |
| 151 | eval "use lib v33.55"; |
| 152 | like ($@, ''); |
| 153 | |
| 154 | eval "use lib v100.105"; |
| 155 | like ($@, qr/lib version 100.105 \(v100\.105\.0\) required--this is only version 35.360 \(v35\.360\.0\)/); |
| 156 | |
| 157 | eval "use lib 33.55"; |
| 158 | is ($@, ''); |
| 159 | |
| 160 | eval "use lib 100.105"; |
| 161 | like ($@, qr/lib version 100.105 \(v100\.105\.0\) required--this is only version 35.360 \(v35\.360\.0\)/); |
| 162 | |
| 163 | local $lib::VERSION = v35.36; |
| 164 | eval "use lib v33.55"; |
| 165 | is ($@, ''); |
| 166 | |
| 167 | eval "use lib v100.105"; |
| 168 | like ($@, qr/lib version 100.105 \(v100\.105\.0\) required--this is only version 35.036000 \(v35\.36\.0\)/); |
| 169 | |
| 170 | eval "use lib 33.55"; |
| 171 | is ($@, ''); |
| 172 | |
| 173 | eval "use lib 100.105"; |
| 174 | like ($@, qr/lib version 100.105 \(v100\.105\.0\) required--this is only version 35.036000 \(v35\.36\.0\)/); |
| 175 | } |
| 176 | |
| 177 | |
| 178 | { |
| 179 | # Regression test for patch 14937: |
| 180 | # Check that a .pm file with no package or VERSION doesn't core. |
| 181 | open F, ">xxx.pm" or die "Cannot open xxx.pm: $!\n"; |
| 182 | print F "1;\n"; |
| 183 | close F; |
| 184 | eval "use lib '.'; use xxx 3;"; |
| 185 | like ($@, qr/^xxx defines neither package nor VERSION--version check failed at/); |
| 186 | unlink 'xxx.pm'; |
| 187 | } |
| 188 | |
| 189 | my @ver = split /\./, sprintf "%vd", $^V; |
| 190 | |
| 191 | foreach my $index (-3..+3) { |
| 192 | foreach my $v (0, 1) { |
| 193 | my @parts = @ver; |
| 194 | if ($index) { |
| 195 | if ($index < 0) { |
| 196 | # Jiggle one of the parts down |
| 197 | --$parts[-$index - 1]; |
| 198 | } else { |
| 199 | # Jiggle one of the parts up |
| 200 | ++$parts[$index - 1]; |
| 201 | } |
| 202 | } |
| 203 | my $v_version = sprintf "v%d.%d.%d", @parts; |
| 204 | my $version; |
| 205 | if ($v) { |
| 206 | $version = $v_version; |
| 207 | } else { |
| 208 | $version = $parts[0] + $parts[1] / 1000 + $parts[2] / 1000000; |
| 209 | } |
| 210 | |
| 211 | eval "use $version"; |
| 212 | if ($index > 0) { |
| 213 | # The future |
| 214 | like ($@, |
| 215 | qr/Perl $v_version required--this is only \Q$^V\E, stopped/, |
| 216 | "use $version"); |
| 217 | } else { |
| 218 | # The present or past |
| 219 | is ($@, '', "use $version"); |
| 220 | } |
| 221 | |
| 222 | eval "no $version"; |
| 223 | if ($index <= 0) { |
| 224 | # The present or past |
| 225 | like ($@, |
| 226 | qr/Perls since $v_version too modern--this is \Q$^V\E, stopped/, |
| 227 | "no $version"); |
| 228 | } else { |
| 229 | # future |
| 230 | is ($@, '', "no $version"); |
| 231 | } |
| 232 | } |
| 233 | } |
| 234 | |