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