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