This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add Socket version numbers to perldelta
[perl5.git] / lib / version.t
CommitLineData
129318bd 1#! /usr/local/perl -w
a7ad731c
HS
2# Before `make install' is performed this script should be runnable with
3# `make test'. After `make install' it should work as `perl test.pl'
a7ad731c
HS
4
5#########################
6
34ba6322 7use Test::More qw(no_plan);
72287d96 8use Data::Dumper;
c8a14fb6
RGS
9require Test::Harness;
10no warnings 'once';
11*Verbose = \$Test::Harness::Verbose;
f941e658
JP
12use POSIX qw/locale_h/;
13use File::Temp qw/tempfile/;
14use File::Basename;
a7ad731c 15
5eb567df 16BEGIN {
f941e658
JP
17 use_ok("version", 0.77);
18 # If we made it this far, we are ok.
5eb567df
RGS
19}
20
f941e658
JP
21my $Verbose;
22
23diag "Tests with base class" unless $ENV{PERL_CORE};
137d6fc0 24
f941e658
JP
25BaseTests("version","new","qv");
26BaseTests("version","new","declare");
27BaseTests("version","parse", "qv");
28BaseTests("version","parse", "declare");
137d6fc0 29
f941e658
JP
30# dummy up a redundant call to satify David Wheeler
31local $SIG{__WARN__} = sub { die $_[0] };
32eval 'use version;';
33unlike ($@, qr/^Subroutine main::declare redefined/,
34 "Only export declare once per package (to prevent redefined warnings).");
137d6fc0 35
e0218a61 36package version::Bad;
f941e658 37use base 'version';
e0218a61
JP
38sub new { my($self,$n)=@_; bless \$n, $self }
39
137d6fc0 40package main;
f941e658
JP
41
42my $warning;
43local $SIG{__WARN__} = sub { $warning = $_[0] };
44my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
45(my $package = basename($filename)) =~ s/\.pm$//;
46print $fh <<"EOF";
47# This is an empty subclass
48package $package;
49use base 'version';
50use vars '\$VERSION';
51\$VERSION=0.001;
52EOF
53close $fh;
54
55sub main_reset {
56 delete $main::INC{'$package'};
57 undef &qv; undef *::qv; # avoid 'used once' warning
58 undef &declare; undef *::declare; # avoid 'used once' warning
59}
60
61diag "Tests with empty derived class" unless $ENV{PERL_CORE};
62
63use_ok($package, 0.001);
64my $testobj = $package->new(1.002_003);
65isa_ok( $testobj, $package );
137d6fc0 66ok( $testobj->numify == 1.002003, "Numified correctly" );
9137345a
JP
67ok( $testobj->stringify eq "1.002003", "Stringified correctly" );
68ok( $testobj->normal eq "v1.2.3", "Normalified correctly" );
137d6fc0 69
f941e658 70my $verobj = version::->new("1.2.4");
137d6fc0 71ok( $verobj > $testobj, "Comparison vs parent class" );
137d6fc0 72
f941e658
JP
73BaseTests($package, "new", "qv");
74main_reset;
75use_ok($package, 0.001, "declare");
76BaseTests($package, "new", "declare");
77main_reset;
78use_ok($package, 0.001);
79BaseTests($package, "parse", "qv");
80main_reset;
81use_ok($package, 0.001, "declare");
82BaseTests($package, "parse", "declare");
83
84diag "tests with bad subclass" unless $ENV{PERL_CORE};
e0218a61
JP
85$testobj = version::Bad->new(1.002_003);
86isa_ok( $testobj, "version::Bad" );
87eval { my $string = $testobj->numify };
88like($@, qr/Invalid version object/,
89 "Bad subclass numify");
90eval { my $string = $testobj->normal };
91like($@, qr/Invalid version object/,
92 "Bad subclass normal");
93eval { my $string = $testobj->stringify };
94like($@, qr/Invalid version object/,
95 "Bad subclass stringify");
f941e658 96eval { my $test = ($testobj > 1.0) };
e0218a61
JP
97like($@, qr/Invalid version object/,
98 "Bad subclass vcmp");
5de8bffd
DG
99
100# Invalid structure
101eval { $a = \\version->new(1); bless $a, "version"; print "# $a\n" };
102like($@, qr/Invalid version object/,
103 "Bad internal structure (RT#78286)");
9b463b21
DG
104
105# do strict lax tests in a sub to isolate a package to test importing
5de8bffd
DG
106strict_lax_tests();
107
9b463b21
DG
108sub strict_lax_tests {
109 package temp12345;
110 # copied from perl core test t/op/packagev.t
111 # format: STRING STRICT_OK LAX_OK
112 my $strict_lax_data = << 'CASE_DATA';
1131.00 pass pass
1141.00001 pass pass
1150.123 pass pass
11612.345 pass pass
11742 pass pass
1180 pass pass
1190.0 pass pass
120v1.2.3 pass pass
121v1.2.3.4 pass pass
122v0.1.2 pass pass
123v0.0.0 pass pass
12401 fail pass
12501.0203 fail pass
126v01 fail pass
127v01.02.03 fail pass
128.1 fail pass
129.1.2 fail pass
1301. fail pass
1311.a fail fail
1321._ fail fail
1331.02_03 fail pass
134v1.2_3 fail pass
135v1.02_03 fail pass
136v1.2_3_4 fail fail
137v1.2_3.4 fail fail
1381.2_3.4 fail fail
1390_ fail fail
1401_ fail fail
1411_. fail fail
1421.1_ fail fail
1431.02_03_04 fail fail
1441.2.3 fail pass
145v1.2 fail pass
146v0 fail pass
147v1 fail pass
148v.1.2.3 fail fail
149v fail fail
150v1.2345.6 fail pass
151undef fail pass
1521a fail fail
1531.2a3 fail fail
154bar fail fail
155_ fail fail
156CASE_DATA
157
158 require version;
159 version->import( qw/is_strict is_lax/ );
160 for my $case ( split qr/\n/, $strict_lax_data ) {
161 my ($v, $strict, $lax) = split qr/\t+/, $case;
162 main::ok( $strict eq 'pass' ? is_strict($v) : ! is_strict($v), "is_strict($v) [$strict]" );
163 main::ok( $strict eq 'pass' ? version::is_strict($v) : ! version::is_strict($v), "version::is_strict($v) [$strict]" );
164 main::ok( $lax eq 'pass' ? is_lax($v) : ! is_lax($v), "is_lax($v) [$lax]" );
165 main::ok( $lax eq 'pass' ? version::is_lax($v) : ! version::is_lax($v), "version::is_lax($v) [$lax]" );
166 }
167}
e0218a61 168
137d6fc0
JP
169sub BaseTests {
170
f941e658 171 my ($CLASS, $method, $qv_declare) = @_;
692a467c
JP
172 my $warning;
173 local $SIG{__WARN__} = sub { $warning = $_[0] };
317f7c8a
RGS
174
175 # Insert your test code below, the Test module is use()ed here so read
176 # its man page ( perldoc Test ) for help writing this test script.
177
178 # Test bare number processing
f941e658
JP
179 diag "tests with bare numbers" unless $ENV{PERL_CORE};
180 $version = $CLASS->$method(5.005_03);
8cb289bd 181 is ( "$version" , "5.00503" , '5.005_03 eq 5.00503' );
f941e658 182 $version = $CLASS->$method(1.23);
8cb289bd 183 is ( "$version" , "1.23" , '1.23 eq "1.23"' );
317f7c8a
RGS
184
185 # Test quoted number processing
f941e658
JP
186 diag "tests with quoted numbers" unless $ENV{PERL_CORE};
187 $version = $CLASS->$method("5.005_03");
8cb289bd 188 is ( "$version" , "5.005_03" , '"5.005_03" eq "5.005_03"' );
f941e658 189 $version = $CLASS->$method("v1.23");
8cb289bd 190 is ( "$version" , "v1.23" , '"v1.23" eq "v1.23"' );
317f7c8a
RGS
191
192 # Test stringify operator
f941e658
JP
193 diag "tests with stringify" unless $ENV{PERL_CORE};
194 $version = $CLASS->$method("5.005");
317f7c8a 195 is ( "$version" , "5.005" , '5.005 eq "5.005"' );
f941e658 196 $version = $CLASS->$method("5.006.001");
8cb289bd 197 is ( "$version" , "5.006.001" , '5.006.001 eq v5.6.1' );
692a467c
JP
198 unlike ($warning, qr/v-string without leading 'v' deprecated/, 'No leading v');
199 $version = $CLASS->$method("v1.2.3_4");
200 is ( "$version" , "v1.2.3_4" , 'alpha version 1.2.3_4 eq v1.2.3_4' );
317f7c8a
RGS
201
202 # test illegal formats
f941e658 203 diag "test illegal formats" unless $ENV{PERL_CORE};
91152fc1 204 eval {$version = $CLASS->$method("1.2_3_4")};
317f7c8a
RGS
205 like($@, qr/multiple underscores/,
206 "Invalid version format (multiple underscores)");
207
91152fc1 208 eval {$version = $CLASS->$method("1.2_3.4")};
317f7c8a
RGS
209 like($@, qr/underscores before decimal/,
210 "Invalid version format (underscores before decimal)");
211
91152fc1 212 eval {$version = $CLASS->$method("1_2")};
317f7c8a
RGS
213 like($@, qr/alpha without decimal/,
214 "Invalid version format (alpha without decimal)");
215
91152fc1
DG
216 eval { $version = $CLASS->$method("1.2b3")};
217 like($@, qr/non-numeric data/,
218 "Invalid version format (non-numeric data)");
317f7c8a
RGS
219
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
331 # that which is not expressly permitted is forbidden
f941e658 332 diag "forbidden operations" unless $ENV{PERL_CORE};
317f7c8a
RGS
333 ok ( !eval { ++$version }, "noop ++" );
334 ok ( !eval { --$version }, "noop --" );
335 ok ( !eval { $version/1 }, "noop /" );
336 ok ( !eval { $version*3 }, "noop *" );
337 ok ( !eval { abs($version) }, "noop abs" );
137d6fc0 338
c8a14fb6 339SKIP: {
f941e658
JP
340 skip "version require'd instead of use'd, cannot test $qv_declare", 3
341 unless defined $qv_declare;
342 # test the $qv_declare() sub
343 diag "testing $qv_declare" unless $ENV{PERL_CORE};
344 $version = $CLASS->$qv_declare("1.2");
345 is ( "$version", "v1.2", $qv_declare.'("1.2") == "1.2.0"' );
346 $version = $CLASS->$qv_declare(1.2);
347 is ( "$version", "v1.2", $qv_declare.'(1.2) == "1.2.0"' );
348 isa_ok( $CLASS->$qv_declare('5.008'), $CLASS );
c8a14fb6 349}
137d6fc0 350
317f7c8a 351 # test creation from existing version object
f941e658
JP
352 diag "create new from existing version" unless $ENV{PERL_CORE};
353 ok (eval {$new_version = $CLASS->$method($version)},
317f7c8a 354 "new from existing object");
f941e658
JP
355 ok ($new_version == $version, "class->$method($version) identical");
356 $new_version = $version->$method();
317f7c8a 357 isa_ok ($new_version, $CLASS );
f941e658
JP
358 is ($new_version, "0", "version->$method() doesn't clone");
359 $new_version = $version->$method("1.2.3");
360 is ($new_version, "1.2.3" , '$version->$method("1.2.3") works too');
317f7c8a
RGS
361
362 # test the CVS revision mode
f941e658 363 diag "testing CVS Revision" unless $ENV{PERL_CORE};
317f7c8a 364 $version = new $CLASS qw$Revision: 1.2$;
8cb289bd 365 ok ( $version == "1.2.0", 'qw$Revision: 1.2$ == 1.2.0' );
317f7c8a 366 $version = new $CLASS qw$Revision: 1.2.3.4$;
8cb289bd 367 ok ( $version == "1.2.3.4", 'qw$Revision: 1.2.3.4$ == 1.2.3.4' );
317f7c8a
RGS
368
369 # test the CPAN style reduced significant digit form
f941e658
JP
370 diag "testing CPAN-style versions" unless $ENV{PERL_CORE};
371 $version = $CLASS->$method("1.23_01");
8cb289bd 372 is ( "$version" , "1.23_01", "CPAN-style alpha version" );
317f7c8a
RGS
373 ok ( $version > 1.23, "1.23_01 > 1.23");
374 ok ( $version < 1.24, "1.23_01 < 1.24");
375
376 # test reformed UNIVERSAL::VERSION
f941e658 377 diag "Replacement UNIVERSAL::VERSION tests" unless $ENV{PERL_CORE};
f34c6aaf
JP
378
379 my $error_regex = $] < 5.006
380 ? 'version \d required'
f941e658 381 : 'does not define \$t.{7}::VERSION';
317f7c8a 382
f34c6aaf 383 {
f941e658
JP
384 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
385 (my $package = basename($filename)) =~ s/\.pm$//;
386 print $fh "package $package;\n\$$package\::VERSION=0.58;\n1;\n";
387 close $fh;
f34c6aaf 388
8cb289bd 389 $version = 0.58;
f941e658
JP
390 eval "use lib '.'; use $package $version";
391 unlike($@, qr/$package version $version/,
f34c6aaf
JP
392 'Replacement eval works with exact version');
393
394 # test as class method
f941e658 395 $new_version = $package->VERSION;
8cb289bd 396 cmp_ok($new_version,'==',$version, "Called as class method");
8dd04980 397
f34c6aaf
JP
398 eval "print Completely::Unknown::Module->VERSION";
399 if ( $] < 5.008 ) {
400 unlike($@, qr/$error_regex/,
401 "Don't freak if the module doesn't even exist");
402 }
403 else {
404 unlike($@, qr/defines neither package nor VERSION/,
405 "Don't freak if the module doesn't even exist");
406 }
407
408 # this should fail even with old UNIVERSAL::VERSION
8cb289bd 409 $version += 0.01;
f941e658
JP
410 eval "use lib '.'; use $package $version";
411 like($@, qr/$package version $version/,
f34c6aaf
JP
412 'Replacement eval works with incremented version');
413
414 $version =~ s/0+$//; #convert to string and remove trailing 0's
415 chop($version); # shorten by 1 digit, should still succeed
f941e658
JP
416 eval "use lib '.'; use $package $version";
417 unlike($@, qr/$package version $version/,
f34c6aaf
JP
418 'Replacement eval works with single digit');
419
420 # this would fail with old UNIVERSAL::VERSION
8cb289bd 421 $version += 0.1;
f941e658
JP
422 eval "use lib '.'; use $package $version";
423 like($@, qr/$package version $version/,
f34c6aaf 424 'Replacement eval works with incremented digit');
f941e658 425 unlink $filename;
f34c6aaf 426 }
317f7c8a
RGS
427
428 { # dummy up some variously broken modules for testing
f941e658
JP
429 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
430 (my $package = basename($filename)) =~ s/\.pm$//;
431 print $fh "1;\n";
432 close $fh;
f34c6aaf 433
f941e658 434 eval "use lib '.'; use $package 3;";
317f7c8a 435 if ( $] < 5.008 ) {
f34c6aaf
JP
436 like($@, qr/$error_regex/,
437 'Replacement handles modules without package or VERSION');
c8a14fb6 438 }
317f7c8a 439 else {
f34c6aaf
JP
440 like($@, qr/defines neither package nor VERSION/,
441 'Replacement handles modules without package or VERSION');
c8a14fb6 442 }
f941e658 443 eval "use lib '.'; use $package; \$version = $package->VERSION";
317f7c8a
RGS
444 unlike ($@, qr/$error_regex/,
445 'Replacement handles modules without package or VERSION');
f34c6aaf 446 ok (!defined($version), "Called as class method");
f941e658 447 unlink $filename;
317f7c8a
RGS
448 }
449
450 { # dummy up some variously broken modules for testing
f941e658
JP
451 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
452 (my $package = basename($filename)) =~ s/\.pm$//;
453 print $fh "package $package;\n#look ma no VERSION\n1;\n";
454 close $fh;
455 eval "use lib '.'; use $package 3;";
f34c6aaf 456 like ($@, qr/$error_regex/,
317f7c8a 457 'Replacement handles modules without VERSION');
f941e658 458 eval "use lib '.'; use $package; print $package->VERSION";
f34c6aaf 459 unlike ($@, qr/$error_regex/,
317f7c8a 460 'Replacement handles modules without VERSION');
f941e658 461 unlink $filename;
317f7c8a
RGS
462 }
463
464 { # dummy up some variously broken modules for testing
f941e658
JP
465 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
466 (my $package = basename($filename)) =~ s/\.pm$//;
467 print $fh "package $package;\n\@VERSION = ();\n1;\n";
468 close $fh;
469 eval "use lib '.'; use $package 3;";
f34c6aaf 470 like ($@, qr/$error_regex/,
317f7c8a 471 'Replacement handles modules without VERSION');
f941e658 472 eval "use lib '.'; use $package; print $package->VERSION";
f34c6aaf 473 unlike ($@, qr/$error_regex/,
317f7c8a 474 'Replacement handles modules without VERSION');
f941e658 475 unlink $filename;
317f7c8a
RGS
476 }
477
137d6fc0 478SKIP: {
ac0e6a2f
RGS
479 skip 'Cannot test bare v-strings with Perl < 5.6.0', 4
480 if $] < 5.006_000;
f941e658
JP
481 diag "Tests with v-strings" unless $ENV{PERL_CORE};
482 $version = $CLASS->$method(1.2.3);
8cb289bd 483 ok("$version" == "v1.2.3", '"$version" == 1.2.3');
f941e658
JP
484 $version = $CLASS->$method(1.0.0);
485 $new_version = $CLASS->$method(1);
317f7c8a 486 ok($version == $new_version, '$version == $new_version');
f941e658
JP
487 skip "version require'd instead of use'd, cannot test declare", 1
488 unless defined $qv_declare;
489 $version = &$qv_declare(1.2.3);
490 ok("$version" == "v1.2.3", 'v-string initialized $qv_declare()');
317f7c8a
RGS
491 }
492
f941e658 493 diag "Tests with real-world (malformed) data" unless $ENV{PERL_CORE};
317f7c8a
RGS
494
495 # trailing zero testing (reported by Andreas Koenig).
f941e658 496 $version = $CLASS->$method("1");
317f7c8a 497 ok($version->numify eq "1.000", "trailing zeros preserved");
f941e658 498 $version = $CLASS->$method("1.0");
317f7c8a 499 ok($version->numify eq "1.000", "trailing zeros preserved");
f941e658 500 $version = $CLASS->$method("1.0.0");
317f7c8a 501 ok($version->numify eq "1.000000", "trailing zeros preserved");
f941e658 502 $version = $CLASS->$method("1.0.0.0");
317f7c8a
RGS
503 ok($version->numify eq "1.000000000", "trailing zeros preserved");
504
505 # leading zero testing (reported by Andreas Koenig).
f941e658 506 $version = $CLASS->$method(".7");
317f7c8a
RGS
507 ok($version->numify eq "0.700", "leading zero inferred");
508
509 # leading space testing (reported by Andreas Koenig).
f941e658 510 $version = $CLASS->$method(" 1.7");
317f7c8a
RGS
511 ok($version->numify eq "1.700", "leading space ignored");
512
513 # RT 19517 - deal with undef and 'undef' initialization
8cb289bd
RGS
514 ok("$version" ne 'undef', "Undef version comparison #1");
515 ok("$version" ne undef, "Undef version comparison #2");
f941e658 516 $version = $CLASS->$method('undef');
317f7c8a
RGS
517 unlike($warning, qr/^Version string 'undef' contains invalid data/,
518 "Version string 'undef'");
519
f941e658 520 $version = $CLASS->$method(undef);
317f7c8a
RGS
521 like($warning, qr/^Use of uninitialized value/,
522 "Version string 'undef'");
8cb289bd
RGS
523 ok($version == 'undef', "Undef version comparison #3");
524 ok($version == undef, "Undef version comparison #4");
f941e658 525 eval "\$version = \$CLASS->$method()"; # no parameter at all
317f7c8a 526 unlike($@, qr/^Bizarre copy of CODE/, "No initializer at all");
8cb289bd
RGS
527 ok($version == 'undef', "Undef version comparison #5");
528 ok($version == undef, "Undef version comparison #6");
317f7c8a 529
f941e658 530 $version = $CLASS->$method(0.000001);
317f7c8a
RGS
531 unlike($warning, qr/^Version string '1e-06' contains invalid data/,
532 "Very small version objects");
f34c6aaf 533 }
e0218a61 534
317f7c8a 535SKIP: {
f941e658
JP
536 my $warning;
537 local $SIG{__WARN__} = sub { $warning = $_[0] };
317f7c8a 538 # dummy up a legal module for testing RT#19017
f941e658
JP
539 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
540 (my $package = basename($filename)) =~ s/\.pm$//;
541 print $fh <<"EOF";
542package $package;
543use $CLASS; \$VERSION = ${CLASS}->new('0.0.4');
c8a14fb6
RGS
5441;
545EOF
f941e658 546 close $fh;
317f7c8a 547
f941e658
JP
548 eval "use lib '.'; use $package 0.000008;";
549 like ($@, qr/^$package version 0.000008 required/,
317f7c8a 550 "Make sure very small versions don't freak");
f941e658
JP
551 eval "use lib '.'; use $package 1;";
552 like ($@, qr/^$package version 1 required/,
317f7c8a 553 "Comparing vs. version with no decimal");
f941e658
JP
554 eval "use lib '.'; use $package 1.;";
555 like ($@, qr/^$package version 1 required/,
317f7c8a 556 "Comparing vs. version with decimal only");
ac0e6a2f 557 if ( $] < 5.006_000 ) {
ac0e6a2f 558 skip 'Cannot "use" extended versions with Perl < 5.6.0', 3;
d69f6151 559 }
f941e658
JP
560 eval "use lib '.'; use $package v0.0.8;";
561 my $regex = "^$package version v0.0.8 required";
ac0e6a2f 562 like ($@, qr/$regex/, "Make sure very small versions don't freak");
317f7c8a 563
ac0e6a2f 564 $regex =~ s/8/4/; # set for second test
f941e658 565 eval "use lib '.'; use $package v0.0.4;";
ac0e6a2f 566 unlike($@, qr/$regex/, 'Succeed - required == VERSION');
f941e658
JP
567 cmp_ok ( $package->VERSION, 'eq', '0.0.4', 'No undef warnings' );
568 unlink $filename;
317f7c8a
RGS
569 }
570
f941e658
JP
571SKIP: {
572 skip 'Cannot test "use base qw(version)" when require is used', 3
573 unless defined $qv_declare;
574 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
575 (my $package = basename($filename)) =~ s/\.pm$//;
576 print $fh <<"EOF";
577package $package;
92dcf8ce
JP
578use base qw(version);
5791;
580EOF
f941e658
JP
581 close $fh;
582 # need to eliminate any other $qv_declare()'s
583 undef *{"main\::$qv_declare"};
584 ok(!defined(&{"main\::$qv_declare"}), "make sure we cleared $qv_declare() properly");
585 eval "use lib '.'; use $package qw/declare qv/;";
586 ok(defined(&{"main\::$qv_declare"}), "make sure we exported $qv_declare() properly");
587 isa_ok( &$qv_declare(1.2), $package);
588 unlink $filename;
589}
d69f6151
JP
590
591SKIP: {
ac0e6a2f
RGS
592 if ( $] < 5.006_000 ) {
593 skip 'Cannot "use" extended versions with Perl < 5.6.0', 3;
594 }
f941e658
JP
595 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
596 (my $package = basename($filename)) =~ s/\.pm$//;
597 print $fh <<"EOF";
598package $package;
ac0e6a2f
RGS
599\$VERSION = 1.0;
6001;
601EOF
f941e658
JP
602 close $fh;
603 eval "use lib '.'; use $package 1.001;";
604 like ($@, qr/^$package version 1.001 required/,
ac0e6a2f 605 "User typed numeric so we error with numeric");
f941e658
JP
606 eval "use lib '.'; use $package v1.1.0;";
607 like ($@, qr/^$package version v1.1.0 required/,
ac0e6a2f 608 "User typed extended so we error with extended");
f941e658 609 unlink $filename;
ac0e6a2f
RGS
610 }
611
612SKIP: {
d69f6151 613 # test locale handling
f34c6aaf
JP
614 my $warning;
615 local $SIG{__WARN__} = sub { $warning = $_[0] };
f941e658
JP
616
617$DB::single = 1;
91152fc1
DG
618 my $v = eval { $CLASS->$method('1,7') };
619# is( $@, "", 'Directly test comma as decimal compliance');
f941e658 620
d69f6151 621 my $ver = 1.23; # has to be floating point number
f941e658 622 my $orig_loc = setlocale( LC_ALL );
d69f6151
JP
623 my $loc;
624 while (<DATA>) {
625 chomp;
f941e658
JP
626 $loc = setlocale( LC_ALL, $_);
627 last if localeconv()->{decimal_point} eq ',';
d69f6151
JP
628 }
629 skip 'Cannot test locale handling without a comma locale', 4
630 unless ( $loc and ($ver eq '1,23') );
631
f941e658 632 diag ("Testing locale handling with $loc") unless $ENV{PERL_CORE};
d69f6151 633
f941e658
JP
634 $v = $CLASS->$method($ver);
635 unlike($warning, qr/Version string '1,23' contains invalid data/,
d69f6151 636 "Process locale-dependent floating point");
8cb289bd 637 is ($v, "1.23", "Locale doesn't apply to version objects");
d69f6151 638 ok ($v == $ver, "Comparison to locale floating point");
f941e658
JP
639
640 setlocale( LC_ALL, $orig_loc); # reset this before possible skip
641 skip 'Cannot test RT#46921 with Perl < 5.008', 1
642 if ($] < 5.008);
643 skip 'Cannot test RT#46921 with pure Perl module', 1
644 if exists $INC{'version/vpp.pm'};
645 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
646 (my $package = basename($filename)) =~ s/\.pm$//;
647 print $fh <<"EOF";
648package $package;
649use POSIX qw(locale_h);
650\$^W = 1;
651use $CLASS;
652setlocale (LC_ALL, '$loc');
653use $CLASS ;
654eval "use Socket 1.7";
655setlocale( LC_ALL, '$orig_loc');
6561;
657EOF
658 close $fh;
659
660 eval "use lib '.'; use $package;";
661 unlike($warning, qr"Version string '1,7' contains invalid data",
662 'Handle locale action-at-a-distance');
d69f6151 663 }
f34c6aaf 664
f941e658 665 eval 'my $v = $CLASS->$method("1._1");';
f34c6aaf
JP
666 unlike($@, qr/^Invalid version format \(alpha with zero width\)/,
667 "Invalid version format 1._1");
ac0e6a2f 668
c812d146
JP
669 {
670 my $warning;
671 local $SIG{__WARN__} = sub { $warning = $_[0] };
f941e658 672 eval 'my $v = $CLASS->$method(~0);';
c812d146
JP
673 unlike($@, qr/Integer overflow in version/, "Too large version");
674 like($warning, qr/Integer overflow in version/, "Too large version");
675 }
676
72287d96
JP
677 {
678 # http://rt.cpan.org/Public/Bug/Display.html?id=30004
f941e658 679 my $v1 = $CLASS->$method("v0.1_1");
72287d96 680 (my $alpha1 = Dumper($v1)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
f941e658 681 my $v2 = $CLASS->$method($v1);
72287d96
JP
682 (my $alpha2 = Dumper($v2)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
683 is $alpha2, $alpha1, "Don't fall for Data::Dumper's tricks";
684 }
685
219bf418
RGS
686 {
687 # http://rt.perl.org/rt3/Ticket/Display.html?id=56606
688 my $badv = bless { version => [1,2,3] }, "version";
689 is $badv, '1.002003', "Deal with badly serialized versions from YAML";
690 my $badv2 = bless { qv => 1, version => [1,2,3] }, "version";
691 is $badv2, 'v1.2.3', "Deal with badly serialized versions from YAML ";
692 }
137d6fc0 693}
cb5772bb
RGS
694
6951;
d69f6151
JP
696
697__DATA__
698af_ZA
699af_ZA.utf8
700an_ES
701an_ES.utf8
702az_AZ.utf8
703be_BY
704be_BY.utf8
705bg_BG
706bg_BG.utf8
707br_FR
708br_FR@euro
709br_FR.utf8
710bs_BA
711bs_BA.utf8
712ca_ES
713ca_ES@euro
714ca_ES.utf8
715cs_CZ
716cs_CZ.utf8
717da_DK
718da_DK.utf8
719de_AT
720de_AT@euro
721de_AT.utf8
722de_BE
723de_BE@euro
724de_BE.utf8
725de_DE
726de_DE@euro
727de_DE.utf8
728de_LU
729de_LU@euro
730de_LU.utf8
731el_GR
732el_GR.utf8
733en_DK
734en_DK.utf8
735es_AR
736es_AR.utf8
737es_BO
738es_BO.utf8
739es_CL
740es_CL.utf8
741es_CO
742es_CO.utf8
743es_EC
744es_EC.utf8
745es_ES
746es_ES@euro
747es_ES.utf8
748es_PY
749es_PY.utf8
750es_UY
751es_UY.utf8
752es_VE
753es_VE.utf8
754et_EE
755et_EE.iso885915
756et_EE.utf8
757eu_ES
758eu_ES@euro
759eu_ES.utf8
760fi_FI
761fi_FI@euro
762fi_FI.utf8
763fo_FO
764fo_FO.utf8
765fr_BE
766fr_BE@euro
767fr_BE.utf8
768fr_CA
769fr_CA.utf8
770fr_CH
771fr_CH.utf8
772fr_FR
773fr_FR@euro
774fr_FR.utf8
775fr_LU
776fr_LU@euro
777fr_LU.utf8
778gl_ES
779gl_ES@euro
780gl_ES.utf8
781hr_HR
782hr_HR.utf8
783hu_HU
784hu_HU.utf8
785id_ID
786id_ID.utf8
787is_IS
788is_IS.utf8
789it_CH
790it_CH.utf8
791it_IT
792it_IT@euro
793it_IT.utf8
794ka_GE
795ka_GE.utf8
796kk_KZ
797kk_KZ.utf8
798kl_GL
799kl_GL.utf8
800lt_LT
801lt_LT.utf8
802lv_LV
803lv_LV.utf8
804mk_MK
805mk_MK.utf8
806mn_MN
807mn_MN.utf8
808nb_NO
809nb_NO.utf8
810nl_BE
811nl_BE@euro
812nl_BE.utf8
813nl_NL
814nl_NL@euro
815nl_NL.utf8
816nn_NO
817nn_NO.utf8
818no_NO
819no_NO.utf8
820oc_FR
821oc_FR.utf8
822pl_PL
823pl_PL.utf8
824pt_BR
825pt_BR.utf8
826pt_PT
827pt_PT@euro
828pt_PT.utf8
829ro_RO
830ro_RO.utf8
831ru_RU
832ru_RU.koi8r
833ru_RU.utf8
834ru_UA
835ru_UA.utf8
836se_NO
837se_NO.utf8
838sh_YU
839sh_YU.utf8
840sk_SK
841sk_SK.utf8
842sl_SI
843sl_SI.utf8
844sq_AL
845sq_AL.utf8
846sr_CS
847sr_CS.utf8
848sv_FI
849sv_FI@euro
850sv_FI.utf8
851sv_SE
852sv_SE.iso885915
853sv_SE.utf8
854tg_TJ
855tg_TJ.utf8
856tr_TR
857tr_TR.utf8
858tt_RU.utf8
859uk_UA
860uk_UA.utf8
861vi_VN
862vi_VN.tcvn
863wa_BE
864wa_BE@euro
865wa_BE.utf8
866