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