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