This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use syntax from perlguts for testing objects
[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;
489 eval "use lib '.'; use $package; die $package->VERSION";
490 ok ($@ =~ /3alpha/, 'Even a bad $VERSION is returned');
491 eval "use lib '.'; use $package;";
492 unlike ($@, qr/Invalid version format \(non-numeric data\)/,
493 'Do not warn about bad $VERSION unless asked');
494 eval "use lib '.'; use $package 1;";
495 like ($@, qr/Invalid version format \(non-numeric data\)/,
496 'Warn about bad $VERSION when asked');
497 }
317f7c8a 498
137d6fc0 499SKIP: {
ac0e6a2f
RGS
500 skip 'Cannot test bare v-strings with Perl < 5.6.0', 4
501 if $] < 5.006_000;
f941e658
JP
502 diag "Tests with v-strings" unless $ENV{PERL_CORE};
503 $version = $CLASS->$method(1.2.3);
d54f8cf7 504 ok("$version" eq "v1.2.3", '"$version" eq 1.2.3');
f941e658
JP
505 $version = $CLASS->$method(1.0.0);
506 $new_version = $CLASS->$method(1);
317f7c8a 507 ok($version == $new_version, '$version == $new_version');
f941e658
JP
508 skip "version require'd instead of use'd, cannot test declare", 1
509 unless defined $qv_declare;
510 $version = &$qv_declare(1.2.3);
d54f8cf7
JP
511 ok("$version" eq "v1.2.3", 'v-string initialized $qv_declare()');
512 }
513
514SKIP: {
515 skip 'Cannot test bare alpha v-strings with Perl < 5.8.1', 2
516 if $] lt 5.008_001;
517 diag "Tests with bare alpha v-strings" unless $ENV{PERL_CORE};
518 $version = $CLASS->$method(v1.2.3_4);
519 is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4"');
520 $version = $CLASS->$method(eval "v1.2.3_4");
521 is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4" (from eval)');
317f7c8a
RGS
522 }
523
f941e658 524 diag "Tests with real-world (malformed) data" unless $ENV{PERL_CORE};
317f7c8a
RGS
525
526 # trailing zero testing (reported by Andreas Koenig).
f941e658 527 $version = $CLASS->$method("1");
317f7c8a 528 ok($version->numify eq "1.000", "trailing zeros preserved");
f941e658 529 $version = $CLASS->$method("1.0");
317f7c8a 530 ok($version->numify eq "1.000", "trailing zeros preserved");
f941e658 531 $version = $CLASS->$method("1.0.0");
317f7c8a 532 ok($version->numify eq "1.000000", "trailing zeros preserved");
f941e658 533 $version = $CLASS->$method("1.0.0.0");
317f7c8a
RGS
534 ok($version->numify eq "1.000000000", "trailing zeros preserved");
535
536 # leading zero testing (reported by Andreas Koenig).
f941e658 537 $version = $CLASS->$method(".7");
317f7c8a
RGS
538 ok($version->numify eq "0.700", "leading zero inferred");
539
540 # leading space testing (reported by Andreas Koenig).
f941e658 541 $version = $CLASS->$method(" 1.7");
317f7c8a
RGS
542 ok($version->numify eq "1.700", "leading space ignored");
543
544 # RT 19517 - deal with undef and 'undef' initialization
8cb289bd
RGS
545 ok("$version" ne 'undef', "Undef version comparison #1");
546 ok("$version" ne undef, "Undef version comparison #2");
f941e658 547 $version = $CLASS->$method('undef');
317f7c8a
RGS
548 unlike($warning, qr/^Version string 'undef' contains invalid data/,
549 "Version string 'undef'");
550
f941e658 551 $version = $CLASS->$method(undef);
317f7c8a
RGS
552 like($warning, qr/^Use of uninitialized value/,
553 "Version string 'undef'");
8cb289bd
RGS
554 ok($version == 'undef', "Undef version comparison #3");
555 ok($version == undef, "Undef version comparison #4");
f941e658 556 eval "\$version = \$CLASS->$method()"; # no parameter at all
317f7c8a 557 unlike($@, qr/^Bizarre copy of CODE/, "No initializer at all");
8cb289bd
RGS
558 ok($version == 'undef', "Undef version comparison #5");
559 ok($version == undef, "Undef version comparison #6");
317f7c8a 560
f941e658 561 $version = $CLASS->$method(0.000001);
317f7c8a
RGS
562 unlike($warning, qr/^Version string '1e-06' contains invalid data/,
563 "Very small version objects");
f34c6aaf 564 }
e0218a61 565
317f7c8a 566SKIP: {
f941e658
JP
567 my $warning;
568 local $SIG{__WARN__} = sub { $warning = $_[0] };
317f7c8a 569 # dummy up a legal module for testing RT#19017
f941e658
JP
570 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
571 (my $package = basename($filename)) =~ s/\.pm$//;
572 print $fh <<"EOF";
573package $package;
574use $CLASS; \$VERSION = ${CLASS}->new('0.0.4');
c8a14fb6
RGS
5751;
576EOF
f941e658 577 close $fh;
317f7c8a 578
f941e658
JP
579 eval "use lib '.'; use $package 0.000008;";
580 like ($@, qr/^$package version 0.000008 required/,
317f7c8a 581 "Make sure very small versions don't freak");
f941e658
JP
582 eval "use lib '.'; use $package 1;";
583 like ($@, qr/^$package version 1 required/,
317f7c8a 584 "Comparing vs. version with no decimal");
f941e658
JP
585 eval "use lib '.'; use $package 1.;";
586 like ($@, qr/^$package version 1 required/,
317f7c8a 587 "Comparing vs. version with decimal only");
ac0e6a2f 588 if ( $] < 5.006_000 ) {
ac0e6a2f 589 skip 'Cannot "use" extended versions with Perl < 5.6.0', 3;
d69f6151 590 }
f941e658
JP
591 eval "use lib '.'; use $package v0.0.8;";
592 my $regex = "^$package version v0.0.8 required";
ac0e6a2f 593 like ($@, qr/$regex/, "Make sure very small versions don't freak");
317f7c8a 594
ac0e6a2f 595 $regex =~ s/8/4/; # set for second test
f941e658 596 eval "use lib '.'; use $package v0.0.4;";
ac0e6a2f 597 unlike($@, qr/$regex/, 'Succeed - required == VERSION');
f941e658
JP
598 cmp_ok ( $package->VERSION, 'eq', '0.0.4', 'No undef warnings' );
599 unlink $filename;
317f7c8a
RGS
600 }
601
f941e658
JP
602SKIP: {
603 skip 'Cannot test "use base qw(version)" when require is used', 3
604 unless defined $qv_declare;
605 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
606 (my $package = basename($filename)) =~ s/\.pm$//;
607 print $fh <<"EOF";
608package $package;
92dcf8ce
JP
609use base qw(version);
6101;
611EOF
f941e658
JP
612 close $fh;
613 # need to eliminate any other $qv_declare()'s
614 undef *{"main\::$qv_declare"};
615 ok(!defined(&{"main\::$qv_declare"}), "make sure we cleared $qv_declare() properly");
616 eval "use lib '.'; use $package qw/declare qv/;";
617 ok(defined(&{"main\::$qv_declare"}), "make sure we exported $qv_declare() properly");
618 isa_ok( &$qv_declare(1.2), $package);
619 unlink $filename;
620}
d69f6151
JP
621
622SKIP: {
ac0e6a2f
RGS
623 if ( $] < 5.006_000 ) {
624 skip 'Cannot "use" extended versions with Perl < 5.6.0', 3;
625 }
f941e658
JP
626 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
627 (my $package = basename($filename)) =~ s/\.pm$//;
628 print $fh <<"EOF";
629package $package;
ac0e6a2f
RGS
630\$VERSION = 1.0;
6311;
632EOF
f941e658
JP
633 close $fh;
634 eval "use lib '.'; use $package 1.001;";
635 like ($@, qr/^$package version 1.001 required/,
ac0e6a2f 636 "User typed numeric so we error with numeric");
f941e658
JP
637 eval "use lib '.'; use $package v1.1.0;";
638 like ($@, qr/^$package version v1.1.0 required/,
ac0e6a2f 639 "User typed extended so we error with extended");
f941e658 640 unlink $filename;
ac0e6a2f
RGS
641 }
642
643SKIP: {
d69f6151 644 # test locale handling
f34c6aaf
JP
645 my $warning;
646 local $SIG{__WARN__} = sub { $warning = $_[0] };
f941e658 647
91152fc1
DG
648 my $v = eval { $CLASS->$method('1,7') };
649# is( $@, "", 'Directly test comma as decimal compliance');
f941e658 650
d69f6151 651 my $ver = 1.23; # has to be floating point number
f941e658 652 my $orig_loc = setlocale( LC_ALL );
d69f6151
JP
653 my $loc;
654 while (<DATA>) {
655 chomp;
f941e658
JP
656 $loc = setlocale( LC_ALL, $_);
657 last if localeconv()->{decimal_point} eq ',';
d69f6151
JP
658 }
659 skip 'Cannot test locale handling without a comma locale', 4
660 unless ( $loc and ($ver eq '1,23') );
661
f941e658 662 diag ("Testing locale handling with $loc") unless $ENV{PERL_CORE};
d69f6151 663
f941e658
JP
664 $v = $CLASS->$method($ver);
665 unlike($warning, qr/Version string '1,23' contains invalid data/,
d69f6151 666 "Process locale-dependent floating point");
8cb289bd 667 is ($v, "1.23", "Locale doesn't apply to version objects");
d69f6151 668 ok ($v == $ver, "Comparison to locale floating point");
f941e658
JP
669
670 setlocale( LC_ALL, $orig_loc); # reset this before possible skip
671 skip 'Cannot test RT#46921 with Perl < 5.008', 1
672 if ($] < 5.008);
673 skip 'Cannot test RT#46921 with pure Perl module', 1
674 if exists $INC{'version/vpp.pm'};
675 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
676 (my $package = basename($filename)) =~ s/\.pm$//;
677 print $fh <<"EOF";
678package $package;
679use POSIX qw(locale_h);
680\$^W = 1;
681use $CLASS;
682setlocale (LC_ALL, '$loc');
683use $CLASS ;
684eval "use Socket 1.7";
685setlocale( LC_ALL, '$orig_loc');
6861;
687EOF
688 close $fh;
689
690 eval "use lib '.'; use $package;";
691 unlike($warning, qr"Version string '1,7' contains invalid data",
692 'Handle locale action-at-a-distance');
d69f6151 693 }
f34c6aaf 694
f941e658 695 eval 'my $v = $CLASS->$method("1._1");';
f34c6aaf
JP
696 unlike($@, qr/^Invalid version format \(alpha with zero width\)/,
697 "Invalid version format 1._1");
ac0e6a2f 698
c812d146
JP
699 {
700 my $warning;
701 local $SIG{__WARN__} = sub { $warning = $_[0] };
f941e658 702 eval 'my $v = $CLASS->$method(~0);';
c812d146
JP
703 unlike($@, qr/Integer overflow in version/, "Too large version");
704 like($warning, qr/Integer overflow in version/, "Too large version");
705 }
706
72287d96
JP
707 {
708 # http://rt.cpan.org/Public/Bug/Display.html?id=30004
f941e658 709 my $v1 = $CLASS->$method("v0.1_1");
72287d96 710 (my $alpha1 = Dumper($v1)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
f941e658 711 my $v2 = $CLASS->$method($v1);
72287d96
JP
712 (my $alpha2 = Dumper($v2)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
713 is $alpha2, $alpha1, "Don't fall for Data::Dumper's tricks";
714 }
715
219bf418
RGS
716 {
717 # http://rt.perl.org/rt3/Ticket/Display.html?id=56606
718 my $badv = bless { version => [1,2,3] }, "version";
719 is $badv, '1.002003', "Deal with badly serialized versions from YAML";
720 my $badv2 = bless { qv => 1, version => [1,2,3] }, "version";
721 is $badv2, 'v1.2.3', "Deal with badly serialized versions from YAML ";
722 }
d54f8cf7
JP
723SKIP: {
724 if ( $] < 5.006_000 ) {
725 skip 'No v-string support at all < 5.6.0', 2;
726 }
727 # https://rt.cpan.org/Ticket/Display.html?id=49348
728 my $v = $CLASS->$method("420");
729 is "$v", "420", 'Correctly guesses this is not a v-string';
730 $v = $CLASS->$method(4.2.0);
731 is "$v", 'v4.2.0', 'Correctly guess that this is a v-string';
732 }
733SKIP: {
734 if ( $] < 5.006_000 ) {
735 skip 'No v-string support at all < 5.6.0', 4;
736 }
737 # https://rt.cpan.org/Ticket/Display.html?id=50347
738 # Check that the qv() implementation does not change
739
740 ok $CLASS->$method(1.2.3) < $CLASS->$method(1.2.3.1), 'Compare 3 and 4 digit v-strings' ;
741 ok $CLASS->$method(v1.2.3) < $CLASS->$method(v1.2.3.1), 'Compare 3 and 4 digit v-strings, leaving v';
742 ok $CLASS->$method("1.2.3") < $CLASS->$method("1.2.3.1"), 'Compare 3 and 4 digit v-strings, quoted';
743 ok $CLASS->$method("v1.2.3") < $CLASS->$method("v1.2.3.1"), 'Compare 3 and 4 digit v-strings, quoted leading v';
744 }
137d6fc0 745}
cb5772bb 746
bc4eb4d6
FC
747eval { version->new("version") };
748pass('no crash with version->new("version")');
749{
750 package _102586;
751 sub TIESCALAR { bless [] }
752 sub FETCH { "version" }
753 sub STORE { }
754 tie my $v, __PACKAGE__;
755 $v = version->new(1);
756 eval { version->new($v) };
757}
758pass('no crash with version->new($tied) where $tied returns "version"');
759
cb5772bb 7601;
d69f6151
JP
761
762__DATA__
763af_ZA
764af_ZA.utf8
765an_ES
766an_ES.utf8
767az_AZ.utf8
768be_BY
769be_BY.utf8
770bg_BG
771bg_BG.utf8
772br_FR
773br_FR@euro
774br_FR.utf8
775bs_BA
776bs_BA.utf8
777ca_ES
778ca_ES@euro
779ca_ES.utf8
780cs_CZ
781cs_CZ.utf8
782da_DK
783da_DK.utf8
784de_AT
785de_AT@euro
786de_AT.utf8
787de_BE
788de_BE@euro
789de_BE.utf8
790de_DE
791de_DE@euro
792de_DE.utf8
793de_LU
794de_LU@euro
795de_LU.utf8
796el_GR
797el_GR.utf8
798en_DK
799en_DK.utf8
800es_AR
801es_AR.utf8
802es_BO
803es_BO.utf8
804es_CL
805es_CL.utf8
806es_CO
807es_CO.utf8
808es_EC
809es_EC.utf8
810es_ES
811es_ES@euro
812es_ES.utf8
813es_PY
814es_PY.utf8
815es_UY
816es_UY.utf8
817es_VE
818es_VE.utf8
819et_EE
820et_EE.iso885915
821et_EE.utf8
822eu_ES
823eu_ES@euro
824eu_ES.utf8
825fi_FI
826fi_FI@euro
827fi_FI.utf8
828fo_FO
829fo_FO.utf8
830fr_BE
831fr_BE@euro
832fr_BE.utf8
833fr_CA
834fr_CA.utf8
835fr_CH
836fr_CH.utf8
837fr_FR
838fr_FR@euro
839fr_FR.utf8
840fr_LU
841fr_LU@euro
842fr_LU.utf8
843gl_ES
844gl_ES@euro
845gl_ES.utf8
846hr_HR
847hr_HR.utf8
848hu_HU
849hu_HU.utf8
850id_ID
851id_ID.utf8
852is_IS
853is_IS.utf8
854it_CH
855it_CH.utf8
856it_IT
857it_IT@euro
858it_IT.utf8
859ka_GE
860ka_GE.utf8
861kk_KZ
862kk_KZ.utf8
863kl_GL
864kl_GL.utf8
865lt_LT
866lt_LT.utf8
867lv_LV
868lv_LV.utf8
869mk_MK
870mk_MK.utf8
871mn_MN
872mn_MN.utf8
873nb_NO
874nb_NO.utf8
875nl_BE
876nl_BE@euro
877nl_BE.utf8
878nl_NL
879nl_NL@euro
880nl_NL.utf8
881nn_NO
882nn_NO.utf8
883no_NO
884no_NO.utf8
885oc_FR
886oc_FR.utf8
887pl_PL
888pl_PL.utf8
889pt_BR
890pt_BR.utf8
891pt_PT
892pt_PT@euro
893pt_PT.utf8
894ro_RO
895ro_RO.utf8
896ru_RU
897ru_RU.koi8r
898ru_RU.utf8
899ru_UA
900ru_UA.utf8
901se_NO
902se_NO.utf8
903sh_YU
904sh_YU.utf8
905sk_SK
906sk_SK.utf8
907sl_SI
908sl_SI.utf8
909sq_AL
910sq_AL.utf8
911sr_CS
912sr_CS.utf8
913sv_FI
914sv_FI@euro
915sv_FI.utf8
916sv_SE
917sv_SE.iso885915
918sv_SE.utf8
919tg_TJ
920tg_TJ.utf8
921tr_TR
922tr_TR.utf8
923tt_RU.utf8
924uk_UA
925uk_UA.utf8
926vi_VN
927vi_VN.tcvn
928wa_BE
929wa_BE@euro
930wa_BE.utf8
931