Commit | Line | Data |
---|---|---|
129318bd | 1 | #! /usr/local/perl -w |
543eec9e | 2 | package main; |
c8a14fb6 | 3 | require Test::Harness; |
543eec9e | 4 | use Data::Dumper; |
f941e658 JP |
5 | use File::Temp qw/tempfile/; |
6 | use File::Basename; | |
a7ad731c | 7 | |
543eec9e JP |
8 | if ($Test::More::VERSION < 0.48) { # Fix for RT#48268 |
9 | local $^W; | |
10 | *main::use_ok = sub ($;@) { | |
11 | my ($pkg, $req, @args) = @_; | |
12 | eval "use $pkg $req ".join(' ',@args); | |
13 | is ${"$pkg\::VERSION"}, $req, 'Had to manually use version'; | |
14 | # If we made it this far, we are ok. | |
15 | }; | |
9b463b21 | 16 | } |
e0218a61 | 17 | |
137d6fc0 JP |
18 | sub BaseTests { |
19 | ||
f941e658 | 20 | my ($CLASS, $method, $qv_declare) = @_; |
692a467c JP |
21 | my $warning; |
22 | local $SIG{__WARN__} = sub { $warning = $_[0] }; | |
543eec9e | 23 | |
317f7c8a RGS |
24 | # Insert your test code below, the Test module is use()ed here so read |
25 | # its man page ( perldoc Test ) for help writing this test script. | |
543eec9e | 26 | |
317f7c8a | 27 | # Test bare number processing |
f941e658 | 28 | $version = $CLASS->$method(5.005_03); |
8cb289bd | 29 | is ( "$version" , "5.00503" , '5.005_03 eq 5.00503' ); |
f941e658 | 30 | $version = $CLASS->$method(1.23); |
8cb289bd | 31 | is ( "$version" , "1.23" , '1.23 eq "1.23"' ); |
543eec9e | 32 | |
317f7c8a | 33 | # Test quoted number processing |
f941e658 | 34 | $version = $CLASS->$method("5.005_03"); |
8cb289bd | 35 | is ( "$version" , "5.005_03" , '"5.005_03" eq "5.005_03"' ); |
f941e658 | 36 | $version = $CLASS->$method("v1.23"); |
8cb289bd | 37 | is ( "$version" , "v1.23" , '"v1.23" eq "v1.23"' ); |
543eec9e | 38 | |
317f7c8a | 39 | # Test stringify operator |
f941e658 | 40 | $version = $CLASS->$method("5.005"); |
317f7c8a | 41 | is ( "$version" , "5.005" , '5.005 eq "5.005"' ); |
f941e658 | 42 | $version = $CLASS->$method("5.006.001"); |
8cb289bd | 43 | is ( "$version" , "5.006.001" , '5.006.001 eq v5.6.1' ); |
692a467c JP |
44 | unlike ($warning, qr/v-string without leading 'v' deprecated/, 'No leading v'); |
45 | $version = $CLASS->$method("v1.2.3_4"); | |
46 | is ( "$version" , "v1.2.3_4" , 'alpha version 1.2.3_4 eq v1.2.3_4' ); | |
543eec9e | 47 | |
317f7c8a | 48 | # test illegal formats |
d54f8cf7 | 49 | eval {my $version = $CLASS->$method("1.2_3_4")}; |
317f7c8a RGS |
50 | like($@, qr/multiple underscores/, |
51 | "Invalid version format (multiple underscores)"); | |
543eec9e | 52 | |
d54f8cf7 | 53 | eval {my $version = $CLASS->$method("1.2_3.4")}; |
317f7c8a RGS |
54 | like($@, qr/underscores before decimal/, |
55 | "Invalid version format (underscores before decimal)"); | |
543eec9e | 56 | |
d54f8cf7 | 57 | eval {my $version = $CLASS->$method("1_2")}; |
317f7c8a RGS |
58 | like($@, qr/alpha without decimal/, |
59 | "Invalid version format (alpha without decimal)"); | |
543eec9e | 60 | |
91152fc1 DG |
61 | eval { $version = $CLASS->$method("1.2b3")}; |
62 | like($@, qr/non-numeric data/, | |
63 | "Invalid version format (non-numeric data)"); | |
317f7c8a | 64 | |
c8c8e589 JP |
65 | eval { $version = $CLASS->$method("-1.23")}; |
66 | like($@, qr/negative version number/, | |
67 | "Invalid version format (negative version number)"); | |
68 | ||
317f7c8a | 69 | # from here on out capture the warning and test independently |
f34c6aaf | 70 | { |
91152fc1 | 71 | eval{$version = $CLASS->$method("99 and 44/100 pure")}; |
317f7c8a | 72 | |
91152fc1 DG |
73 | like($@, qr/non-numeric data/, |
74 | "Invalid version format (non-numeric data)"); | |
543eec9e | 75 | |
91152fc1 DG |
76 | eval{$version = $CLASS->$method("something")}; |
77 | like($@, qr/non-numeric data/, | |
78 | "Invalid version format (non-numeric data)"); | |
543eec9e | 79 | |
317f7c8a | 80 | # reset the test object to something reasonable |
f941e658 | 81 | $version = $CLASS->$method("1.2.3"); |
543eec9e | 82 | |
317f7c8a RGS |
83 | # Test boolean operator |
84 | ok ($version, 'boolean'); | |
543eec9e | 85 | |
317f7c8a RGS |
86 | # Test class membership |
87 | isa_ok ( $version, $CLASS ); | |
543eec9e | 88 | |
317f7c8a | 89 | # Test comparison operators with self |
8cb289bd | 90 | is ( $version <=> $version, 0, '$version <=> $version == 0' ); |
317f7c8a | 91 | ok ( $version == $version, '$version == $version' ); |
543eec9e | 92 | |
317f7c8a RGS |
93 | # Test Numeric Comparison operators |
94 | # test first with non-object | |
f941e658 | 95 | $version = $CLASS->$method("5.006.001"); |
317f7c8a | 96 | $new_version = "5.8.0"; |
317f7c8a RGS |
97 | ok ( $version == $version, '$version == $version' ); |
98 | ok ( $version < $new_version, '$version < $new_version' ); | |
99 | ok ( $new_version > $version, '$new_version > $version' ); | |
100 | ok ( $version != $new_version, '$version != $new_version' ); | |
543eec9e | 101 | |
317f7c8a | 102 | # now test with existing object |
f941e658 | 103 | $new_version = $CLASS->$method($new_version); |
317f7c8a RGS |
104 | ok ( $version < $new_version, '$version < $new_version' ); |
105 | ok ( $new_version > $version, '$new_version > $version' ); | |
106 | ok ( $version != $new_version, '$version != $new_version' ); | |
543eec9e | 107 | |
317f7c8a | 108 | # now test with actual numbers |
317f7c8a RGS |
109 | ok ( $version->numify() == 5.006001, '$version->numify() == 5.006001' ); |
110 | ok ( $version->numify() <= 5.006001, '$version->numify() <= 5.006001' ); | |
111 | ok ( $version->numify() < 5.008, '$version->numify() < 5.008' ); | |
112 | #ok ( $version->numify() > v5.005_02, '$version->numify() > 5.005_02' ); | |
543eec9e | 113 | |
317f7c8a | 114 | # test with long decimals |
f941e658 | 115 | $version = $CLASS->$method(1.002003); |
8cb289bd | 116 | ok ( $version == "1.2.3", '$version == "1.2.3"'); |
317f7c8a | 117 | ok ( $version->numify == 1.002003, '$version->numify == 1.002003'); |
f941e658 | 118 | $version = $CLASS->$method("2002.09.30.1"); |
8cb289bd | 119 | ok ( $version == "2002.9.30.1",'$version == 2002.9.30.1'); |
317f7c8a RGS |
120 | ok ( $version->numify == 2002.009030001, |
121 | '$version->numify == 2002.009030001'); | |
543eec9e | 122 | |
317f7c8a | 123 | # now test with alpha version form with string |
f941e658 | 124 | $version = $CLASS->$method("1.2.3"); |
317f7c8a | 125 | $new_version = "1.2.3_4"; |
8cb289bd RGS |
126 | ok ( $version < $new_version, '$version < $new_version' ); |
127 | ok ( $new_version > $version, '$new_version > $version' ); | |
128 | ok ( $version != $new_version, '$version != $new_version' ); | |
543eec9e | 129 | |
f941e658 | 130 | $version = $CLASS->$method("1.2.4"); |
317f7c8a RGS |
131 | ok ( $version > $new_version, '$version > $new_version' ); |
132 | ok ( $new_version < $version, '$new_version < $version' ); | |
133 | ok ( $version != $new_version, '$version != $new_version' ); | |
543eec9e | 134 | |
317f7c8a | 135 | # now test with alpha version form with object |
f941e658 JP |
136 | $version = $CLASS->$method("1.2.3"); |
137 | $new_version = $CLASS->$method("1.2.3_4"); | |
317f7c8a RGS |
138 | ok ( $version < $new_version, '$version < $new_version' ); |
139 | ok ( $new_version > $version, '$new_version > $version' ); | |
140 | ok ( $version != $new_version, '$version != $new_version' ); | |
141 | ok ( !$version->is_alpha, '!$version->is_alpha'); | |
142 | ok ( $new_version->is_alpha, '$new_version->is_alpha'); | |
543eec9e | 143 | |
f941e658 | 144 | $version = $CLASS->$method("1.2.4"); |
317f7c8a RGS |
145 | ok ( $version > $new_version, '$version > $new_version' ); |
146 | ok ( $new_version < $version, '$new_version < $version' ); | |
147 | ok ( $version != $new_version, '$version != $new_version' ); | |
543eec9e | 148 | |
f941e658 JP |
149 | $version = $CLASS->$method("1.2.3.4"); |
150 | $new_version = $CLASS->$method("1.2.3_4"); | |
317f7c8a RGS |
151 | ok ( $version > $new_version, '$version > $new_version' ); |
152 | ok ( $new_version < $version, '$new_version < $version' ); | |
153 | ok ( $version != $new_version, '$version != $new_version' ); | |
543eec9e | 154 | |
f941e658 JP |
155 | $version = $CLASS->$method("v1.2.3"); |
156 | $new_version = $CLASS->$method("1.2.3.0"); | |
317f7c8a | 157 | ok ( $version == $new_version, '$version == $new_version' ); |
f941e658 | 158 | $new_version = $CLASS->$method("1.2.3_0"); |
317f7c8a | 159 | ok ( $version == $new_version, '$version == $new_version' ); |
f941e658 | 160 | $new_version = $CLASS->$method("1.2.3.1"); |
317f7c8a | 161 | ok ( $version < $new_version, '$version < $new_version' ); |
f941e658 | 162 | $new_version = $CLASS->$method("1.2.3_1"); |
317f7c8a | 163 | ok ( $version < $new_version, '$version < $new_version' ); |
f941e658 | 164 | $new_version = $CLASS->$method("1.1.999"); |
317f7c8a | 165 | ok ( $version > $new_version, '$version > $new_version' ); |
543eec9e | 166 | |
e7b3543f | 167 | $version = $CLASS->$method("v1.2.3"); |
543eec9e | 168 | eval { () = $version < 'version' }; |
5027b3af JP |
169 | # this test, and only this test, I have to do this or else $@ gets |
170 | # "reset" before like() has a chance to evaluate it. Quite maddening!!! | |
171 | my $err = $@; | |
172 | like $err, qr/^Invalid version format/, "error with $version < 'version'"; | |
543eec9e | 173 | |
317f7c8a | 174 | # that which is not expressly permitted is forbidden |
317f7c8a RGS |
175 | ok ( !eval { ++$version }, "noop ++" ); |
176 | ok ( !eval { --$version }, "noop --" ); | |
177 | ok ( !eval { $version/1 }, "noop /" ); | |
178 | ok ( !eval { $version*3 }, "noop *" ); | |
179 | ok ( !eval { abs($version) }, "noop abs" ); | |
137d6fc0 | 180 | |
c8a14fb6 | 181 | SKIP: { |
f941e658 | 182 | skip "version require'd instead of use'd, cannot test $qv_declare", 3 |
543eec9e | 183 | unless defined $qv_declare; |
f941e658 | 184 | # test the $qv_declare() sub |
f941e658 JP |
185 | $version = $CLASS->$qv_declare("1.2"); |
186 | is ( "$version", "v1.2", $qv_declare.'("1.2") == "1.2.0"' ); | |
187 | $version = $CLASS->$qv_declare(1.2); | |
188 | is ( "$version", "v1.2", $qv_declare.'(1.2) == "1.2.0"' ); | |
189 | isa_ok( $CLASS->$qv_declare('5.008'), $CLASS ); | |
c8a14fb6 | 190 | } |
137d6fc0 | 191 | |
317f7c8a | 192 | # test creation from existing version object |
f941e658 | 193 | ok (eval {$new_version = $CLASS->$method($version)}, |
317f7c8a | 194 | "new from existing object"); |
f941e658 | 195 | ok ($new_version == $version, "class->$method($version) identical"); |
d54f8cf7 | 196 | $new_version = $version->$method(0); |
317f7c8a | 197 | isa_ok ($new_version, $CLASS ); |
f941e658 JP |
198 | is ($new_version, "0", "version->$method() doesn't clone"); |
199 | $new_version = $version->$method("1.2.3"); | |
200 | is ($new_version, "1.2.3" , '$version->$method("1.2.3") works too'); | |
317f7c8a RGS |
201 | |
202 | # test the CVS revision mode | |
317f7c8a | 203 | $version = new $CLASS qw$Revision: 1.2$; |
8cb289bd | 204 | ok ( $version == "1.2.0", 'qw$Revision: 1.2$ == 1.2.0' ); |
317f7c8a | 205 | $version = new $CLASS qw$Revision: 1.2.3.4$; |
8cb289bd | 206 | ok ( $version == "1.2.3.4", 'qw$Revision: 1.2.3.4$ == 1.2.3.4' ); |
543eec9e | 207 | |
317f7c8a | 208 | # test the CPAN style reduced significant digit form |
f941e658 | 209 | $version = $CLASS->$method("1.23_01"); |
8cb289bd | 210 | is ( "$version" , "1.23_01", "CPAN-style alpha version" ); |
317f7c8a RGS |
211 | ok ( $version > 1.23, "1.23_01 > 1.23"); |
212 | ok ( $version < 1.24, "1.23_01 < 1.24"); | |
213 | ||
214 | # test reformed UNIVERSAL::VERSION | |
f34c6aaf JP |
215 | |
216 | my $error_regex = $] < 5.006 | |
217 | ? 'version \d required' | |
f941e658 | 218 | : 'does not define \$t.{7}::VERSION'; |
543eec9e | 219 | |
f34c6aaf | 220 | { |
f941e658 JP |
221 | my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); |
222 | (my $package = basename($filename)) =~ s/\.pm$//; | |
223 | print $fh "package $package;\n\$$package\::VERSION=0.58;\n1;\n"; | |
224 | close $fh; | |
f34c6aaf | 225 | |
8cb289bd | 226 | $version = 0.58; |
f941e658 JP |
227 | eval "use lib '.'; use $package $version"; |
228 | unlike($@, qr/$package version $version/, | |
f34c6aaf | 229 | 'Replacement eval works with exact version'); |
543eec9e | 230 | |
f34c6aaf | 231 | # test as class method |
f941e658 | 232 | $new_version = $package->VERSION; |
8cb289bd | 233 | cmp_ok($new_version,'==',$version, "Called as class method"); |
8dd04980 | 234 | |
f34c6aaf JP |
235 | eval "print Completely::Unknown::Module->VERSION"; |
236 | if ( $] < 5.008 ) { | |
237 | unlike($@, qr/$error_regex/, | |
238 | "Don't freak if the module doesn't even exist"); | |
239 | } | |
240 | else { | |
241 | unlike($@, qr/defines neither package nor VERSION/, | |
242 | "Don't freak if the module doesn't even exist"); | |
243 | } | |
244 | ||
245 | # this should fail even with old UNIVERSAL::VERSION | |
8cb289bd | 246 | $version += 0.01; |
f941e658 JP |
247 | eval "use lib '.'; use $package $version"; |
248 | like($@, qr/$package version $version/, | |
f34c6aaf | 249 | 'Replacement eval works with incremented version'); |
543eec9e | 250 | |
f34c6aaf JP |
251 | $version =~ s/0+$//; #convert to string and remove trailing 0's |
252 | chop($version); # shorten by 1 digit, should still succeed | |
f941e658 JP |
253 | eval "use lib '.'; use $package $version"; |
254 | unlike($@, qr/$package version $version/, | |
f34c6aaf | 255 | 'Replacement eval works with single digit'); |
543eec9e | 256 | |
f34c6aaf | 257 | # this would fail with old UNIVERSAL::VERSION |
8cb289bd | 258 | $version += 0.1; |
f941e658 JP |
259 | eval "use lib '.'; use $package $version"; |
260 | like($@, qr/$package version $version/, | |
f34c6aaf | 261 | 'Replacement eval works with incremented digit'); |
f941e658 | 262 | unlink $filename; |
f34c6aaf | 263 | } |
317f7c8a RGS |
264 | |
265 | { # dummy up some variously broken modules for testing | |
f941e658 JP |
266 | my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); |
267 | (my $package = basename($filename)) =~ s/\.pm$//; | |
268 | print $fh "1;\n"; | |
269 | close $fh; | |
f34c6aaf | 270 | |
f941e658 | 271 | eval "use lib '.'; use $package 3;"; |
317f7c8a | 272 | if ( $] < 5.008 ) { |
f34c6aaf | 273 | like($@, qr/$error_regex/, |
543eec9e | 274 | 'Replacement handles modules without package or VERSION'); |
c8a14fb6 | 275 | } |
317f7c8a | 276 | else { |
f34c6aaf | 277 | like($@, qr/defines neither package nor VERSION/, |
543eec9e | 278 | 'Replacement handles modules without package or VERSION'); |
c8a14fb6 | 279 | } |
f941e658 | 280 | eval "use lib '.'; use $package; \$version = $package->VERSION"; |
317f7c8a | 281 | unlike ($@, qr/$error_regex/, |
543eec9e | 282 | 'Replacement handles modules without package or VERSION'); |
f34c6aaf | 283 | ok (!defined($version), "Called as class method"); |
f941e658 | 284 | unlink $filename; |
317f7c8a | 285 | } |
543eec9e | 286 | |
317f7c8a | 287 | { # dummy up some variously broken modules for testing |
f941e658 JP |
288 | my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); |
289 | (my $package = basename($filename)) =~ s/\.pm$//; | |
290 | print $fh "package $package;\n#look ma no VERSION\n1;\n"; | |
291 | close $fh; | |
292 | eval "use lib '.'; use $package 3;"; | |
f34c6aaf | 293 | like ($@, qr/$error_regex/, |
543eec9e | 294 | 'Replacement handles modules without VERSION'); |
f941e658 | 295 | eval "use lib '.'; use $package; print $package->VERSION"; |
f34c6aaf | 296 | unlike ($@, qr/$error_regex/, |
543eec9e | 297 | 'Replacement handles modules without VERSION'); |
f941e658 | 298 | unlink $filename; |
317f7c8a RGS |
299 | } |
300 | ||
301 | { # dummy up some variously broken modules for testing | |
f941e658 JP |
302 | my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); |
303 | (my $package = basename($filename)) =~ s/\.pm$//; | |
304 | print $fh "package $package;\n\@VERSION = ();\n1;\n"; | |
305 | close $fh; | |
306 | eval "use lib '.'; use $package 3;"; | |
f34c6aaf | 307 | like ($@, qr/$error_regex/, |
543eec9e | 308 | 'Replacement handles modules without VERSION'); |
f941e658 | 309 | eval "use lib '.'; use $package; print $package->VERSION"; |
f34c6aaf | 310 | unlike ($@, qr/$error_regex/, |
543eec9e | 311 | 'Replacement handles modules without VERSION'); |
f941e658 | 312 | unlink $filename; |
317f7c8a | 313 | } |
a0e8d7b9 JP |
314 | SKIP: { # https://rt.perl.org/rt3/Ticket/Display.html?id=95544 |
315 | skip "version require'd instead of use'd, cannot test UNIVERSAL::VERSION", 2 | |
316 | unless defined $qv_declare; | |
317 | my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); | |
318 | (my $package = basename($filename)) =~ s/\.pm$//; | |
319 | print $fh "package $package;\n\$VERSION = '3alpha';\n1;\n"; | |
320 | close $fh; | |
249f7ddc JP |
321 | eval "use lib '.'; use $package; print $package->VERSION"; |
322 | like ($@, qr/Invalid version format \(non-numeric data\)/, | |
323 | 'Warn about bad \$VERSION'); | |
a0e8d7b9 JP |
324 | eval "use lib '.'; use $package 1;"; |
325 | like ($@, qr/Invalid version format \(non-numeric data\)/, | |
249f7ddc | 326 | 'Warn about bad $VERSION'); |
a0e8d7b9 | 327 | } |
317f7c8a | 328 | |
137d6fc0 | 329 | SKIP: { |
ac0e6a2f | 330 | skip 'Cannot test bare v-strings with Perl < 5.6.0', 4 |
543eec9e | 331 | if $] < 5.006_000; |
f941e658 | 332 | $version = $CLASS->$method(1.2.3); |
d54f8cf7 | 333 | ok("$version" eq "v1.2.3", '"$version" eq 1.2.3'); |
f941e658 JP |
334 | $version = $CLASS->$method(1.0.0); |
335 | $new_version = $CLASS->$method(1); | |
317f7c8a | 336 | ok($version == $new_version, '$version == $new_version'); |
f941e658 JP |
337 | skip "version require'd instead of use'd, cannot test declare", 1 |
338 | unless defined $qv_declare; | |
339 | $version = &$qv_declare(1.2.3); | |
d54f8cf7 JP |
340 | ok("$version" eq "v1.2.3", 'v-string initialized $qv_declare()'); |
341 | } | |
342 | ||
343 | SKIP: { | |
344 | skip 'Cannot test bare alpha v-strings with Perl < 5.8.1', 2 | |
543eec9e | 345 | if $] lt 5.008_001; |
d54f8cf7 JP |
346 | $version = $CLASS->$method(v1.2.3_4); |
347 | is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4"'); | |
348 | $version = $CLASS->$method(eval "v1.2.3_4"); | |
349 | is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4" (from eval)'); | |
317f7c8a RGS |
350 | } |
351 | ||
317f7c8a | 352 | # trailing zero testing (reported by Andreas Koenig). |
f941e658 | 353 | $version = $CLASS->$method("1"); |
317f7c8a | 354 | ok($version->numify eq "1.000", "trailing zeros preserved"); |
f941e658 | 355 | $version = $CLASS->$method("1.0"); |
317f7c8a | 356 | ok($version->numify eq "1.000", "trailing zeros preserved"); |
f941e658 | 357 | $version = $CLASS->$method("1.0.0"); |
317f7c8a | 358 | ok($version->numify eq "1.000000", "trailing zeros preserved"); |
f941e658 | 359 | $version = $CLASS->$method("1.0.0.0"); |
317f7c8a | 360 | ok($version->numify eq "1.000000000", "trailing zeros preserved"); |
543eec9e | 361 | |
317f7c8a | 362 | # leading zero testing (reported by Andreas Koenig). |
f941e658 | 363 | $version = $CLASS->$method(".7"); |
317f7c8a RGS |
364 | ok($version->numify eq "0.700", "leading zero inferred"); |
365 | ||
366 | # leading space testing (reported by Andreas Koenig). | |
f941e658 | 367 | $version = $CLASS->$method(" 1.7"); |
317f7c8a RGS |
368 | ok($version->numify eq "1.700", "leading space ignored"); |
369 | ||
370 | # RT 19517 - deal with undef and 'undef' initialization | |
8cb289bd RGS |
371 | ok("$version" ne 'undef', "Undef version comparison #1"); |
372 | ok("$version" ne undef, "Undef version comparison #2"); | |
f941e658 | 373 | $version = $CLASS->$method('undef'); |
317f7c8a RGS |
374 | unlike($warning, qr/^Version string 'undef' contains invalid data/, |
375 | "Version string 'undef'"); | |
376 | ||
f941e658 | 377 | $version = $CLASS->$method(undef); |
317f7c8a RGS |
378 | like($warning, qr/^Use of uninitialized value/, |
379 | "Version string 'undef'"); | |
8cb289bd RGS |
380 | ok($version == 'undef', "Undef version comparison #3"); |
381 | ok($version == undef, "Undef version comparison #4"); | |
f941e658 | 382 | eval "\$version = \$CLASS->$method()"; # no parameter at all |
317f7c8a | 383 | unlike($@, qr/^Bizarre copy of CODE/, "No initializer at all"); |
8cb289bd RGS |
384 | ok($version == 'undef', "Undef version comparison #5"); |
385 | ok($version == undef, "Undef version comparison #6"); | |
317f7c8a | 386 | |
f941e658 | 387 | $version = $CLASS->$method(0.000001); |
317f7c8a | 388 | unlike($warning, qr/^Version string '1e-06' contains invalid data/, |
543eec9e | 389 | "Very small version objects"); |
f34c6aaf | 390 | } |
e0218a61 | 391 | |
317f7c8a | 392 | SKIP: { |
f941e658 JP |
393 | my $warning; |
394 | local $SIG{__WARN__} = sub { $warning = $_[0] }; | |
317f7c8a | 395 | # dummy up a legal module for testing RT#19017 |
f941e658 JP |
396 | my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); |
397 | (my $package = basename($filename)) =~ s/\.pm$//; | |
398 | print $fh <<"EOF"; | |
399 | package $package; | |
400 | use $CLASS; \$VERSION = ${CLASS}->new('0.0.4'); | |
c8a14fb6 RGS |
401 | 1; |
402 | EOF | |
f941e658 | 403 | close $fh; |
317f7c8a | 404 | |
f941e658 JP |
405 | eval "use lib '.'; use $package 0.000008;"; |
406 | like ($@, qr/^$package version 0.000008 required/, | |
543eec9e | 407 | "Make sure very small versions don't freak"); |
f941e658 JP |
408 | eval "use lib '.'; use $package 1;"; |
409 | like ($@, qr/^$package version 1 required/, | |
543eec9e | 410 | "Comparing vs. version with no decimal"); |
f941e658 JP |
411 | eval "use lib '.'; use $package 1.;"; |
412 | like ($@, qr/^$package version 1 required/, | |
543eec9e | 413 | "Comparing vs. version with decimal only"); |
ac0e6a2f | 414 | if ( $] < 5.006_000 ) { |
543eec9e | 415 | skip 'Cannot "use" extended versions with Perl < 5.6.0', 3; |
d69f6151 | 416 | } |
f941e658 JP |
417 | eval "use lib '.'; use $package v0.0.8;"; |
418 | my $regex = "^$package version v0.0.8 required"; | |
543eec9e | 419 | like ($@, qr/$regex/, "Make sure very small versions don't freak"); |
317f7c8a | 420 | |
ac0e6a2f | 421 | $regex =~ s/8/4/; # set for second test |
f941e658 | 422 | eval "use lib '.'; use $package v0.0.4;"; |
ac0e6a2f | 423 | unlike($@, qr/$regex/, 'Succeed - required == VERSION'); |
f941e658 JP |
424 | cmp_ok ( $package->VERSION, 'eq', '0.0.4', 'No undef warnings' ); |
425 | unlink $filename; | |
317f7c8a RGS |
426 | } |
427 | ||
f941e658 | 428 | SKIP: { |
5027b3af | 429 | skip 'Cannot test "use parent qw(version)" when require is used', 3 |
543eec9e | 430 | unless defined $qv_declare; |
f941e658 JP |
431 | my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); |
432 | (my $package = basename($filename)) =~ s/\.pm$//; | |
433 | print $fh <<"EOF"; | |
434 | package $package; | |
5027b3af | 435 | use parent qw(version); |
92dcf8ce JP |
436 | 1; |
437 | EOF | |
f941e658 JP |
438 | close $fh; |
439 | # need to eliminate any other $qv_declare()'s | |
440 | undef *{"main\::$qv_declare"}; | |
441 | ok(!defined(&{"main\::$qv_declare"}), "make sure we cleared $qv_declare() properly"); | |
442 | eval "use lib '.'; use $package qw/declare qv/;"; | |
443 | ok(defined(&{"main\::$qv_declare"}), "make sure we exported $qv_declare() properly"); | |
444 | isa_ok( &$qv_declare(1.2), $package); | |
445 | unlink $filename; | |
446 | } | |
d69f6151 JP |
447 | |
448 | SKIP: { | |
ac0e6a2f | 449 | if ( $] < 5.006_000 ) { |
543eec9e | 450 | skip 'Cannot "use" extended versions with Perl < 5.6.0', 3; |
ac0e6a2f | 451 | } |
f941e658 JP |
452 | my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); |
453 | (my $package = basename($filename)) =~ s/\.pm$//; | |
454 | print $fh <<"EOF"; | |
455 | package $package; | |
ac0e6a2f RGS |
456 | \$VERSION = 1.0; |
457 | 1; | |
458 | EOF | |
f941e658 JP |
459 | close $fh; |
460 | eval "use lib '.'; use $package 1.001;"; | |
461 | like ($@, qr/^$package version 1.001 required/, | |
543eec9e | 462 | "User typed numeric so we error with numeric"); |
f941e658 JP |
463 | eval "use lib '.'; use $package v1.1.0;"; |
464 | like ($@, qr/^$package version v1.1.0 required/, | |
543eec9e | 465 | "User typed extended so we error with extended"); |
f941e658 | 466 | unlink $filename; |
ac0e6a2f RGS |
467 | } |
468 | ||
f941e658 | 469 | eval 'my $v = $CLASS->$method("1._1");'; |
f34c6aaf | 470 | unlike($@, qr/^Invalid version format \(alpha with zero width\)/, |
543eec9e | 471 | "Invalid version format 1._1"); |
ac0e6a2f | 472 | |
c812d146 JP |
473 | { |
474 | my $warning; | |
475 | local $SIG{__WARN__} = sub { $warning = $_[0] }; | |
f941e658 | 476 | eval 'my $v = $CLASS->$method(~0);'; |
c812d146 JP |
477 | unlike($@, qr/Integer overflow in version/, "Too large version"); |
478 | like($warning, qr/Integer overflow in version/, "Too large version"); | |
479 | } | |
480 | ||
72287d96 | 481 | { |
4a755745 | 482 | local $Data::Dumper::Sortkeys= 1; |
72287d96 | 483 | # http://rt.cpan.org/Public/Bug/Display.html?id=30004 |
f941e658 | 484 | my $v1 = $CLASS->$method("v0.1_1"); |
72287d96 | 485 | (my $alpha1 = Dumper($v1)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms; |
f941e658 | 486 | my $v2 = $CLASS->$method($v1); |
72287d96 JP |
487 | (my $alpha2 = Dumper($v2)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms; |
488 | is $alpha2, $alpha1, "Don't fall for Data::Dumper's tricks"; | |
489 | } | |
490 | ||
219bf418 RGS |
491 | { |
492 | # http://rt.perl.org/rt3/Ticket/Display.html?id=56606 | |
493 | my $badv = bless { version => [1,2,3] }, "version"; | |
543eec9e | 494 | is $badv, '1.002003', "Deal with badly serialized versions from YAML"; |
219bf418 | 495 | my $badv2 = bless { qv => 1, version => [1,2,3] }, "version"; |
543eec9e | 496 | is $badv2, 'v1.2.3', "Deal with badly serialized versions from YAML "; |
219bf418 | 497 | } |
249f7ddc JP |
498 | |
499 | { | |
500 | # https://rt.cpan.org/Public/Bug/Display.html?id=70950 | |
501 | # test indirect usage of version objects | |
502 | my $sum = 0; | |
503 | eval '$sum += $CLASS->$method("v2.0.0")'; | |
504 | like $@, qr/operation not supported with version object/, | |
505 | 'No math operations with version objects'; | |
506 | # test direct usage of version objects | |
507 | my $v = $CLASS->$method("v2.0.0"); | |
508 | eval '$v += 1'; | |
509 | like $@, qr/operation not supported with version object/, | |
510 | 'No math operations with version objects'; | |
511 | } | |
512 | ||
513 | { | |
514 | # https://rt.cpan.org/Ticket/Display.html?id=72365 | |
515 | # https://rt.perl.org/rt3/Ticket/Display.html?id=102586 | |
a6075c73 | 516 | # https://rt.cpan.org/Ticket/Display.html?id=78328 |
249f7ddc JP |
517 | eval 'my $v = $CLASS->$method("version")'; |
518 | like $@, qr/Invalid version format/, | |
a6075c73 | 519 | "The string 'version' is not a version for $method"; |
249f7ddc JP |
520 | eval 'my $v = $CLASS->$method("ver510n")'; |
521 | like $@, qr/Invalid version format/, | |
522 | 'All strings starting with "v" are not versions'; | |
523 | } | |
524 | ||
d54f8cf7 JP |
525 | SKIP: { |
526 | if ( $] < 5.006_000 ) { | |
543eec9e | 527 | skip 'No v-string support at all < 5.6.0', 2; |
d54f8cf7 JP |
528 | } |
529 | # https://rt.cpan.org/Ticket/Display.html?id=49348 | |
530 | my $v = $CLASS->$method("420"); | |
531 | is "$v", "420", 'Correctly guesses this is not a v-string'; | |
532 | $v = $CLASS->$method(4.2.0); | |
533 | is "$v", 'v4.2.0', 'Correctly guess that this is a v-string'; | |
534 | } | |
535 | SKIP: { | |
536 | if ( $] < 5.006_000 ) { | |
543eec9e | 537 | skip 'No v-string support at all < 5.6.0', 4; |
d54f8cf7 JP |
538 | } |
539 | # https://rt.cpan.org/Ticket/Display.html?id=50347 | |
540 | # Check that the qv() implementation does not change | |
541 | ||
542 | ok $CLASS->$method(1.2.3) < $CLASS->$method(1.2.3.1), 'Compare 3 and 4 digit v-strings' ; | |
543 | ok $CLASS->$method(v1.2.3) < $CLASS->$method(v1.2.3.1), 'Compare 3 and 4 digit v-strings, leaving v'; | |
544 | ok $CLASS->$method("1.2.3") < $CLASS->$method("1.2.3.1"), 'Compare 3 and 4 digit v-strings, quoted'; | |
545 | ok $CLASS->$method("v1.2.3") < $CLASS->$method("v1.2.3.1"), 'Compare 3 and 4 digit v-strings, quoted leading v'; | |
546 | } | |
cb5772bb | 547 | |
249f7ddc JP |
548 | { |
549 | eval '$CLASS->$method("version")'; | |
550 | pass("no crash with ${CLASS}->${method}('version')"); | |
551 | { | |
552 | package _102586; | |
553 | sub TIESCALAR { bless [] } | |
554 | sub FETCH { "version" } | |
555 | sub STORE { } | |
556 | my $v; | |
557 | tie $v, __PACKAGE__; | |
558 | $v = $CLASS->$method(1); | |
559 | eval '$CLASS->$method($v)'; | |
560 | } | |
561 | pass('no crash with version->new($tied) where $tied returns "version"'); | |
562 | } | |
78e230ae FC |
563 | |
564 | { # [perl #112478] | |
565 | $_112478::VERSION = 9e99; | |
566 | ok eval { _112478->VERSION(9e99); 1 }, '->VERSION(9e99) succeeds' | |
567 | or diag $@; | |
568 | $_112478::VERSION = 1; | |
569 | eval { _112478->VERSION(9e99) }; | |
d1f1d9a7 | 570 | unlike $@, qr/panic/, '->VERSION(9e99) does not panic'; |
78e230ae | 571 | } |
a6075c73 JP |
572 | |
573 | { # https://rt.cpan.org/Ticket/Display.html?id=79259 | |
574 | my $v = $CLASS->new("0.52_0"); | |
575 | ok $v->is_alpha, 'Just checking'; | |
576 | is $v->numify, '0.520', 'Correctly nummified'; | |
577 | } | |
578 | ||
bc4eb4d6 | 579 | } |
bc4eb4d6 | 580 | |
cb5772bb | 581 | 1; |
a6075c73 | 582 |