t/comp/use.t

   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 v100.105.0 required--this is only version 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 required--this is only version 35.36/);
 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 v100.105.0 required--this is only version 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 required--this is only version 35.36/);
 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 v100.105.0 required--this is only version 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 required--this is only version v35.36/);
 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                 if ($parts[-$index - 1] < 0) {
 199                     # perl's version number ends with '.0'
 200                     $parts[-$index - 1] = 0;
 201                     $parts[-$index - 2] -= 2;
 202                 }
 203             } else {
 204                 # Jiggle one of the parts up
 205                 ++$parts[$index - 1];
 206             }
 207         }
 208         my $v_version = sprintf "v%d.%d.%d", @parts;
 209         my $version;
 210         if ($v) {
 211             $version = $v_version;
 212         } else {
 213             $version = $parts[0] + $parts[1] / 1000 + $parts[2] / 1000000;
 214         }
 215
 216         eval "use $version";
 217         if ($index > 0) {
 218             # The future
 219             like ($@,
 220                   qr/Perl $v_version required--this is only \Q$^V\E, stopped/,
 221                   "use $version");
 222         } else {
 223             # The present or past
 224             is ($@, '', "use $version");
 225         }
 226
 227         eval "no $version";
 228         if ($index <= 0) {
 229             # The present or past
 230             like ($@,
 231                   qr/Perls since $v_version too modern--this is \Q$^V\E, stopped/,
 232                   "no $version");
 233         } else {
 234             # future
 235             is ($@, '', "no $version");
 236         }
 237     }
 238 }
 239