This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Sync up tests with upstream version.pm
[perl5.git] / lib / version.t
CommitLineData
129318bd 1#! /usr/local/perl -w
a7ad731c 2
34ba6322 3use Test::More qw(no_plan);
72287d96 4use Data::Dumper;
c8a14fb6
RGS
5require Test::Harness;
6no warnings 'once';
7*Verbose = \$Test::Harness::Verbose;
f941e658
JP
8use POSIX qw/locale_h/;
9use File::Temp qw/tempfile/;
10use File::Basename;
a7ad731c 11
5eb567df 12BEGIN {
f941e658
JP
13 use_ok("version", 0.77);
14 # If we made it this far, we are ok.
5eb567df
RGS
15}
16
f941e658
JP
17my $Verbose;
18
19diag "Tests with base class" unless $ENV{PERL_CORE};
137d6fc0 20
f941e658
JP
21BaseTests("version","new","qv");
22BaseTests("version","new","declare");
23BaseTests("version","parse", "qv");
24BaseTests("version","parse", "declare");
137d6fc0 25
98dc9551 26# dummy up a redundant call to satisfy David Wheeler
f941e658
JP
27local $SIG{__WARN__} = sub { die $_[0] };
28eval 'use version;';
29unlike ($@, qr/^Subroutine main::declare redefined/,
30 "Only export declare once per package (to prevent redefined warnings).");
137d6fc0 31
e0218a61 32package version::Bad;
f941e658 33use base 'version';
e0218a61
JP
34sub new { my($self,$n)=@_; bless \$n, $self }
35
137d6fc0 36package main;
f941e658
JP
37
38my $warning;
39local $SIG{__WARN__} = sub { $warning = $_[0] };
40my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
41(my $package = basename($filename)) =~ s/\.pm$//;
42print $fh <<"EOF";
43# This is an empty subclass
44package $package;
45use base 'version';
46use vars '\$VERSION';
47\$VERSION=0.001;
48EOF
49close $fh;
50
51sub main_reset {
52 delete $main::INC{'$package'};
53 undef &qv; undef *::qv; # avoid 'used once' warning
54 undef &declare; undef *::declare; # avoid 'used once' warning
55}
56
57diag "Tests with empty derived class" unless $ENV{PERL_CORE};
58
59use_ok($package, 0.001);
60my $testobj = $package->new(1.002_003);
61isa_ok( $testobj, $package );
137d6fc0 62ok( $testobj->numify == 1.002003, "Numified correctly" );
9137345a
JP
63ok( $testobj->stringify eq "1.002003", "Stringified correctly" );
64ok( $testobj->normal eq "v1.2.3", "Normalified correctly" );
137d6fc0 65
f941e658 66my $verobj = version::->new("1.2.4");
137d6fc0 67ok( $verobj > $testobj, "Comparison vs parent class" );
137d6fc0 68
f941e658
JP
69BaseTests($package, "new", "qv");
70main_reset;
71use_ok($package, 0.001, "declare");
72BaseTests($package, "new", "declare");
73main_reset;
74use_ok($package, 0.001);
75BaseTests($package, "parse", "qv");
76main_reset;
77use_ok($package, 0.001, "declare");
78BaseTests($package, "parse", "declare");
79
80diag "tests with bad subclass" unless $ENV{PERL_CORE};
e0218a61
JP
81$testobj = version::Bad->new(1.002_003);
82isa_ok( $testobj, "version::Bad" );
83eval { my $string = $testobj->numify };
84like($@, qr/Invalid version object/,
85 "Bad subclass numify");
86eval { my $string = $testobj->normal };
87like($@, qr/Invalid version object/,
88 "Bad subclass normal");
89eval { my $string = $testobj->stringify };
90like($@, qr/Invalid version object/,
91 "Bad subclass stringify");
f941e658 92eval { my $test = ($testobj > 1.0) };
e0218a61
JP
93like($@, qr/Invalid version object/,
94 "Bad subclass vcmp");
5de8bffd
DG
95
96# Invalid structure
97eval { $a = \\version->new(1); bless $a, "version"; print "# $a\n" };
98like($@, qr/Invalid version object/,
99 "Bad internal structure (RT#78286)");
9b463b21
DG
100
101# do strict lax tests in a sub to isolate a package to test importing
5de8bffd
DG
102strict_lax_tests();
103
9b463b21
DG
104sub strict_lax_tests {
105 package temp12345;
106 # copied from perl core test t/op/packagev.t
107 # format: STRING STRICT_OK LAX_OK
108 my $strict_lax_data = << 'CASE_DATA';
1091.00 pass pass
1101.00001 pass pass
1110.123 pass pass
11212.345 pass pass
11342 pass pass
1140 pass pass
1150.0 pass pass
116v1.2.3 pass pass
117v1.2.3.4 pass pass
118v0.1.2 pass pass
119v0.0.0 pass pass
12001 fail pass
12101.0203 fail pass
122v01 fail pass
123v01.02.03 fail pass
124.1 fail pass
125.1.2 fail pass
1261. fail pass
1271.a fail fail
1281._ fail fail
1291.02_03 fail pass
130v1.2_3 fail pass
131v1.02_03 fail pass
132v1.2_3_4 fail fail
133v1.2_3.4 fail fail
1341.2_3.4 fail fail
1350_ fail fail
1361_ fail fail
1371_. fail fail
1381.1_ fail fail
1391.02_03_04 fail fail
1401.2.3 fail pass
141v1.2 fail pass
142v0 fail pass
143v1 fail pass
144v.1.2.3 fail fail
145v fail fail
146v1.2345.6 fail pass
147undef fail pass
1481a fail fail
1491.2a3 fail fail
150bar fail fail
151_ fail fail
152CASE_DATA
153
154 require version;
155 version->import( qw/is_strict is_lax/ );
156 for my $case ( split qr/\n/, $strict_lax_data ) {
157 my ($v, $strict, $lax) = split qr/\t+/, $case;
158 main::ok( $strict eq 'pass' ? is_strict($v) : ! is_strict($v), "is_strict($v) [$strict]" );
159 main::ok( $strict eq 'pass' ? version::is_strict($v) : ! version::is_strict($v), "version::is_strict($v) [$strict]" );
160 main::ok( $lax eq 'pass' ? is_lax($v) : ! is_lax($v), "is_lax($v) [$lax]" );
161 main::ok( $lax eq 'pass' ? version::is_lax($v) : ! version::is_lax($v), "version::is_lax($v) [$lax]" );
162 }
163}
e0218a61 164
137d6fc0
JP
165sub BaseTests {
166
f941e658 167 my ($CLASS, $method, $qv_declare) = @_;
692a467c
JP
168 my $warning;
169 local $SIG{__WARN__} = sub { $warning = $_[0] };
317f7c8a
RGS
170
171 # Insert your test code below, the Test module is use()ed here so read
172 # its man page ( perldoc Test ) for help writing this test script.
173
174 # Test bare number processing
f941e658
JP
175 diag "tests with bare numbers" unless $ENV{PERL_CORE};
176 $version = $CLASS->$method(5.005_03);
8cb289bd 177 is ( "$version" , "5.00503" , '5.005_03 eq 5.00503' );
f941e658 178 $version = $CLASS->$method(1.23);
8cb289bd 179 is ( "$version" , "1.23" , '1.23 eq "1.23"' );
317f7c8a
RGS
180
181 # Test quoted number processing
f941e658
JP
182 diag "tests with quoted numbers" unless $ENV{PERL_CORE};
183 $version = $CLASS->$method("5.005_03");
8cb289bd 184 is ( "$version" , "5.005_03" , '"5.005_03" eq "5.005_03"' );
f941e658 185 $version = $CLASS->$method("v1.23");
8cb289bd 186 is ( "$version" , "v1.23" , '"v1.23" eq "v1.23"' );
317f7c8a
RGS
187
188 # Test stringify operator
f941e658
JP
189 diag "tests with stringify" unless $ENV{PERL_CORE};
190 $version = $CLASS->$method("5.005");
317f7c8a 191 is ( "$version" , "5.005" , '5.005 eq "5.005"' );
f941e658 192 $version = $CLASS->$method("5.006.001");
8cb289bd 193 is ( "$version" , "5.006.001" , '5.006.001 eq v5.6.1' );
692a467c
JP
194 unlike ($warning, qr/v-string without leading 'v' deprecated/, 'No leading v');
195 $version = $CLASS->$method("v1.2.3_4");
196 is ( "$version" , "v1.2.3_4" , 'alpha version 1.2.3_4 eq v1.2.3_4' );
317f7c8a
RGS
197
198 # test illegal formats
f941e658 199 diag "test illegal formats" unless $ENV{PERL_CORE};
d54f8cf7 200 eval {my $version = $CLASS->$method("1.2_3_4")};
317f7c8a
RGS
201 like($@, qr/multiple underscores/,
202 "Invalid version format (multiple underscores)");
203
d54f8cf7 204 eval {my $version = $CLASS->$method("1.2_3.4")};
317f7c8a
RGS
205 like($@, qr/underscores before decimal/,
206 "Invalid version format (underscores before decimal)");
207
d54f8cf7 208 eval {my $version = $CLASS->$method("1_2")};
317f7c8a
RGS
209 like($@, qr/alpha without decimal/,
210 "Invalid version format (alpha without decimal)");
211
91152fc1
DG
212 eval { $version = $CLASS->$method("1.2b3")};
213 like($@, qr/non-numeric data/,
214 "Invalid version format (non-numeric data)");
317f7c8a 215
c8c8e589
JP
216 eval { $version = $CLASS->$method("-1.23")};
217 like($@, qr/negative version number/,
218 "Invalid version format (negative version number)");
219
317f7c8a 220 # from here on out capture the warning and test independently
f34c6aaf 221 {
91152fc1 222 eval{$version = $CLASS->$method("99 and 44/100 pure")};
317f7c8a 223
91152fc1
DG
224 like($@, qr/non-numeric data/,
225 "Invalid version format (non-numeric data)");
317f7c8a 226
91152fc1
DG
227 eval{$version = $CLASS->$method("something")};
228 like($@, qr/non-numeric data/,
229 "Invalid version format (non-numeric data)");
317f7c8a
RGS
230
231 # reset the test object to something reasonable
f941e658 232 $version = $CLASS->$method("1.2.3");
317f7c8a
RGS
233
234 # Test boolean operator
235 ok ($version, 'boolean');
236
237 # Test class membership
238 isa_ok ( $version, $CLASS );
239
240 # Test comparison operators with self
f941e658 241 diag "tests with self" unless $ENV{PERL_CORE};
8cb289bd 242 is ( $version <=> $version, 0, '$version <=> $version == 0' );
317f7c8a
RGS
243 ok ( $version == $version, '$version == $version' );
244
317f7c8a
RGS
245 # Test Numeric Comparison operators
246 # test first with non-object
f941e658 247 $version = $CLASS->$method("5.006.001");
317f7c8a 248 $new_version = "5.8.0";
f941e658 249 diag "numeric tests with non-objects" unless $ENV{PERL_CORE};
317f7c8a
RGS
250 ok ( $version == $version, '$version == $version' );
251 ok ( $version < $new_version, '$version < $new_version' );
252 ok ( $new_version > $version, '$new_version > $version' );
253 ok ( $version != $new_version, '$version != $new_version' );
254
255 # now test with existing object
f941e658
JP
256 $new_version = $CLASS->$method($new_version);
257 diag "numeric tests with objects" unless $ENV{PERL_CORE};
317f7c8a
RGS
258 ok ( $version < $new_version, '$version < $new_version' );
259 ok ( $new_version > $version, '$new_version > $version' );
260 ok ( $version != $new_version, '$version != $new_version' );
261
262 # now test with actual numbers
f941e658 263 diag "numeric tests with numbers" unless $ENV{PERL_CORE};
317f7c8a
RGS
264 ok ( $version->numify() == 5.006001, '$version->numify() == 5.006001' );
265 ok ( $version->numify() <= 5.006001, '$version->numify() <= 5.006001' );
266 ok ( $version->numify() < 5.008, '$version->numify() < 5.008' );
267 #ok ( $version->numify() > v5.005_02, '$version->numify() > 5.005_02' );
268
269 # test with long decimals
f941e658
JP
270 diag "Tests with extended decimal versions" unless $ENV{PERL_CORE};
271 $version = $CLASS->$method(1.002003);
8cb289bd 272 ok ( $version == "1.2.3", '$version == "1.2.3"');
317f7c8a 273 ok ( $version->numify == 1.002003, '$version->numify == 1.002003');
f941e658 274 $version = $CLASS->$method("2002.09.30.1");
8cb289bd 275 ok ( $version == "2002.9.30.1",'$version == 2002.9.30.1');
317f7c8a
RGS
276 ok ( $version->numify == 2002.009030001,
277 '$version->numify == 2002.009030001');
278
279 # now test with alpha version form with string
f941e658 280 $version = $CLASS->$method("1.2.3");
317f7c8a 281 $new_version = "1.2.3_4";
f941e658 282 diag "numeric tests with alpha-style non-objects" unless $ENV{PERL_CORE};
8cb289bd
RGS
283 ok ( $version < $new_version, '$version < $new_version' );
284 ok ( $new_version > $version, '$new_version > $version' );
285 ok ( $version != $new_version, '$version != $new_version' );
317f7c8a 286
f941e658 287 $version = $CLASS->$method("1.2.4");
317f7c8a 288 diag "numeric tests with alpha-style non-objects"
692a467c 289 unless $ENV{PERL_CORE};
317f7c8a
RGS
290 ok ( $version > $new_version, '$version > $new_version' );
291 ok ( $new_version < $version, '$new_version < $version' );
292 ok ( $version != $new_version, '$version != $new_version' );
293
294 # now test with alpha version form with object
f941e658
JP
295 $version = $CLASS->$method("1.2.3");
296 $new_version = $CLASS->$method("1.2.3_4");
297 diag "tests with alpha-style objects" unless $ENV{PERL_CORE};
317f7c8a
RGS
298 ok ( $version < $new_version, '$version < $new_version' );
299 ok ( $new_version > $version, '$new_version > $version' );
300 ok ( $version != $new_version, '$version != $new_version' );
301 ok ( !$version->is_alpha, '!$version->is_alpha');
302 ok ( $new_version->is_alpha, '$new_version->is_alpha');
303
f941e658
JP
304 $version = $CLASS->$method("1.2.4");
305 diag "tests with alpha-style objects" unless $ENV{PERL_CORE};
317f7c8a
RGS
306 ok ( $version > $new_version, '$version > $new_version' );
307 ok ( $new_version < $version, '$new_version < $version' );
308 ok ( $version != $new_version, '$version != $new_version' );
309
f941e658
JP
310 $version = $CLASS->$method("1.2.3.4");
311 $new_version = $CLASS->$method("1.2.3_4");
317f7c8a 312 diag "tests with alpha-style objects with same subversion"
692a467c 313 unless $ENV{PERL_CORE};
317f7c8a
RGS
314 ok ( $version > $new_version, '$version > $new_version' );
315 ok ( $new_version < $version, '$new_version < $version' );
316 ok ( $version != $new_version, '$version != $new_version' );
317
f941e658
JP
318 diag "test implicit [in]equality" unless $ENV{PERL_CORE};
319 $version = $CLASS->$method("v1.2.3");
320 $new_version = $CLASS->$method("1.2.3.0");
317f7c8a 321 ok ( $version == $new_version, '$version == $new_version' );
f941e658 322 $new_version = $CLASS->$method("1.2.3_0");
317f7c8a 323 ok ( $version == $new_version, '$version == $new_version' );
f941e658 324 $new_version = $CLASS->$method("1.2.3.1");
317f7c8a 325 ok ( $version < $new_version, '$version < $new_version' );
f941e658 326 $new_version = $CLASS->$method("1.2.3_1");
317f7c8a 327 ok ( $version < $new_version, '$version < $new_version' );
f941e658 328 $new_version = $CLASS->$method("1.1.999");
317f7c8a
RGS
329 ok ( $version > $new_version, '$version > $new_version' );
330
e7b3543f
FC
331 diag "test with version class names" unless $ENV{PERL_CORE};
332 $version = $CLASS->$method("v1.2.3");
e935c5db 333 eval { () = $version < $CLASS };
e7b3543f
FC
334 like $@, qr/^Invalid version format/, "error with $version < $CLASS";
335
317f7c8a 336 # that which is not expressly permitted is forbidden
f941e658 337 diag "forbidden operations" unless $ENV{PERL_CORE};
317f7c8a
RGS
338 ok ( !eval { ++$version }, "noop ++" );
339 ok ( !eval { --$version }, "noop --" );
340 ok ( !eval { $version/1 }, "noop /" );
341 ok ( !eval { $version*3 }, "noop *" );
342 ok ( !eval { abs($version) }, "noop abs" );
137d6fc0 343
c8a14fb6 344SKIP: {
f941e658
JP
345 skip "version require'd instead of use'd, cannot test $qv_declare", 3
346 unless defined $qv_declare;
347 # test the $qv_declare() sub
348 diag "testing $qv_declare" unless $ENV{PERL_CORE};
349 $version = $CLASS->$qv_declare("1.2");
350 is ( "$version", "v1.2", $qv_declare.'("1.2") == "1.2.0"' );
351 $version = $CLASS->$qv_declare(1.2);
352 is ( "$version", "v1.2", $qv_declare.'(1.2) == "1.2.0"' );
353 isa_ok( $CLASS->$qv_declare('5.008'), $CLASS );
c8a14fb6 354}
137d6fc0 355
317f7c8a 356 # test creation from existing version object
f941e658
JP
357 diag "create new from existing version" unless $ENV{PERL_CORE};
358 ok (eval {$new_version = $CLASS->$method($version)},
317f7c8a 359 "new from existing object");
f941e658 360 ok ($new_version == $version, "class->$method($version) identical");
d54f8cf7 361 $new_version = $version->$method(0);
317f7c8a 362 isa_ok ($new_version, $CLASS );
f941e658
JP
363 is ($new_version, "0", "version->$method() doesn't clone");
364 $new_version = $version->$method("1.2.3");
365 is ($new_version, "1.2.3" , '$version->$method("1.2.3") works too');
317f7c8a
RGS
366
367 # test the CVS revision mode
f941e658 368 diag "testing CVS Revision" unless $ENV{PERL_CORE};
317f7c8a 369 $version = new $CLASS qw$Revision: 1.2$;
8cb289bd 370 ok ( $version == "1.2.0", 'qw$Revision: 1.2$ == 1.2.0' );
317f7c8a 371 $version = new $CLASS qw$Revision: 1.2.3.4$;
8cb289bd 372 ok ( $version == "1.2.3.4", 'qw$Revision: 1.2.3.4$ == 1.2.3.4' );
317f7c8a
RGS
373
374 # test the CPAN style reduced significant digit form
f941e658
JP
375 diag "testing CPAN-style versions" unless $ENV{PERL_CORE};
376 $version = $CLASS->$method("1.23_01");
8cb289bd 377 is ( "$version" , "1.23_01", "CPAN-style alpha version" );
317f7c8a
RGS
378 ok ( $version > 1.23, "1.23_01 > 1.23");
379 ok ( $version < 1.24, "1.23_01 < 1.24");
380
381 # test reformed UNIVERSAL::VERSION
f941e658 382 diag "Replacement UNIVERSAL::VERSION tests" unless $ENV{PERL_CORE};
f34c6aaf
JP
383
384 my $error_regex = $] < 5.006
385 ? 'version \d required'
f941e658 386 : 'does not define \$t.{7}::VERSION';
317f7c8a 387
f34c6aaf 388 {
f941e658
JP
389 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
390 (my $package = basename($filename)) =~ s/\.pm$//;
391 print $fh "package $package;\n\$$package\::VERSION=0.58;\n1;\n";
392 close $fh;
f34c6aaf 393
8cb289bd 394 $version = 0.58;
f941e658
JP
395 eval "use lib '.'; use $package $version";
396 unlike($@, qr/$package version $version/,
f34c6aaf
JP
397 'Replacement eval works with exact version');
398
399 # test as class method
f941e658 400 $new_version = $package->VERSION;
8cb289bd 401 cmp_ok($new_version,'==',$version, "Called as class method");
8dd04980 402
f34c6aaf
JP
403 eval "print Completely::Unknown::Module->VERSION";
404 if ( $] < 5.008 ) {
405 unlike($@, qr/$error_regex/,
406 "Don't freak if the module doesn't even exist");
407 }
408 else {
409 unlike($@, qr/defines neither package nor VERSION/,
410 "Don't freak if the module doesn't even exist");
411 }
412
413 # this should fail even with old UNIVERSAL::VERSION
8cb289bd 414 $version += 0.01;
f941e658
JP
415 eval "use lib '.'; use $package $version";
416 like($@, qr/$package version $version/,
f34c6aaf
JP
417 'Replacement eval works with incremented version');
418
419 $version =~ s/0+$//; #convert to string and remove trailing 0's
420 chop($version); # shorten by 1 digit, should still succeed
f941e658
JP
421 eval "use lib '.'; use $package $version";
422 unlike($@, qr/$package version $version/,
f34c6aaf
JP
423 'Replacement eval works with single digit');
424
425 # this would fail with old UNIVERSAL::VERSION
8cb289bd 426 $version += 0.1;
f941e658
JP
427 eval "use lib '.'; use $package $version";
428 like($@, qr/$package version $version/,
f34c6aaf 429 'Replacement eval works with incremented digit');
f941e658 430 unlink $filename;
f34c6aaf 431 }
317f7c8a
RGS
432
433 { # dummy up some variously broken modules for testing
f941e658
JP
434 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
435 (my $package = basename($filename)) =~ s/\.pm$//;
436 print $fh "1;\n";
437 close $fh;
f34c6aaf 438
f941e658 439 eval "use lib '.'; use $package 3;";
317f7c8a 440 if ( $] < 5.008 ) {
f34c6aaf
JP
441 like($@, qr/$error_regex/,
442 'Replacement handles modules without package or VERSION');
c8a14fb6 443 }
317f7c8a 444 else {
f34c6aaf
JP
445 like($@, qr/defines neither package nor VERSION/,
446 'Replacement handles modules without package or VERSION');
c8a14fb6 447 }
f941e658 448 eval "use lib '.'; use $package; \$version = $package->VERSION";
317f7c8a
RGS
449 unlike ($@, qr/$error_regex/,
450 'Replacement handles modules without package or VERSION');
f34c6aaf 451 ok (!defined($version), "Called as class method");
f941e658 452 unlink $filename;
317f7c8a
RGS
453 }
454
455 { # dummy up some variously broken modules for testing
f941e658
JP
456 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
457 (my $package = basename($filename)) =~ s/\.pm$//;
458 print $fh "package $package;\n#look ma no VERSION\n1;\n";
459 close $fh;
460 eval "use lib '.'; use $package 3;";
f34c6aaf 461 like ($@, qr/$error_regex/,
317f7c8a 462 'Replacement handles modules without VERSION');
f941e658 463 eval "use lib '.'; use $package; print $package->VERSION";
f34c6aaf 464 unlike ($@, qr/$error_regex/,
317f7c8a 465 'Replacement handles modules without VERSION');
f941e658 466 unlink $filename;
317f7c8a
RGS
467 }
468
469 { # dummy up some variously broken modules for testing
f941e658
JP
470 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
471 (my $package = basename($filename)) =~ s/\.pm$//;
472 print $fh "package $package;\n\@VERSION = ();\n1;\n";
473 close $fh;
474 eval "use lib '.'; use $package 3;";
f34c6aaf 475 like ($@, qr/$error_regex/,
317f7c8a 476 'Replacement handles modules without VERSION');
f941e658 477 eval "use lib '.'; use $package; print $package->VERSION";
f34c6aaf 478 unlike ($@, qr/$error_regex/,
317f7c8a 479 'Replacement handles modules without VERSION');
f941e658 480 unlink $filename;
317f7c8a 481 }
a0e8d7b9
JP
482SKIP: { # https://rt.perl.org/rt3/Ticket/Display.html?id=95544
483 skip "version require'd instead of use'd, cannot test UNIVERSAL::VERSION", 2
484 unless defined $qv_declare;
485 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
486 (my $package = basename($filename)) =~ s/\.pm$//;
487 print $fh "package $package;\n\$VERSION = '3alpha';\n1;\n";
488 close $fh;
249f7ddc
JP
489 eval "use lib '.'; use $package; print $package->VERSION";
490 like ($@, qr/Invalid version format \(non-numeric data\)/,
491 'Warn about bad \$VERSION');
a0e8d7b9
JP
492 eval "use lib '.'; use $package 1;";
493 like ($@, qr/Invalid version format \(non-numeric data\)/,
249f7ddc 494 'Warn about bad $VERSION');
a0e8d7b9 495 }
317f7c8a 496
137d6fc0 497SKIP: {
ac0e6a2f
RGS
498 skip 'Cannot test bare v-strings with Perl < 5.6.0', 4
499 if $] < 5.006_000;
f941e658
JP
500 diag "Tests with v-strings" unless $ENV{PERL_CORE};
501 $version = $CLASS->$method(1.2.3);
d54f8cf7 502 ok("$version" eq "v1.2.3", '"$version" eq 1.2.3');
f941e658
JP
503 $version = $CLASS->$method(1.0.0);
504 $new_version = $CLASS->$method(1);
317f7c8a 505 ok($version == $new_version, '$version == $new_version');
f941e658
JP
506 skip "version require'd instead of use'd, cannot test declare", 1
507 unless defined $qv_declare;
508 $version = &$qv_declare(1.2.3);
d54f8cf7
JP
509 ok("$version" eq "v1.2.3", 'v-string initialized $qv_declare()');
510 }
511
512SKIP: {
513 skip 'Cannot test bare alpha v-strings with Perl < 5.8.1', 2
514 if $] lt 5.008_001;
515 diag "Tests with bare alpha v-strings" unless $ENV{PERL_CORE};
516 $version = $CLASS->$method(v1.2.3_4);
517 is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4"');
518 $version = $CLASS->$method(eval "v1.2.3_4");
519 is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4" (from eval)');
317f7c8a
RGS
520 }
521
f941e658 522 diag "Tests with real-world (malformed) data" unless $ENV{PERL_CORE};
317f7c8a
RGS
523
524 # trailing zero testing (reported by Andreas Koenig).
f941e658 525 $version = $CLASS->$method("1");
317f7c8a 526 ok($version->numify eq "1.000", "trailing zeros preserved");
f941e658 527 $version = $CLASS->$method("1.0");
317f7c8a 528 ok($version->numify eq "1.000", "trailing zeros preserved");
f941e658 529 $version = $CLASS->$method("1.0.0");
317f7c8a 530 ok($version->numify eq "1.000000", "trailing zeros preserved");
f941e658 531 $version = $CLASS->$method("1.0.0.0");
317f7c8a
RGS
532 ok($version->numify eq "1.000000000", "trailing zeros preserved");
533
534 # leading zero testing (reported by Andreas Koenig).
f941e658 535 $version = $CLASS->$method(".7");
317f7c8a
RGS
536 ok($version->numify eq "0.700", "leading zero inferred");
537
538 # leading space testing (reported by Andreas Koenig).
f941e658 539 $version = $CLASS->$method(" 1.7");
317f7c8a
RGS
540 ok($version->numify eq "1.700", "leading space ignored");
541
542 # RT 19517 - deal with undef and 'undef' initialization
8cb289bd
RGS
543 ok("$version" ne 'undef', "Undef version comparison #1");
544 ok("$version" ne undef, "Undef version comparison #2");
f941e658 545 $version = $CLASS->$method('undef');
317f7c8a
RGS
546 unlike($warning, qr/^Version string 'undef' contains invalid data/,
547 "Version string 'undef'");
548
f941e658 549 $version = $CLASS->$method(undef);
317f7c8a
RGS
550 like($warning, qr/^Use of uninitialized value/,
551 "Version string 'undef'");
8cb289bd
RGS
552 ok($version == 'undef', "Undef version comparison #3");
553 ok($version == undef, "Undef version comparison #4");
f941e658 554 eval "\$version = \$CLASS->$method()"; # no parameter at all
317f7c8a 555 unlike($@, qr/^Bizarre copy of CODE/, "No initializer at all");
8cb289bd
RGS
556 ok($version == 'undef', "Undef version comparison #5");
557 ok($version == undef, "Undef version comparison #6");
317f7c8a 558
f941e658 559 $version = $CLASS->$method(0.000001);
317f7c8a
RGS
560 unlike($warning, qr/^Version string '1e-06' contains invalid data/,
561 "Very small version objects");
f34c6aaf 562 }
e0218a61 563
317f7c8a 564SKIP: {
f941e658
JP
565 my $warning;
566 local $SIG{__WARN__} = sub { $warning = $_[0] };
317f7c8a 567 # dummy up a legal module for testing RT#19017
f941e658
JP
568 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
569 (my $package = basename($filename)) =~ s/\.pm$//;
570 print $fh <<"EOF";
571package $package;
572use $CLASS; \$VERSION = ${CLASS}->new('0.0.4');
c8a14fb6
RGS
5731;
574EOF
f941e658 575 close $fh;
317f7c8a 576
f941e658
JP
577 eval "use lib '.'; use $package 0.000008;";
578 like ($@, qr/^$package version 0.000008 required/,
317f7c8a 579 "Make sure very small versions don't freak");
f941e658
JP
580 eval "use lib '.'; use $package 1;";
581 like ($@, qr/^$package version 1 required/,
317f7c8a 582 "Comparing vs. version with no decimal");
f941e658
JP
583 eval "use lib '.'; use $package 1.;";
584 like ($@, qr/^$package version 1 required/,
317f7c8a 585 "Comparing vs. version with decimal only");
ac0e6a2f 586 if ( $] < 5.006_000 ) {
ac0e6a2f 587 skip 'Cannot "use" extended versions with Perl < 5.6.0', 3;
d69f6151 588 }
f941e658
JP
589 eval "use lib '.'; use $package v0.0.8;";
590 my $regex = "^$package version v0.0.8 required";
ac0e6a2f 591 like ($@, qr/$regex/, "Make sure very small versions don't freak");
317f7c8a 592
ac0e6a2f 593 $regex =~ s/8/4/; # set for second test
f941e658 594 eval "use lib '.'; use $package v0.0.4;";
ac0e6a2f 595 unlike($@, qr/$regex/, 'Succeed - required == VERSION');
f941e658
JP
596 cmp_ok ( $package->VERSION, 'eq', '0.0.4', 'No undef warnings' );
597 unlink $filename;
317f7c8a
RGS
598 }
599
f941e658
JP
600SKIP: {
601 skip 'Cannot test "use base qw(version)" when require is used', 3
602 unless defined $qv_declare;
603 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
604 (my $package = basename($filename)) =~ s/\.pm$//;
605 print $fh <<"EOF";
606package $package;
92dcf8ce
JP
607use base qw(version);
6081;
609EOF
f941e658
JP
610 close $fh;
611 # need to eliminate any other $qv_declare()'s
612 undef *{"main\::$qv_declare"};
613 ok(!defined(&{"main\::$qv_declare"}), "make sure we cleared $qv_declare() properly");
614 eval "use lib '.'; use $package qw/declare qv/;";
615 ok(defined(&{"main\::$qv_declare"}), "make sure we exported $qv_declare() properly");
616 isa_ok( &$qv_declare(1.2), $package);
617 unlink $filename;
618}
d69f6151
JP
619
620SKIP: {
ac0e6a2f
RGS
621 if ( $] < 5.006_000 ) {
622 skip 'Cannot "use" extended versions with Perl < 5.6.0', 3;
623 }
f941e658
JP
624 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
625 (my $package = basename($filename)) =~ s/\.pm$//;
626 print $fh <<"EOF";
627package $package;
ac0e6a2f
RGS
628\$VERSION = 1.0;
6291;
630EOF
f941e658
JP
631 close $fh;
632 eval "use lib '.'; use $package 1.001;";
633 like ($@, qr/^$package version 1.001 required/,
ac0e6a2f 634 "User typed numeric so we error with numeric");
f941e658
JP
635 eval "use lib '.'; use $package v1.1.0;";
636 like ($@, qr/^$package version v1.1.0 required/,
ac0e6a2f 637 "User typed extended so we error with extended");
f941e658 638 unlink $filename;
ac0e6a2f
RGS
639 }
640
641SKIP: {
d69f6151 642 # test locale handling
f34c6aaf
JP
643 my $warning;
644 local $SIG{__WARN__} = sub { $warning = $_[0] };
f941e658 645
91152fc1
DG
646 my $v = eval { $CLASS->$method('1,7') };
647# is( $@, "", 'Directly test comma as decimal compliance');
f941e658 648
d69f6151 649 my $ver = 1.23; # has to be floating point number
f941e658 650 my $orig_loc = setlocale( LC_ALL );
d69f6151
JP
651 my $loc;
652 while (<DATA>) {
653 chomp;
f941e658
JP
654 $loc = setlocale( LC_ALL, $_);
655 last if localeconv()->{decimal_point} eq ',';
d69f6151
JP
656 }
657 skip 'Cannot test locale handling without a comma locale', 4
658 unless ( $loc and ($ver eq '1,23') );
659
f941e658 660 diag ("Testing locale handling with $loc") unless $ENV{PERL_CORE};
d69f6151 661
f941e658
JP
662 $v = $CLASS->$method($ver);
663 unlike($warning, qr/Version string '1,23' contains invalid data/,
d69f6151 664 "Process locale-dependent floating point");
8cb289bd 665 is ($v, "1.23", "Locale doesn't apply to version objects");
d69f6151 666 ok ($v == $ver, "Comparison to locale floating point");
f941e658
JP
667
668 setlocale( LC_ALL, $orig_loc); # reset this before possible skip
669 skip 'Cannot test RT#46921 with Perl < 5.008', 1
670 if ($] < 5.008);
671 skip 'Cannot test RT#46921 with pure Perl module', 1
672 if exists $INC{'version/vpp.pm'};
673 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
674 (my $package = basename($filename)) =~ s/\.pm$//;
675 print $fh <<"EOF";
676package $package;
677use POSIX qw(locale_h);
678\$^W = 1;
679use $CLASS;
680setlocale (LC_ALL, '$loc');
681use $CLASS ;
682eval "use Socket 1.7";
683setlocale( LC_ALL, '$orig_loc');
6841;
685EOF
686 close $fh;
687
688 eval "use lib '.'; use $package;";
689 unlike($warning, qr"Version string '1,7' contains invalid data",
690 'Handle locale action-at-a-distance');
d69f6151 691 }
f34c6aaf 692
f941e658 693 eval 'my $v = $CLASS->$method("1._1");';
f34c6aaf
JP
694 unlike($@, qr/^Invalid version format \(alpha with zero width\)/,
695 "Invalid version format 1._1");
ac0e6a2f 696
c812d146
JP
697 {
698 my $warning;
699 local $SIG{__WARN__} = sub { $warning = $_[0] };
f941e658 700 eval 'my $v = $CLASS->$method(~0);';
c812d146
JP
701 unlike($@, qr/Integer overflow in version/, "Too large version");
702 like($warning, qr/Integer overflow in version/, "Too large version");
703 }
704
72287d96
JP
705 {
706 # http://rt.cpan.org/Public/Bug/Display.html?id=30004
f941e658 707 my $v1 = $CLASS->$method("v0.1_1");
72287d96 708 (my $alpha1 = Dumper($v1)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
f941e658 709 my $v2 = $CLASS->$method($v1);
72287d96
JP
710 (my $alpha2 = Dumper($v2)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
711 is $alpha2, $alpha1, "Don't fall for Data::Dumper's tricks";
712 }
713
219bf418
RGS
714 {
715 # http://rt.perl.org/rt3/Ticket/Display.html?id=56606
716 my $badv = bless { version => [1,2,3] }, "version";
717 is $badv, '1.002003', "Deal with badly serialized versions from YAML";
718 my $badv2 = bless { qv => 1, version => [1,2,3] }, "version";
719 is $badv2, 'v1.2.3', "Deal with badly serialized versions from YAML ";
720 }
249f7ddc
JP
721
722 {
723 # https://rt.cpan.org/Public/Bug/Display.html?id=70950
724 # test indirect usage of version objects
725 my $sum = 0;
726 eval '$sum += $CLASS->$method("v2.0.0")';
727 like $@, qr/operation not supported with version object/,
728 'No math operations with version objects';
729 # test direct usage of version objects
730 my $v = $CLASS->$method("v2.0.0");
731 eval '$v += 1';
732 like $@, qr/operation not supported with version object/,
733 'No math operations with version objects';
734 }
735
736 {
737 # https://rt.cpan.org/Ticket/Display.html?id=72365
738 # https://rt.perl.org/rt3/Ticket/Display.html?id=102586
739 eval 'my $v = $CLASS->$method("version")';
740 like $@, qr/Invalid version format/,
741 'The string "version" is not a version';
742 eval 'my $v = $CLASS->$method("ver510n")';
743 like $@, qr/Invalid version format/,
744 'All strings starting with "v" are not versions';
745 }
746
d54f8cf7
JP
747SKIP: {
748 if ( $] < 5.006_000 ) {
749 skip 'No v-string support at all < 5.6.0', 2;
750 }
751 # https://rt.cpan.org/Ticket/Display.html?id=49348
752 my $v = $CLASS->$method("420");
753 is "$v", "420", 'Correctly guesses this is not a v-string';
754 $v = $CLASS->$method(4.2.0);
755 is "$v", 'v4.2.0', 'Correctly guess that this is a v-string';
756 }
757SKIP: {
758 if ( $] < 5.006_000 ) {
759 skip 'No v-string support at all < 5.6.0', 4;
760 }
761 # https://rt.cpan.org/Ticket/Display.html?id=50347
762 # Check that the qv() implementation does not change
763
764 ok $CLASS->$method(1.2.3) < $CLASS->$method(1.2.3.1), 'Compare 3 and 4 digit v-strings' ;
765 ok $CLASS->$method(v1.2.3) < $CLASS->$method(v1.2.3.1), 'Compare 3 and 4 digit v-strings, leaving v';
766 ok $CLASS->$method("1.2.3") < $CLASS->$method("1.2.3.1"), 'Compare 3 and 4 digit v-strings, quoted';
767 ok $CLASS->$method("v1.2.3") < $CLASS->$method("v1.2.3.1"), 'Compare 3 and 4 digit v-strings, quoted leading v';
768 }
cb5772bb 769
249f7ddc
JP
770 {
771 eval '$CLASS->$method("version")';
772 pass("no crash with ${CLASS}->${method}('version')");
773 {
774 package _102586;
775 sub TIESCALAR { bless [] }
776 sub FETCH { "version" }
777 sub STORE { }
778 my $v;
779 tie $v, __PACKAGE__;
780 $v = $CLASS->$method(1);
781 eval '$CLASS->$method($v)';
782 }
783 pass('no crash with version->new($tied) where $tied returns "version"');
784 }
bc4eb4d6 785}
bc4eb4d6 786
cb5772bb 7871;
d69f6151
JP
788
789__DATA__
790af_ZA
791af_ZA.utf8
792an_ES
793an_ES.utf8
794az_AZ.utf8
795be_BY
796be_BY.utf8
797bg_BG
798bg_BG.utf8
799br_FR
800br_FR@euro
801br_FR.utf8
802bs_BA
803bs_BA.utf8
804ca_ES
805ca_ES@euro
806ca_ES.utf8
807cs_CZ
808cs_CZ.utf8
809da_DK
810da_DK.utf8
811de_AT
812de_AT@euro
813de_AT.utf8
814de_BE
815de_BE@euro
816de_BE.utf8
817de_DE
818de_DE@euro
819de_DE.utf8
820de_LU
821de_LU@euro
822de_LU.utf8
823el_GR
824el_GR.utf8
825en_DK
826en_DK.utf8
827es_AR
828es_AR.utf8
829es_BO
830es_BO.utf8
831es_CL
832es_CL.utf8
833es_CO
834es_CO.utf8
835es_EC
836es_EC.utf8
837es_ES
838es_ES@euro
839es_ES.utf8
840es_PY
841es_PY.utf8
842es_UY
843es_UY.utf8
844es_VE
845es_VE.utf8
846et_EE
847et_EE.iso885915
848et_EE.utf8
849eu_ES
850eu_ES@euro
851eu_ES.utf8
852fi_FI
853fi_FI@euro
854fi_FI.utf8
855fo_FO
856fo_FO.utf8
857fr_BE
858fr_BE@euro
859fr_BE.utf8
860fr_CA
861fr_CA.utf8
862fr_CH
863fr_CH.utf8
864fr_FR
865fr_FR@euro
866fr_FR.utf8
867fr_LU
868fr_LU@euro
869fr_LU.utf8
870gl_ES
871gl_ES@euro
872gl_ES.utf8
873hr_HR
874hr_HR.utf8
875hu_HU
876hu_HU.utf8
877id_ID
878id_ID.utf8
879is_IS
880is_IS.utf8
881it_CH
882it_CH.utf8
883it_IT
884it_IT@euro
885it_IT.utf8
886ka_GE
887ka_GE.utf8
888kk_KZ
889kk_KZ.utf8
890kl_GL
891kl_GL.utf8
892lt_LT
893lt_LT.utf8
894lv_LV
895lv_LV.utf8
896mk_MK
897mk_MK.utf8
898mn_MN
899mn_MN.utf8
900nb_NO
901nb_NO.utf8
902nl_BE
903nl_BE@euro
904nl_BE.utf8
905nl_NL
906nl_NL@euro
907nl_NL.utf8
908nn_NO
909nn_NO.utf8
910no_NO
911no_NO.utf8
912oc_FR
913oc_FR.utf8
914pl_PL
915pl_PL.utf8
916pt_BR
917pt_BR.utf8
918pt_PT
919pt_PT@euro
920pt_PT.utf8
921ro_RO
922ro_RO.utf8
923ru_RU
924ru_RU.koi8r
925ru_RU.utf8
926ru_UA
927ru_UA.utf8
928se_NO
929se_NO.utf8
930sh_YU
931sh_YU.utf8
932sk_SK
933sk_SK.utf8
934sl_SI
935sl_SI.utf8
936sq_AL
937sq_AL.utf8
938sr_CS
939sr_CS.utf8
940sv_FI
941sv_FI@euro
942sv_FI.utf8
943sv_SE
944sv_SE.iso885915
945sv_SE.utf8
946tg_TJ
947tg_TJ.utf8
948tr_TR
949tr_TR.utf8
950tt_RU.utf8
951uk_UA
952uk_UA.utf8
953vi_VN
954vi_VN.tcvn
955wa_BE
956wa_BE@euro
957wa_BE.utf8
958