cpan/version/t/coretests.pm

   1 #! /usr/local/perl -w
   2 package main;
   3 require Test::Harness;
   4 use Data::Dumper;
   5 use File::Temp qw/tempfile/;
   6 use File::Basename;
   7
   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     };
  16 }
  17
  18 sub 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 quoted number processing
  34     $version = $CLASS->$method("5.005_03");
  35     is ( "$version" , "5.005_03" , '"5.005_03" eq "5.005_03"' );
  36     $version = $CLASS->$method("v1.23");
  37     is ( "$version" , "v1.23" , '"v1.23" eq "v1.23"' );
  38
  39     # Test stringify operator
  40     $version = $CLASS->$method("5.005");
  41     is ( "$version" , "5.005" , '5.005 eq "5.005"' );
  42     $version = $CLASS->$method("5.006.001");
  43     is ( "$version" , "5.006.001" , '5.006.001 eq v5.6.1' );
  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' );
  47
  48     # test illegal formats
  49     eval {my $version = $CLASS->$method("1.2_3_4")};
  50     like($@, qr/multiple underscores/,
  51         "Invalid version format (multiple underscores)");
  52
  53     eval {my $version = $CLASS->$method("1.2_3.4")};
  54     like($@, qr/underscores before decimal/,
  55         "Invalid version format (underscores before decimal)");
  56
  57     eval {my $version = $CLASS->$method("1_2")};
  58     like($@, qr/alpha without decimal/,
  59         "Invalid version format (alpha without decimal)");
  60
  61     eval { $version = $CLASS->$method("1.2b3")};
  62     like($@, qr/non-numeric data/,
  63         "Invalid version format (non-numeric data)");
  64
  65     eval { $version = $CLASS->$method("-1.23")};
  66     like($@, qr/negative version number/,
  67         "Invalid version format (negative version number)");
  68
  69     # from here on out capture the warning and test independently
  70     {
  71     eval{$version = $CLASS->$method("99 and 44/100 pure")};
  72
  73     like($@, qr/non-numeric data/,
  74         "Invalid version format (non-numeric data)");
  75
  76     eval{$version = $CLASS->$method("something")};
  77     like($@, qr/non-numeric data/,
  78         "Invalid version format (non-numeric data)");
  79
  80     # reset the test object to something reasonable
  81     $version = $CLASS->$method("1.2.3");
  82
  83     # Test boolean operator
  84     ok ($version, 'boolean');
  85
  86     # Test class membership
  87     isa_ok ( $version, $CLASS );
  88
  89     # Test comparison operators with self
  90     is ( $version <=> $version, 0, '$version <=> $version == 0' );
  91     ok ( $version == $version, '$version == $version' );
  92
  93     # Test Numeric Comparison operators
  94     # test first with non-object
  95     $version = $CLASS->$method("5.006.001");
  96     $new_version = "5.8.0";
  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' );
 101
 102     # now test with existing object
 103     $new_version = $CLASS->$method($new_version);
 104     ok ( $version < $new_version, '$version < $new_version' );
 105     ok ( $new_version > $version, '$new_version > $version' );
 106     ok ( $version != $new_version, '$version != $new_version' );
 107
 108     # now test with actual numbers
 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' );
 113
 114     # test with long decimals
 115     $version = $CLASS->$method(1.002003);
 116     ok ( $version == "1.2.3", '$version == "1.2.3"');
 117     ok ( $version->numify == 1.002003, '$version->numify == 1.002003');
 118     $version = $CLASS->$method("2002.09.30.1");
 119     ok ( $version == "2002.9.30.1",'$version == 2002.9.30.1');
 120     ok ( $version->numify == 2002.009030001,
 121         '$version->numify == 2002.009030001');
 122
 123     # now test with alpha version form with string
 124     $version = $CLASS->$method("1.2.3");
 125     $new_version = "1.2.3_4";
 126     ok ( $version < $new_version, '$version < $new_version' );
 127     ok ( $new_version > $version, '$new_version > $version' );
 128     ok ( $version != $new_version, '$version != $new_version' );
 129
 130     $version = $CLASS->$method("1.2.4");
 131     ok ( $version > $new_version, '$version > $new_version' );
 132     ok ( $new_version < $version, '$new_version < $version' );
 133     ok ( $version != $new_version, '$version != $new_version' );
 134
 135     # now test with alpha version form with object
 136     $version = $CLASS->$method("1.2.3");
 137     $new_version = $CLASS->$method("1.2.3_4");
 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');
 143
 144     $version = $CLASS->$method("1.2.4");
 145     ok ( $version > $new_version, '$version > $new_version' );
 146     ok ( $new_version < $version, '$new_version < $version' );
 147     ok ( $version != $new_version, '$version != $new_version' );
 148
 149     $version = $CLASS->$method("1.2.3.4");
 150     $new_version = $CLASS->$method("1.2.3_4");
 151     ok ( $version > $new_version, '$version > $new_version' );
 152     ok ( $new_version < $version, '$new_version < $version' );
 153     ok ( $version != $new_version, '$version != $new_version' );
 154
 155     $version = $CLASS->$method("v1.2.3");
 156     $new_version = $CLASS->$method("1.2.3.0");
 157     ok ( $version == $new_version, '$version == $new_version' );
 158     $new_version = $CLASS->$method("1.2.3_0");
 159     ok ( $version == $new_version, '$version == $new_version' );
 160     $new_version = $CLASS->$method("1.2.3.1");
 161     ok ( $version < $new_version, '$version < $new_version' );
 162     $new_version = $CLASS->$method("1.2.3_1");
 163     ok ( $version < $new_version, '$version < $new_version' );
 164     $new_version = $CLASS->$method("1.1.999");
 165     ok ( $version > $new_version, '$version > $new_version' );
 166
 167     $version = $CLASS->$method("v1.2.3");
 168     eval { () = $version < 'version' };
 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'";
 173
 174     # that which is not expressly permitted is forbidden
 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" );
 180
 181 SKIP: {
 182     skip "version require'd instead of use'd, cannot test $qv_declare", 3
 183         unless defined $qv_declare;
 184     # test the $qv_declare() sub
 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 );
 190 }
 191
 192     # test creation from existing version object
 193     ok (eval {$new_version = $CLASS->$method($version)},
 194             "new from existing object");
 195     ok ($new_version == $version, "class->$method($version) identical");
 196     $new_version = $version->$method(0);
 197     isa_ok ($new_version, $CLASS );
 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');
 201
 202     # test the CVS revision mode
 203     $version = new $CLASS qw$Revision: 1.2$;
 204     ok ( $version == "1.2.0", 'qw$Revision: 1.2$ == 1.2.0' );
 205     $version = new $CLASS qw$Revision: 1.2.3.4$;
 206     ok ( $version == "1.2.3.4", 'qw$Revision: 1.2.3.4$ == 1.2.3.4' );
 207
 208     # test the CPAN style reduced significant digit form
 209     $version = $CLASS->$method("1.23_01");
 210     is ( "$version" , "1.23_01", "CPAN-style alpha version" );
 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
 215
 216     my $error_regex = $] < 5.006
 217         ? 'version \d required'
 218         : 'does not define \$t.{7}::VERSION';
 219
 220     {
 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;
 225
 226         $version = 0.58;
 227         eval "use lib '.'; use $package $version";
 228         unlike($@, qr/$package version $version/,
 229                 'Replacement eval works with exact version');
 230
 231         # test as class method
 232         $new_version = $package->VERSION;
 233         cmp_ok($new_version,'==',$version, "Called as class method");
 234
 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
 246         $version += 0.01;
 247         eval "use lib '.'; use $package $version";
 248         like($@, qr/$package version $version/,
 249                 'Replacement eval works with incremented version');
 250
 251         $version =~ s/0+$//; #convert to string and remove trailing 0's
 252         chop($version); # shorten by 1 digit, should still succeed
 253         eval "use lib '.'; use $package $version";
 254         unlike($@, qr/$package version $version/,
 255                 'Replacement eval works with single digit');
 256
 257         # this would fail with old UNIVERSAL::VERSION
 258         $version += 0.1;
 259         eval "use lib '.'; use $package $version";
 260         like($@, qr/$package version $version/,
 261                 'Replacement eval works with incremented digit');
 262         unlink $filename;
 263     }
 264
 265     { # dummy up some variously broken modules for testing
 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;
 270
 271         eval "use lib '.'; use $package 3;";
 272         if ( $] < 5.008 ) {
 273             like($@, qr/$error_regex/,
 274                 'Replacement handles modules without package or VERSION');
 275         }
 276         else {
 277             like($@, qr/defines neither package nor VERSION/,
 278                 'Replacement handles modules without package or VERSION');
 279         }
 280         eval "use lib '.'; use $package; \$version = $package->VERSION";
 281         unlike ($@, qr/$error_regex/,
 282             'Replacement handles modules without package or VERSION');
 283         ok (!defined($version), "Called as class method");
 284         unlink $filename;
 285     }
 286
 287     { # dummy up some variously broken modules for testing
 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;";
 293         like ($@, qr/$error_regex/,
 294             'Replacement handles modules without VERSION');
 295         eval "use lib '.'; use $package; print $package->VERSION";
 296         unlike ($@, qr/$error_regex/,
 297             'Replacement handles modules without VERSION');
 298         unlink $filename;
 299     }
 300
 301     { # dummy up some variously broken modules for testing
 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;";
 307         like ($@, qr/$error_regex/,
 308             'Replacement handles modules without VERSION');
 309         eval "use lib '.'; use $package; print $package->VERSION";
 310         unlike ($@, qr/$error_regex/,
 311             'Replacement handles modules without VERSION');
 312         unlink $filename;
 313     }
 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;
 321         eval "use lib '.'; use $package; print $package->VERSION";
 322         like ($@, qr/Invalid version format \(non-numeric data\)/,
 323             'Warn about bad \$VERSION');
 324         eval "use lib '.'; use $package 1;";
 325         like ($@, qr/Invalid version format \(non-numeric data\)/,
 326             'Warn about bad $VERSION');
 327     }
 328
 329 SKIP:   {
 330         skip 'Cannot test bare v-strings with Perl < 5.6.0', 4
 331                 if $] < 5.006_000;
 332         $version = $CLASS->$method(1.2.3);
 333         ok("$version" eq "v1.2.3", '"$version" eq 1.2.3');
 334         $version = $CLASS->$method(1.0.0);
 335         $new_version = $CLASS->$method(1);
 336         ok($version == $new_version, '$version == $new_version');
 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);
 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
 345                 if $] lt 5.008_001;
 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)');
 350     }
 351
 352     # trailing zero testing (reported by Andreas Koenig).
 353     $version = $CLASS->$method("1");
 354     ok($version->numify eq "1.000", "trailing zeros preserved");
 355     $version = $CLASS->$method("1.0");
 356     ok($version->numify eq "1.000", "trailing zeros preserved");
 357     $version = $CLASS->$method("1.0.0");
 358     ok($version->numify eq "1.000000", "trailing zeros preserved");
 359     $version = $CLASS->$method("1.0.0.0");
 360     ok($version->numify eq "1.000000000", "trailing zeros preserved");
 361
 362     # leading zero testing (reported by Andreas Koenig).
 363     $version = $CLASS->$method(".7");
 364     ok($version->numify eq "0.700", "leading zero inferred");
 365
 366     # leading space testing (reported by Andreas Koenig).
 367     $version = $CLASS->$method(" 1.7");
 368     ok($version->numify eq "1.700", "leading space ignored");
 369
 370     # RT 19517 - deal with undef and 'undef' initialization
 371     ok("$version" ne 'undef', "Undef version comparison #1");
 372     ok("$version" ne undef, "Undef version comparison #2");
 373     $version = $CLASS->$method('undef');
 374     unlike($warning, qr/^Version string 'undef' contains invalid data/,
 375         "Version string 'undef'");
 376
 377     $version = $CLASS->$method(undef);
 378     like($warning, qr/^Use of uninitialized value/,
 379         "Version string 'undef'");
 380     ok($version == 'undef', "Undef version comparison #3");
 381     ok($version ==  undef,  "Undef version comparison #4");
 382     eval "\$version = \$CLASS->$method()"; # no parameter at all
 383     unlike($@, qr/^Bizarre copy of CODE/, "No initializer at all");
 384     ok($version == 'undef', "Undef version comparison #5");
 385     ok($version ==  undef,  "Undef version comparison #6");
 386
 387     $version = $CLASS->$method(0.000001);
 388     unlike($warning, qr/^Version string '1e-06' contains invalid data/,
 389         "Very small version objects");
 390     }
 391
 392 SKIP: {
 393         my $warning;
 394         local $SIG{__WARN__} = sub { $warning = $_[0] };
 395         # dummy up a legal module for testing RT#19017
 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');
 401 1;
 402 EOF
 403         close $fh;
 404
 405         eval "use lib '.'; use $package 0.000008;";
 406         like ($@, qr/^$package version 0.000008 required/,
 407             "Make sure very small versions don't freak");
 408         eval "use lib '.'; use $package 1;";
 409         like ($@, qr/^$package version 1 required/,
 410             "Comparing vs. version with no decimal");
 411         eval "use lib '.'; use $package 1.;";
 412         like ($@, qr/^$package version 1 required/,
 413             "Comparing vs. version with decimal only");
 414         if ( $] < 5.006_000 ) {
 415             skip 'Cannot "use" extended versions with Perl < 5.6.0', 3;
 416         }
 417         eval "use lib '.'; use $package v0.0.8;";
 418         my $regex = "^$package version v0.0.8 required";
 419         like ($@, qr/$regex/, "Make sure very small versions don't freak");
 420
 421         $regex =~ s/8/4/; # set for second test
 422         eval "use lib '.'; use $package v0.0.4;";
 423         unlike($@, qr/$regex/, 'Succeed - required == VERSION');
 424         cmp_ok ( $package->VERSION, 'eq', '0.0.4', 'No undef warnings' );
 425         unlink $filename;
 426     }
 427
 428 SKIP: {
 429     skip "Cannot test \"use parent $CLASS\"  when require is used", 3
 430         unless defined $qv_declare;
 431     my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
 432     (my $package = basename($filename)) =~ s/\.pm$//;
 433     print $fh <<"EOF";
 434 package $package;
 435 use parent $CLASS;
 436 1;
 437 EOF
 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 }
 447
 448 SKIP: {
 449         if ( $] < 5.006_000 ) {
 450             skip 'Cannot "use" extended versions with Perl < 5.6.0', 3;
 451         }
 452         my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
 453         (my $package = basename($filename)) =~ s/\.pm$//;
 454         print $fh <<"EOF";
 455 package $package;
 456 \$VERSION = 1.0;
 457 1;
 458 EOF
 459         close $fh;
 460         eval "use lib '.'; use $package 1.001;";
 461         like ($@, qr/^$package version 1.001 required/,
 462             "User typed numeric so we error with numeric");
 463         eval "use lib '.'; use $package v1.1.0;";
 464         like ($@, qr/^$package version v1.1.0 required/,
 465             "User typed extended so we error with extended");
 466         unlink $filename;
 467     }
 468
 469     eval 'my $v = $CLASS->$method("1._1");';
 470     unlike($@, qr/^Invalid version format \(alpha with zero width\)/,
 471         "Invalid version format 1._1");
 472
 473     {
 474         my $warning;
 475         local $SIG{__WARN__} = sub { $warning = $_[0] };
 476         eval 'my $v = $CLASS->$method(~0);';
 477         unlike($@, qr/Integer overflow in version/, "Too large version");
 478         like($warning, qr/Integer overflow in version/, "Too large version");
 479     }
 480
 481     {
 482         local $Data::Dumper::Sortkeys= 1;
 483         # http://rt.cpan.org/Public/Bug/Display.html?id=30004
 484         my $v1 = $CLASS->$method("v0.1_1");
 485         (my $alpha1 = Dumper($v1)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
 486         my $v2 = $CLASS->$method($v1);
 487         (my $alpha2 = Dumper($v2)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
 488         is $alpha2, $alpha1, "Don't fall for Data::Dumper's tricks";
 489     }
 490
 491     {
 492         # http://rt.perl.org/rt3/Ticket/Display.html?id=56606
 493         my $badv = bless { version => [1,2,3] }, $CLASS;
 494         is $badv, '1.002003', "Deal with badly serialized versions from YAML";
 495         my $badv2 = bless { qv => 1, version => [1,2,3] }, $CLASS;
 496         is $badv2, 'v1.2.3', "Deal with badly serialized versions from YAML ";
 497     }
 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
 516         # https://rt.cpan.org/Ticket/Display.html?id=78328
 517         eval 'my $v = $CLASS->$method("version")';
 518         like $@, qr/Invalid version format/,
 519             "The string 'version' is not a version for $method";
 520         eval 'my $v = $CLASS->$method("ver510n")';
 521         like $@, qr/Invalid version format/,
 522             'All strings starting with "v" are not versions';
 523     }
 524
 525 SKIP: {
 526         if ( $] < 5.006_000 ) {
 527             skip 'No v-string support at all < 5.6.0', 2;
 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 ) {
 537             skip 'No v-string support at all < 5.6.0', 4;
 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     }
 547
 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     }
 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) };
 570         unlike $@, qr/panic/, '->VERSION(9e99) does not panic';
 571     }
 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
 579     { # https://rt.cpan.org/Ticket/Display.html?id=88495
 580         @ver::ISA = $CLASS;
 581         is ref(ver->new), 'ver', 'ver can inherit from version';
 582         is ref(ver->qv("1.2.3")), 'ver', 'ver can inherit from version';
 583     }
 584
 585 }
 586
 587 1;
 588