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"}, $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.3.4"); 154 $new_version = $CLASS->$method("1.2.3_4"); 155 ok ( $version > $new_version, '$version > $new_version' ); 156 ok ( $new_version < $version, '$new_version < $version' ); 157 ok ( $version != $new_version, '$version != $new_version' ); 158 159 $version = $CLASS->$method("v1.2.3"); 160 $new_version = $CLASS->$method("1.2.3.0"); 161 ok ( $version == $new_version, '$version == $new_version' ); 162 $new_version = $CLASS->$method("1.2.3_0"); 163 ok ( $version == $new_version, '$version == $new_version' ); 164 $new_version = $CLASS->$method("1.2.3.1"); 165 ok ( $version < $new_version, '$version < $new_version' ); 166 $new_version = $CLASS->$method("1.2.3_1"); 167 ok ( $version < $new_version, '$version < $new_version' ); 168 $new_version = $CLASS->$method("1.1.999"); 169 ok ( $version > $new_version, '$version > $new_version' ); 170 171 $version = $CLASS->$method("v1.2.3"); 172 eval { () = $version < 'version' }; 173 # this test, and only this test, I have to do this or else $@ gets 174 # "reset" before like() has a chance to evaluate it. Quite maddening!!! 175 my $err = $@; 176 like $err, qr/^Invalid version format/, "error with $version < 'version'"; 177 178 # that which is not expressly permitted is forbidden 179 ok ( !eval { ++$version }, "noop ++" ); 180 ok ( !eval { --$version }, "noop --" ); 181 ok ( !eval { $version/1 }, "noop /" ); 182 ok ( !eval { $version*3 }, "noop *" ); 183 ok ( !eval { abs($version) }, "noop abs" ); 184 185SKIP: { 186 skip "version require'd instead of use'd, cannot test $qv_declare", 3 187 unless defined $qv_declare; 188 # test the $qv_declare() sub 189 $version = $CLASS->$qv_declare("1.2"); 190 is ( "$version", "v1.2", $qv_declare.'("1.2") == "1.2.0"' ); 191 $version = $CLASS->$qv_declare(1.2); 192 is ( "$version", "v1.2", $qv_declare.'(1.2) == "1.2.0"' ); 193 isa_ok( $CLASS->$qv_declare('5.008'), $CLASS ); 194} 195 196 # test creation from existing version object 197 ok (eval {$new_version = $CLASS->$method($version)}, 198 "new from existing object"); 199 ok ($new_version == $version, "class->$method($version) identical"); 200 $new_version = $version->$method(0); 201 isa_ok ($new_version, $CLASS ); 202 is ($new_version, "0", "version->$method() doesn't clone"); 203 $new_version = $version->$method("1.2.3"); 204 is ($new_version, "1.2.3" , '$version->$method("1.2.3") works too'); 205 206 # test the CVS revision mode 207 $version = new $CLASS qw$Revision: 1.2$; 208 ok ( $version == "1.2.0", 'qw$Revision: 1.2$ == 1.2.0' ); 209 $version = new $CLASS qw$Revision: 1.2.3.4$; 210 ok ( $version == "1.2.3.4", 'qw$Revision: 1.2.3.4$ == 1.2.3.4' ); 211 212 # test the CPAN style reduced significant digit form 213 $version = $CLASS->$method("1.23_01"); 214 is ( "$version" , "1.23_01", "CPAN-style alpha version" ); 215 ok ( $version > 1.23, "1.23_01 > 1.23"); 216 ok ( $version < 1.24, "1.23_01 < 1.24"); 217 218 # test reformed UNIVERSAL::VERSION 219 220 my $error_regex = $] < 5.006 221 ? 'version \d required' 222 : 'does not define \$t.{7}::VERSION'; 223 224 { 225 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); 226 (my $package = basename($filename)) =~ s/\.pm$//; 227 print $fh "package $package;\n\$$package\::VERSION=0.58;\n1;\n"; 228 close $fh; 229 230 $version = 0.58; 231 eval "use lib '.'; use $package $version"; 232 unlike($@, qr/$package version $version/, 233 'Replacement eval works with exact version'); 234 235 # test as class method 236 $new_version = $package->VERSION; 237 cmp_ok($new_version,'==',$version, "Called as class method"); 238 239 eval "print Completely::Unknown::Module->VERSION"; 240 if ( $] < 5.008 ) { 241 unlike($@, qr/$error_regex/, 242 "Don't freak if the module doesn't even exist"); 243 } 244 else { 245 unlike($@, qr/defines neither package nor VERSION/, 246 "Don't freak if the module doesn't even exist"); 247 } 248 249 # this should fail even with old UNIVERSAL::VERSION 250 $version += 0.01; 251 eval "use lib '.'; use $package $version"; 252 like($@, qr/$package version $version/, 253 'Replacement eval works with incremented version'); 254 255 $version =~ s/0+$//; #convert to string and remove trailing 0's 256 chop($version); # shorten by 1 digit, should still succeed 257 eval "use lib '.'; use $package $version"; 258 unlike($@, qr/$package version $version/, 259 'Replacement eval works with single digit'); 260 261 # this would fail with old UNIVERSAL::VERSION 262 $version += 0.1; 263 eval "use lib '.'; use $package $version"; 264 like($@, qr/$package version $version/, 265 'Replacement eval works with incremented digit'); 266 unlink $filename; 267 } 268 269 { # dummy up some variously broken modules for testing 270 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); 271 (my $package = basename($filename)) =~ s/\.pm$//; 272 print $fh "1;\n"; 273 close $fh; 274 275 eval "use lib '.'; use $package 3;"; 276 if ( $] < 5.008 ) { 277 like($@, qr/$error_regex/, 278 'Replacement handles modules without package or VERSION'); 279 } 280 else { 281 like($@, qr/defines neither package nor VERSION/, 282 'Replacement handles modules without package or VERSION'); 283 } 284 eval "use lib '.'; use $package; \$version = $package->VERSION"; 285 unlike ($@, qr/$error_regex/, 286 'Replacement handles modules without package or VERSION'); 287 ok (!defined($version), "Called as class method"); 288 unlink $filename; 289 } 290 291 { # dummy up some variously broken modules for testing 292 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); 293 (my $package = basename($filename)) =~ s/\.pm$//; 294 print $fh "package $package;\n#look ma no VERSION\n1;\n"; 295 close $fh; 296 eval "use lib '.'; use $package 3;"; 297 like ($@, qr/$error_regex/, 298 'Replacement handles modules without VERSION'); 299 eval "use lib '.'; use $package; print $package->VERSION"; 300 unlike ($@, qr/$error_regex/, 301 'Replacement handles modules without VERSION'); 302 unlink $filename; 303 } 304 305 { # dummy up some variously broken modules for testing 306 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); 307 (my $package = basename($filename)) =~ s/\.pm$//; 308 print $fh "package $package;\n\@VERSION = ();\n1;\n"; 309 close $fh; 310 eval "use lib '.'; use $package 3;"; 311 like ($@, qr/$error_regex/, 312 'Replacement handles modules without VERSION'); 313 eval "use lib '.'; use $package; print $package->VERSION"; 314 unlike ($@, qr/$error_regex/, 315 'Replacement handles modules without VERSION'); 316 unlink $filename; 317 } 318SKIP: { # https://rt.perl.org/rt3/Ticket/Display.html?id=95544 319 skip "version require'd instead of use'd, cannot test UNIVERSAL::VERSION", 2 320 unless defined $qv_declare; 321 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); 322 (my $package = basename($filename)) =~ s/\.pm$//; 323 print $fh "package $package;\n\$VERSION = '3alpha';\n1;\n"; 324 close $fh; 325 eval "use lib '.'; use $package; print $package->VERSION"; 326 like ($@, qr/Invalid version format \(non-numeric data\)/, 327 'Warn about bad \$VERSION'); 328 eval "use lib '.'; use $package 1;"; 329 like ($@, qr/Invalid version format \(non-numeric data\)/, 330 'Warn about bad $VERSION'); 331 } 332 333SKIP: { 334 skip 'Cannot test bare v-strings with Perl < 5.6.0', 4 335 if $] < 5.006_000; 336 $version = $CLASS->$method(1.2.3); 337 ok("$version" eq "v1.2.3", '"$version" eq 1.2.3'); 338 $version = $CLASS->$method(1.0.0); 339 $new_version = $CLASS->$method(1); 340 ok($version == $new_version, '$version == $new_version'); 341 skip "version require'd instead of use'd, cannot test declare", 1 342 unless defined $qv_declare; 343 $version = &$qv_declare(1.2.3); 344 ok("$version" eq "v1.2.3", 'v-string initialized $qv_declare()'); 345 } 346 347SKIP: { 348 skip 'Cannot test bare alpha v-strings with Perl < 5.8.1', 2 349 if $] lt 5.008_001; 350 $version = $CLASS->$method(v1.2.3_4); 351 is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4"'); 352 $version = $CLASS->$method(eval "v1.2.3_4"); 353 is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4" (from eval)'); 354 } 355 356 # trailing zero testing (reported by Andreas Koenig). 357 $version = $CLASS->$method("1"); 358 ok($version->numify eq "1.000", "trailing zeros preserved"); 359 $version = $CLASS->$method("1.0"); 360 ok($version->numify eq "1.000", "trailing zeros preserved"); 361 $version = $CLASS->$method("1.0.0"); 362 ok($version->numify eq "1.000000", "trailing zeros preserved"); 363 $version = $CLASS->$method("1.0.0.0"); 364 ok($version->numify eq "1.000000000", "trailing zeros preserved"); 365 366 # leading zero testing (reported by Andreas Koenig). 367 $version = $CLASS->$method(".7"); 368 ok($version->numify eq "0.700", "leading zero inferred"); 369 370 # leading space testing (reported by Andreas Koenig). 371 $version = $CLASS->$method(" 1.7"); 372 ok($version->numify eq "1.700", "leading space ignored"); 373 374 # RT 19517 - deal with undef and 'undef' initialization 375 ok("$version" ne 'undef', "Undef version comparison #1"); 376 ok("$version" ne undef, "Undef version comparison #2"); 377 $version = $CLASS->$method('undef'); 378 unlike($warning, qr/^Version string 'undef' contains invalid data/, 379 "Version string 'undef'"); 380 381 $version = $CLASS->$method(undef); 382 like($warning, qr/^Use of uninitialized value/, 383 "Version string 'undef'"); 384 ok($version == 'undef', "Undef version comparison #3"); 385 ok($version == undef, "Undef version comparison #4"); 386 eval "\$version = \$CLASS->$method()"; # no parameter at all 387 unlike($@, qr/^Bizarre copy of CODE/, "No initializer at all"); 388 ok($version == 'undef', "Undef version comparison #5"); 389 ok($version == undef, "Undef version comparison #6"); 390 391 $version = $CLASS->$method(0.000001); 392 unlike($warning, qr/^Version string '1e-06' contains invalid data/, 393 "Very small version objects"); 394 } 395 396SKIP: { 397 my $warning; 398 local $SIG{__WARN__} = sub { $warning = $_[0] }; 399 # dummy up a legal module for testing RT#19017 400 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); 401 (my $package = basename($filename)) =~ s/\.pm$//; 402 print $fh <<"EOF"; 403package $package; 404use $CLASS; \$VERSION = ${CLASS}->new('0.0.4'); 4051; 406EOF 407 close $fh; 408 409 eval "use lib '.'; use $package 0.000008;"; 410 like ($@, qr/^$package version 0.000008 required/, 411 "Make sure very small versions don't freak"); 412 eval "use lib '.'; use $package 1;"; 413 like ($@, qr/^$package version 1 required/, 414 "Comparing vs. version with no decimal"); 415 eval "use lib '.'; use $package 1.;"; 416 like ($@, qr/^$package version 1 required/, 417 "Comparing vs. version with decimal only"); 418 if ( $] < 5.006_000 ) { 419 skip 'Cannot "use" extended versions with Perl < 5.6.0', 3; 420 } 421 eval "use lib '.'; use $package v0.0.8;"; 422 my $regex = "^$package version v0.0.8 required"; 423 like ($@, qr/$regex/, "Make sure very small versions don't freak"); 424 425 $regex =~ s/8/4/; # set for second test 426 eval "use lib '.'; use $package v0.0.4;"; 427 unlike($@, qr/$regex/, 'Succeed - required == VERSION'); 428 cmp_ok ( $package->VERSION, 'eq', '0.0.4', 'No undef warnings' ); 429 unlink $filename; 430 } 431 432SKIP: { 433 skip "Cannot test \"use parent $CLASS\" when require is used", 3 434 unless defined $qv_declare; 435 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); 436 (my $package = basename($filename)) =~ s/\.pm$//; 437 print $fh <<"EOF"; 438package $package; 439use parent $CLASS; 4401; 441EOF 442 close $fh; 443 # need to eliminate any other $qv_declare()'s 444 undef *{"main\::$qv_declare"}; 445 ok(!defined(&{"main\::$qv_declare"}), "make sure we cleared $qv_declare() properly"); 446 eval "use lib '.'; use $package qw/declare qv/;"; 447 ok(defined(&{"main\::$qv_declare"}), "make sure we exported $qv_declare() properly"); 448 isa_ok( &$qv_declare(1.2), $package); 449 unlink $filename; 450} 451 452SKIP: { 453 if ( $] < 5.006_000 ) { 454 skip 'Cannot "use" extended versions with Perl < 5.6.0', 3; 455 } 456 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); 457 (my $package = basename($filename)) =~ s/\.pm$//; 458 print $fh <<"EOF"; 459package $package; 460\$VERSION = 1.0; 4611; 462EOF 463 close $fh; 464 eval "use lib '.'; use $package 1.001;"; 465 like ($@, qr/^$package version 1.001 required/, 466 "User typed numeric so we error with numeric"); 467 eval "use lib '.'; use $package v1.1.0;"; 468 like ($@, qr/^$package version v1.1.0 required/, 469 "User typed extended so we error with extended"); 470 unlink $filename; 471 } 472 473 eval 'my $v = $CLASS->$method("1._1");'; 474 unlike($@, qr/^Invalid version format \(alpha with zero width\)/, 475 "Invalid version format 1._1"); 476 477 { 478 my $warning; 479 local $SIG{__WARN__} = sub { $warning = $_[0] }; 480 eval 'my $v = $CLASS->$method(~0);'; 481 unlike($@, qr/Integer overflow in version/, "Too large version"); 482 like($warning, qr/Integer overflow in version/, "Too large version"); 483 } 484 485 { 486 local $Data::Dumper::Sortkeys= 1; 487 # http://rt.cpan.org/Public/Bug/Display.html?id=30004 488 my $v1 = $CLASS->$method("v0.1_1"); 489 (my $alpha1 = Dumper($v1)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms; 490 my $v2 = $CLASS->$method($v1); 491 (my $alpha2 = Dumper($v2)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms; 492 is $alpha2, $alpha1, "Don't fall for Data::Dumper's tricks"; 493 } 494 495 { 496 # http://rt.perl.org/rt3/Ticket/Display.html?id=56606 497 my $badv = bless { version => [1,2,3] }, $CLASS; 498 is $badv, '1.002003', "Deal with badly serialized versions from YAML"; 499 my $badv2 = bless { qv => 1, version => [1,2,3] }, $CLASS; 500 is $badv2, 'v1.2.3', "Deal with badly serialized versions from YAML "; 501 } 502 503 { 504 # https://rt.cpan.org/Public/Bug/Display.html?id=70950 505 # test indirect usage of version objects 506 my $sum = 0; 507 eval '$sum += $CLASS->$method("v2.0.0")'; 508 like $@, qr/operation not supported with version object/, 509 'No math operations with version objects'; 510 # test direct usage of version objects 511 my $v = $CLASS->$method("v2.0.0"); 512 eval '$v += 1'; 513 like $@, qr/operation not supported with version object/, 514 'No math operations with version objects'; 515 } 516 517 { 518 # https://rt.cpan.org/Ticket/Display.html?id=72365 519 # https://rt.perl.org/rt3/Ticket/Display.html?id=102586 520 # https://rt.cpan.org/Ticket/Display.html?id=78328 521 eval 'my $v = $CLASS->$method("version")'; 522 like $@, qr/Invalid version format/, 523 "The string 'version' is not a version for $method"; 524 eval 'my $v = $CLASS->$method("ver510n")'; 525 like $@, qr/Invalid version format/, 526 'All strings starting with "v" are not versions'; 527 } 528 529SKIP: { 530 if ( $] < 5.006_000 ) { 531 skip 'No v-string support at all < 5.6.0', 2; 532 } 533 # https://rt.cpan.org/Ticket/Display.html?id=49348 534 my $v = $CLASS->$method("420"); 535 is "$v", "420", 'Correctly guesses this is not a v-string'; 536 $v = $CLASS->$method(4.2.0); 537 is "$v", 'v4.2.0', 'Correctly guess that this is a v-string'; 538 } 539SKIP: { 540 if ( $] < 5.006_000 ) { 541 skip 'No v-string support at all < 5.6.0', 4; 542 } 543 # https://rt.cpan.org/Ticket/Display.html?id=50347 544 # Check that the qv() implementation does not change 545 546 ok $CLASS->$method(1.2.3) < $CLASS->$method(1.2.3.1), 'Compare 3 and 4 digit v-strings' ; 547 ok $CLASS->$method(v1.2.3) < $CLASS->$method(v1.2.3.1), 'Compare 3 and 4 digit v-strings, leaving v'; 548 ok $CLASS->$method("1.2.3") < $CLASS->$method("1.2.3.1"), 'Compare 3 and 4 digit v-strings, quoted'; 549 ok $CLASS->$method("v1.2.3") < $CLASS->$method("v1.2.3.1"), 'Compare 3 and 4 digit v-strings, quoted leading v'; 550 } 551 552 { 553 eval '$CLASS->$method("version")'; 554 pass("no crash with ${CLASS}->${method}('version')"); 555 { 556 package _102586; 557 sub TIESCALAR { bless [] } 558 sub FETCH { "version" } 559 sub STORE { } 560 my $v; 561 tie $v, __PACKAGE__; 562 $v = $CLASS->$method(1); 563 eval '$CLASS->$method($v)'; 564 } 565 pass('no crash with version->new($tied) where $tied returns "version"'); 566 } 567 568 { # [perl #112478] 569 $_112478::VERSION = 9e99; 570 ok eval { _112478->VERSION(9e99); 1 }, '->VERSION(9e99) succeeds' 571 or diag $@; 572 $_112478::VERSION = 1; 573 eval { _112478->VERSION(9e99) }; 574 unlike $@, qr/panic/, '->VERSION(9e99) does not panic'; 575 } 576 577 { # https://rt.cpan.org/Ticket/Display.html?id=79259 578 my $v = $CLASS->new("0.52_0"); 579 ok $v->is_alpha, 'Just checking'; 580 is $v->numify, '0.520', 'Correctly nummified'; 581 } 582 583 { # https://rt.cpan.org/Ticket/Display.html?id=88495 584 @ver::ISA = $CLASS; 585 is ref(ver->new), 'ver', 'ver can inherit from version'; 586 is ref(ver->qv("1.2.3")), 'ver', 'ver can inherit from version'; 587 } 588 589 { # discovered while integrating with bleadperl 590 eval {my $v = $CLASS->new([1,2,3]) }; 591 like $@, qr/Invalid version format/, 'Do not crash for garbage'; 592 eval {my $v = $CLASS->new({1 => 2}) }; 593 like $@, qr/Invalid version format/, 'Do not crash for garbage'; 594 } 595 596} 597 5981; 599 600