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..83\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 local $test_use::VERSION = 1.0;
 171
 172 eval "use test_use 0.9";
 173 is ($@, '');
 174
 175 eval "use test_use 1.0";
 176 is ($@, '');
 177
 178 eval "use test_use 1.01";
 179 isnt ($@, '');
 180
 181 eval "use test_use 0.9 qw(fred)";
 182 is ($@, '');
 183
 184 is("@test_use::got", "fred");
 185
 186 eval "use test_use 1.0 qw(joe)";
 187 is ($@, '');
 188
 189 is("@test_use::got", "joe");
 190
 191 eval "use test_use 1.01 qw(freda)";
 192 isnt($@, '');
 193
 194 is("@test_use::got", "joe");
 195
 196 {
 197     local $test_use::VERSION = 35.36;
 198     eval "use test_use v33.55";
 199     is ($@, '');
 200
 201     eval "use test_use v100.105";
 202     like ($@, qr/test_use version v100.105.0 required--this is only version v35\.360\.0/);
 203
 204     eval "use test_use 33.55";
 205     is ($@, '');
 206
 207     eval "use test_use 100.105";
 208     like ($@, qr/test_use version 100.105 required--this is only version 35.36/);
 209
 210     local $test_use::VERSION = '35.36';
 211     eval "use test_use v33.55";
 212     like ($@, '');
 213
 214     eval "use test_use v100.105";
 215     like ($@, qr/test_use version v100.105.0 required--this is only version v35\.360\.0/);
 216
 217     eval "use test_use 33.55";
 218     is ($@, '');
 219
 220     eval "use test_use 100.105";
 221     like ($@, qr/test_use version 100.105 required--this is only version 35.36/);
 222
 223     local $test_use::VERSION = v35.36;
 224     eval "use test_use v33.55";
 225     is ($@, '');
 226
 227     eval "use test_use v100.105";
 228     like ($@, qr/test_use version v100.105.0 required--this is only version v35\.36\.0/);
 229
 230     eval "use test_use 33.55";
 231     is ($@, '');
 232
 233     eval "use test_use 100.105";
 234     like ($@, qr/test_use version 100.105 required--this is only version v35.36/);
 235 }
 236
 237
 238 {
 239     # Regression test for patch 14937:
 240     #   Check that a .pm file with no package or VERSION doesn't core.
 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/);
 244 }
 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];
 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                 }
 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