t/comp/use.t

   1 #!./perl
   2
   3 BEGIN {
   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
   9 print "1..84\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     } 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
  59 sub like ($$;$) {
  60     _ok ('like', @_);
  61 }
  62 sub is ($$;$) {
  63     _ok ('is', @_);
  64 }
  65 sub isnt ($$;$) {
  66     _ok ('isnt', @_);
  67 }
  68 sub ok($;$) {
  69     _ok ('ok', shift, undef, @_);
  70 }
  71
  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
  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
  92 eval "use 5.000";       # implicit semicolon
  93 is ($@, '');
  94
  95 eval "use 5.000;";
  96 is ($@, '');
  97
  98 eval "use 6.000;";
  99 like ($@, qr/Perl v6\.0\.0 required--this is only \Q$^V\E, stopped/);
 100
 101 eval "no 6.000;";
 102 is ($@, '');
 103
 104 eval "no 5.000;";
 105 like ($@, qr/Perls since v5\.0\.0 too modern--this is \Q$^V\E, stopped/);
 106
 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
 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
 122 eval sprintf "use %.6f;", $];
 123 is ($@, '');
 124
 125
 126 eval sprintf "use %.6f;", $] - 0.000001;
 127 is ($@, '');
 128
 129 eval sprintf("use %.6f;", $] + 1);
 130 like ($@, qr/Perl v6.\d+.\d+ required--this is only \Q$^V\E, stopped/);
 131
 132 eval sprintf "use %.6f;", $] + 0.00001;
 133 like ($@, 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
 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/);
 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 ($@, "");
 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';
 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';
 166
 167
 168 { use test_use }        # check that subparse saves pending tokens
 169
 170 use test_use { () };
 171 is ref $test_use::got[0], 'HASH', 'use parses arguments in term lexing cx';
 172
 173 local $test_use::VERSION = 1.0;
 174
 175 eval "use test_use 0.9";
 176 is ($@, '');
 177
 178 eval "use test_use 1.0";
 179 is ($@, '');
 180
 181 eval "use test_use 1.01";
 182 isnt ($@, '');
 183
 184 eval "use test_use 0.9 qw(fred)";
 185 is ($@, '');
 186
 187 is("@test_use::got", "fred");
 188
 189 eval "use test_use 1.0 qw(joe)";
 190 is ($@, '');
 191
 192 is("@test_use::got", "joe");
 193
 194 eval "use test_use 1.01 qw(freda)";
 195 isnt($@, '');
 196
 197 is("@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
 249 my @ver = split /\./, sprintf "%vd", $^V;
 250
 251 foreach 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