t/comp/use.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 print "1..31\n";
   9
  10 # Can't require test.pl, as we're testing the use/require mechanism here.
  11
  12 my $test = 1;
  13
  14 sub _ok {
  15     my ($type, $got, $expected, $name) = @_;
  16
  17     my @caller = caller(2);
  18     if ($name) {
  19         $name = " $name";
  20     }
  21     $name .= " at $caller[1] line $caller[2]";
  22
  23     my $result;
  24     if ($type eq 'is') {
  25         $result = $got eq $expected;
  26     } elsif ($type eq 'isnt') {
  27         $result = $got ne $expected;
  28     } elsif ($type eq 'like') {
  29         $result = $got =~ $expected;
  30     } else {
  31         die "Unexpected type '$type'$name";
  32     }
  33     if ($result) {
  34         print "ok $test\n";
  35     } else {
  36         print "not ok $test\n";
  37         print "# Failed test $name\n";
  38         print "# Got      '$got'\n";
  39         if ($type eq 'is') {
  40             print "# Expected '$expected'\n";
  41         } elsif ($type eq 'isnt') {
  42             print "# Expected not '$expected'\n";
  43         } elsif ($type eq 'like') {
  44             print "# Expected $expected\n";
  45         }
  46     }
  47     $test = $test + 1;
  48     $result;
  49 }
  50
  51 sub like ($$;$) {
  52     _ok ('like', @_);
  53 }
  54 sub is ($$;$) {
  55     _ok ('is', @_);
  56 }
  57 sub isnt ($$;$) {
  58     _ok ('isnt', @_);
  59 }
  60
  61 eval "use 5.000";       # implicit semicolon
  62 is ($@, '');
  63
  64 eval "use 5.000;";
  65 is ($@, '');
  66
  67 eval "use 6.000;";
  68 like ($@, qr/Perl v6\.0\.0 required--this is only \Q$^V\E, stopped/);
  69
  70 eval "no 6.000;";
  71 is ($@, '');
  72
  73 eval "no 5.000;";
  74 like ($@, qr/Perls since v5\.0\.0 too modern--this is \Q$^V\E, stopped/);
  75
  76 eval sprintf "use %.6f;", $];
  77 is ($@, '');
  78
  79
  80 eval sprintf "use %.6f;", $] - 0.000001;
  81 is ($@, '');
  82
  83 eval sprintf("use %.6f;", $] + 1);
  84 like ($@, qr/Perl v6.\d+.\d+ required--this is only \Q$^V\E, stopped/);
  85
  86 eval sprintf "use %.6f;", $] + 0.00001;
  87 like ($@, qr/Perl v5.\d+.\d+ required--this is only \Q$^V\E, stopped/);
  88
  89 { use lib }     # check that subparse saves pending tokens
  90
  91 local $lib::VERSION = 1.0;
  92
  93 eval "use lib 0.9";
  94 is ($@, '');
  95
  96 eval "use lib 1.0";
  97 is ($@, '');
  98
  99 eval "use lib 1.01";
 100 isnt ($@, '');
 101
 102
 103 eval "use lib 0.9 qw(fred)";
 104 is ($@, '');
 105
 106 if ($^O eq 'MacOS') {
 107     is($INC[0], ":fred:");
 108 } else {
 109     is($INC[0], "fred");
 110 }
 111
 112 eval "use lib 1.0 qw(joe)";
 113 is ($@, '');
 114
 115
 116 if ($^O eq 'MacOS') {
 117     is($INC[0], ":joe:");
 118 } else {
 119     is($INC[0], "joe");
 120 }
 121
 122
 123 eval "use lib 1.01 qw(freda)";
 124 isnt($@, '');
 125
 126 if ($^O eq 'MacOS') {
 127     isnt($INC[0], ":freda:");
 128 } else {
 129     isnt($INC[0], "freda");
 130 }
 131
 132 {
 133     local $lib::VERSION = 35.36;
 134     eval "use lib v33.55";
 135     is ($@, '');
 136
 137     eval "use lib v100.105";
 138     like ($@, qr/lib version 100.105 \(v100\.105\.0\) required--this is only version 35.360 \(v35\.360\.0\)/);
 139
 140     eval "use lib 33.55";
 141     is ($@, '');
 142
 143     eval "use lib 100.105";
 144     like ($@, qr/lib version 100.105 \(v100\.105\.0\) required--this is only version 35.360 \(v35\.360\.0\)/);
 145
 146     local $lib::VERSION = '35.36';
 147     eval "use lib v33.55";
 148     like ($@, '');
 149
 150     eval "use lib v100.105";
 151     like ($@, qr/lib version 100.105 \(v100\.105\.0\) required--this is only version 35.360 \(v35\.360\.0\)/);
 152
 153     eval "use lib 33.55";
 154     is ($@, '');
 155
 156     eval "use lib 100.105";
 157     like ($@, qr/lib version 100.105 \(v100\.105\.0\) required--this is only version 35.360 \(v35\.360\.0\)/);
 158
 159     local $lib::VERSION = v35.36;
 160     eval "use lib v33.55";
 161     is ($@, '');
 162
 163     eval "use lib v100.105";
 164     like ($@, qr/lib version 100.105 \(v100\.105\.0\) required--this is only version 35.036000 \(v35\.36\.0\)/);
 165
 166     eval "use lib 33.55";
 167     is ($@, '');
 168
 169     eval "use lib 100.105";
 170     like ($@, qr/lib version 100.105 \(v100\.105\.0\) required--this is only version 35.036000 \(v35\.36\.0\)/);
 171 }
 172
 173
 174 {
 175     # Regression test for patch 14937:
 176     #   Check that a .pm file with no package or VERSION doesn't core.
 177     open F, ">xxx.pm" or die "Cannot open xxx.pm: $!\n";
 178     print F "1;\n";
 179     close F;
 180     eval "use lib '.'; use xxx 3;";
 181     like ($@, qr/^xxx defines neither package nor VERSION--version check failed at/);
 182     unlink 'xxx.pm';
 183 }