This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl_gv_fetchpvn_flags() can avoid copying when the package separator is ::
[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");
9b463b21
DG
99strict_lax_tests();
100
101# do strict lax tests in a sub to isolate a package to test importing
102sub strict_lax_tests {
103 package temp12345;
104 # copied from perl core test t/op/packagev.t
105 # format: STRING STRICT_OK LAX_OK
106 my $strict_lax_data = << 'CASE_DATA';
1071.00 pass pass
1081.00001 pass pass
1090.123 pass pass
11012.345 pass pass
11142 pass pass
1120 pass pass
1130.0 pass pass
114v1.2.3 pass pass
115v1.2.3.4 pass pass
116v0.1.2 pass pass
117v0.0.0 pass pass
11801 fail pass
11901.0203 fail pass
120v01 fail pass
121v01.02.03 fail pass
122.1 fail pass
123.1.2 fail pass
1241. fail pass
1251.a fail fail
1261._ fail fail
1271.02_03 fail pass
128v1.2_3 fail pass
129v1.02_03 fail pass
130v1.2_3_4 fail fail
131v1.2_3.4 fail fail
1321.2_3.4 fail fail
1330_ fail fail
1341_ fail fail
1351_. fail fail
1361.1_ fail fail
1371.02_03_04 fail fail
1381.2.3 fail pass
139v1.2 fail pass
140v0 fail pass
141v1 fail pass
142v.1.2.3 fail fail
143v fail fail
144v1.2345.6 fail pass
145undef fail pass
1461a fail fail
1471.2a3 fail fail
148bar fail fail
149_ fail fail
150CASE_DATA
151
152 require version;
153 version->import( qw/is_strict is_lax/ );
154 for my $case ( split qr/\n/, $strict_lax_data ) {
155 my ($v, $strict, $lax) = split qr/\t+/, $case;
156 main::ok( $strict eq 'pass' ? is_strict($v) : ! is_strict($v), "is_strict($v) [$strict]" );
157 main::ok( $strict eq 'pass' ? version::is_strict($v) : ! version::is_strict($v), "version::is_strict($v) [$strict]" );
158 main::ok( $lax eq 'pass' ? is_lax($v) : ! is_lax($v), "is_lax($v) [$lax]" );
159 main::ok( $lax eq 'pass' ? version::is_lax($v) : ! version::is_lax($v), "version::is_lax($v) [$lax]" );
160 }
161}
e0218a61 162
137d6fc0
JP
163sub BaseTests {
164
f941e658 165 my ($CLASS, $method, $qv_declare) = @_;
692a467c
JP
166 my $warning;
167 local $SIG{__WARN__} = sub { $warning = $_[0] };
317f7c8a
RGS
168
169 # Insert your test code below, the Test module is use()ed here so read
170 # its man page ( perldoc Test ) for help writing this test script.
171
172 # Test bare number processing
f941e658
JP
173 diag "tests with bare numbers" unless $ENV{PERL_CORE};
174 $version = $CLASS->$method(5.005_03);
8cb289bd 175 is ( "$version" , "5.00503" , '5.005_03 eq 5.00503' );
f941e658 176 $version = $CLASS->$method(1.23);
8cb289bd 177 is ( "$version" , "1.23" , '1.23 eq "1.23"' );
317f7c8a
RGS
178
179 # Test quoted number processing
f941e658
JP
180 diag "tests with quoted numbers" unless $ENV{PERL_CORE};
181 $version = $CLASS->$method("5.005_03");
8cb289bd 182 is ( "$version" , "5.005_03" , '"5.005_03" eq "5.005_03"' );
f941e658 183 $version = $CLASS->$method("v1.23");
8cb289bd 184 is ( "$version" , "v1.23" , '"v1.23" eq "v1.23"' );
317f7c8a
RGS
185
186 # Test stringify operator
f941e658
JP
187 diag "tests with stringify" unless $ENV{PERL_CORE};
188 $version = $CLASS->$method("5.005");
317f7c8a 189 is ( "$version" , "5.005" , '5.005 eq "5.005"' );
f941e658 190 $version = $CLASS->$method("5.006.001");
8cb289bd 191 is ( "$version" , "5.006.001" , '5.006.001 eq v5.6.1' );
692a467c
JP
192 unlike ($warning, qr/v-string without leading 'v' deprecated/, 'No leading v');
193 $version = $CLASS->$method("v1.2.3_4");
194 is ( "$version" , "v1.2.3_4" , 'alpha version 1.2.3_4 eq v1.2.3_4' );
317f7c8a
RGS
195
196 # test illegal formats
f941e658 197 diag "test illegal formats" unless $ENV{PERL_CORE};
91152fc1 198 eval {$version = $CLASS->$method("1.2_3_4")};
317f7c8a
RGS
199 like($@, qr/multiple underscores/,
200 "Invalid version format (multiple underscores)");
201
91152fc1 202 eval {$version = $CLASS->$method("1.2_3.4")};
317f7c8a
RGS
203 like($@, qr/underscores before decimal/,
204 "Invalid version format (underscores before decimal)");
205
91152fc1 206 eval {$version = $CLASS->$method("1_2")};
317f7c8a
RGS
207 like($@, qr/alpha without decimal/,
208 "Invalid version format (alpha without decimal)");
209
91152fc1
DG
210 eval { $version = $CLASS->$method("1.2b3")};
211 like($@, qr/non-numeric data/,
212 "Invalid version format (non-numeric data)");
317f7c8a
RGS
213
214 # from here on out capture the warning and test independently
f34c6aaf 215 {
91152fc1 216 eval{$version = $CLASS->$method("99 and 44/100 pure")};
317f7c8a 217
91152fc1
DG
218 like($@, qr/non-numeric data/,
219 "Invalid version format (non-numeric data)");
317f7c8a 220
91152fc1
DG
221 eval{$version = $CLASS->$method("something")};
222 like($@, qr/non-numeric data/,
223 "Invalid version format (non-numeric data)");
317f7c8a
RGS
224
225 # reset the test object to something reasonable
f941e658 226 $version = $CLASS->$method("1.2.3");
317f7c8a
RGS
227
228 # Test boolean operator
229 ok ($version, 'boolean');
230
231 # Test class membership
232 isa_ok ( $version, $CLASS );
233
234 # Test comparison operators with self
f941e658 235 diag "tests with self" unless $ENV{PERL_CORE};
8cb289bd 236 is ( $version <=> $version, 0, '$version <=> $version == 0' );
317f7c8a
RGS
237 ok ( $version == $version, '$version == $version' );
238
317f7c8a
RGS
239 # Test Numeric Comparison operators
240 # test first with non-object
f941e658 241 $version = $CLASS->$method("5.006.001");
317f7c8a 242 $new_version = "5.8.0";
f941e658 243 diag "numeric tests with non-objects" unless $ENV{PERL_CORE};
317f7c8a
RGS
244 ok ( $version == $version, '$version == $version' );
245 ok ( $version < $new_version, '$version < $new_version' );
246 ok ( $new_version > $version, '$new_version > $version' );
247 ok ( $version != $new_version, '$version != $new_version' );
248
249 # now test with existing object
f941e658
JP
250 $new_version = $CLASS->$method($new_version);
251 diag "numeric tests with objects" unless $ENV{PERL_CORE};
317f7c8a
RGS
252 ok ( $version < $new_version, '$version < $new_version' );
253 ok ( $new_version > $version, '$new_version > $version' );
254 ok ( $version != $new_version, '$version != $new_version' );
255
256 # now test with actual numbers
f941e658 257 diag "numeric tests with numbers" unless $ENV{PERL_CORE};
317f7c8a
RGS
258 ok ( $version->numify() == 5.006001, '$version->numify() == 5.006001' );
259 ok ( $version->numify() <= 5.006001, '$version->numify() <= 5.006001' );
260 ok ( $version->numify() < 5.008, '$version->numify() < 5.008' );
261 #ok ( $version->numify() > v5.005_02, '$version->numify() > 5.005_02' );
262
263 # test with long decimals
f941e658
JP
264 diag "Tests with extended decimal versions" unless $ENV{PERL_CORE};
265 $version = $CLASS->$method(1.002003);
8cb289bd 266 ok ( $version == "1.2.3", '$version == "1.2.3"');
317f7c8a 267 ok ( $version->numify == 1.002003, '$version->numify == 1.002003');
f941e658 268 $version = $CLASS->$method("2002.09.30.1");
8cb289bd 269 ok ( $version == "2002.9.30.1",'$version == 2002.9.30.1');
317f7c8a
RGS
270 ok ( $version->numify == 2002.009030001,
271 '$version->numify == 2002.009030001');
272
273 # now test with alpha version form with string
f941e658 274 $version = $CLASS->$method("1.2.3");
317f7c8a 275 $new_version = "1.2.3_4";
f941e658 276 diag "numeric tests with alpha-style non-objects" unless $ENV{PERL_CORE};
8cb289bd
RGS
277 ok ( $version < $new_version, '$version < $new_version' );
278 ok ( $new_version > $version, '$new_version > $version' );
279 ok ( $version != $new_version, '$version != $new_version' );
317f7c8a 280
f941e658 281 $version = $CLASS->$method("1.2.4");
317f7c8a 282 diag "numeric tests with alpha-style non-objects"
692a467c 283 unless $ENV{PERL_CORE};
317f7c8a
RGS
284 ok ( $version > $new_version, '$version > $new_version' );
285 ok ( $new_version < $version, '$new_version < $version' );
286 ok ( $version != $new_version, '$version != $new_version' );
287
288 # now test with alpha version form with object
f941e658
JP
289 $version = $CLASS->$method("1.2.3");
290 $new_version = $CLASS->$method("1.2.3_4");
291 diag "tests with alpha-style objects" unless $ENV{PERL_CORE};
317f7c8a
RGS
292 ok ( $version < $new_version, '$version < $new_version' );
293 ok ( $new_version > $version, '$new_version > $version' );
294 ok ( $version != $new_version, '$version != $new_version' );
295 ok ( !$version->is_alpha, '!$version->is_alpha');
296 ok ( $new_version->is_alpha, '$new_version->is_alpha');
297
f941e658
JP
298 $version = $CLASS->$method("1.2.4");
299 diag "tests with alpha-style objects" unless $ENV{PERL_CORE};
317f7c8a
RGS
300 ok ( $version > $new_version, '$version > $new_version' );
301 ok ( $new_version < $version, '$new_version < $version' );
302 ok ( $version != $new_version, '$version != $new_version' );
303
f941e658
JP
304 $version = $CLASS->$method("1.2.3.4");
305 $new_version = $CLASS->$method("1.2.3_4");
317f7c8a 306 diag "tests with alpha-style objects with same subversion"
692a467c 307 unless $ENV{PERL_CORE};
317f7c8a
RGS
308 ok ( $version > $new_version, '$version > $new_version' );
309 ok ( $new_version < $version, '$new_version < $version' );
310 ok ( $version != $new_version, '$version != $new_version' );
311
f941e658
JP
312 diag "test implicit [in]equality" unless $ENV{PERL_CORE};
313 $version = $CLASS->$method("v1.2.3");
314 $new_version = $CLASS->$method("1.2.3.0");
317f7c8a 315 ok ( $version == $new_version, '$version == $new_version' );
f941e658 316 $new_version = $CLASS->$method("1.2.3_0");
317f7c8a 317 ok ( $version == $new_version, '$version == $new_version' );
f941e658 318 $new_version = $CLASS->$method("1.2.3.1");
317f7c8a 319 ok ( $version < $new_version, '$version < $new_version' );
f941e658 320 $new_version = $CLASS->$method("1.2.3_1");
317f7c8a 321 ok ( $version < $new_version, '$version < $new_version' );
f941e658 322 $new_version = $CLASS->$method("1.1.999");
317f7c8a
RGS
323 ok ( $version > $new_version, '$version > $new_version' );
324
325 # that which is not expressly permitted is forbidden
f941e658 326 diag "forbidden operations" unless $ENV{PERL_CORE};
317f7c8a
RGS
327 ok ( !eval { ++$version }, "noop ++" );
328 ok ( !eval { --$version }, "noop --" );
329 ok ( !eval { $version/1 }, "noop /" );
330 ok ( !eval { $version*3 }, "noop *" );
331 ok ( !eval { abs($version) }, "noop abs" );
137d6fc0 332
c8a14fb6 333SKIP: {
f941e658
JP
334 skip "version require'd instead of use'd, cannot test $qv_declare", 3
335 unless defined $qv_declare;
336 # test the $qv_declare() sub
337 diag "testing $qv_declare" unless $ENV{PERL_CORE};
338 $version = $CLASS->$qv_declare("1.2");
339 is ( "$version", "v1.2", $qv_declare.'("1.2") == "1.2.0"' );
340 $version = $CLASS->$qv_declare(1.2);
341 is ( "$version", "v1.2", $qv_declare.'(1.2) == "1.2.0"' );
342 isa_ok( $CLASS->$qv_declare('5.008'), $CLASS );
c8a14fb6 343}
137d6fc0 344
317f7c8a 345 # test creation from existing version object
f941e658
JP
346 diag "create new from existing version" unless $ENV{PERL_CORE};
347 ok (eval {$new_version = $CLASS->$method($version)},
317f7c8a 348 "new from existing object");
f941e658
JP
349 ok ($new_version == $version, "class->$method($version) identical");
350 $new_version = $version->$method();
317f7c8a 351 isa_ok ($new_version, $CLASS );
f941e658
JP
352 is ($new_version, "0", "version->$method() doesn't clone");
353 $new_version = $version->$method("1.2.3");
354 is ($new_version, "1.2.3" , '$version->$method("1.2.3") works too');
317f7c8a
RGS
355
356 # test the CVS revision mode
f941e658 357 diag "testing CVS Revision" unless $ENV{PERL_CORE};
317f7c8a 358 $version = new $CLASS qw$Revision: 1.2$;
8cb289bd 359 ok ( $version == "1.2.0", 'qw$Revision: 1.2$ == 1.2.0' );
317f7c8a 360 $version = new $CLASS qw$Revision: 1.2.3.4$;
8cb289bd 361 ok ( $version == "1.2.3.4", 'qw$Revision: 1.2.3.4$ == 1.2.3.4' );
317f7c8a
RGS
362
363 # test the CPAN style reduced significant digit form
f941e658
JP
364 diag "testing CPAN-style versions" unless $ENV{PERL_CORE};
365 $version = $CLASS->$method("1.23_01");
8cb289bd 366 is ( "$version" , "1.23_01", "CPAN-style alpha version" );
317f7c8a
RGS
367 ok ( $version > 1.23, "1.23_01 > 1.23");
368 ok ( $version < 1.24, "1.23_01 < 1.24");
369
370 # test reformed UNIVERSAL::VERSION
f941e658 371 diag "Replacement UNIVERSAL::VERSION tests" unless $ENV{PERL_CORE};
f34c6aaf
JP
372
373 my $error_regex = $] < 5.006
374 ? 'version \d required'
f941e658 375 : 'does not define \$t.{7}::VERSION';
317f7c8a 376
f34c6aaf 377 {
f941e658
JP
378 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
379 (my $package = basename($filename)) =~ s/\.pm$//;
380 print $fh "package $package;\n\$$package\::VERSION=0.58;\n1;\n";
381 close $fh;
f34c6aaf 382
8cb289bd 383 $version = 0.58;
f941e658
JP
384 eval "use lib '.'; use $package $version";
385 unlike($@, qr/$package version $version/,
f34c6aaf
JP
386 'Replacement eval works with exact version');
387
388 # test as class method
f941e658 389 $new_version = $package->VERSION;
8cb289bd 390 cmp_ok($new_version,'==',$version, "Called as class method");
8dd04980 391
f34c6aaf
JP
392 eval "print Completely::Unknown::Module->VERSION";
393 if ( $] < 5.008 ) {
394 unlike($@, qr/$error_regex/,
395 "Don't freak if the module doesn't even exist");
396 }
397 else {
398 unlike($@, qr/defines neither package nor VERSION/,
399 "Don't freak if the module doesn't even exist");
400 }
401
402 # this should fail even with old UNIVERSAL::VERSION
8cb289bd 403 $version += 0.01;
f941e658
JP
404 eval "use lib '.'; use $package $version";
405 like($@, qr/$package version $version/,
f34c6aaf
JP
406 'Replacement eval works with incremented version');
407
408 $version =~ s/0+$//; #convert to string and remove trailing 0's
409 chop($version); # shorten by 1 digit, should still succeed
f941e658
JP
410 eval "use lib '.'; use $package $version";
411 unlike($@, qr/$package version $version/,
f34c6aaf
JP
412 'Replacement eval works with single digit');
413
414 # this would fail with old UNIVERSAL::VERSION
8cb289bd 415 $version += 0.1;
f941e658
JP
416 eval "use lib '.'; use $package $version";
417 like($@, qr/$package version $version/,
f34c6aaf 418 'Replacement eval works with incremented digit');
f941e658 419 unlink $filename;
f34c6aaf 420 }
317f7c8a
RGS
421
422 { # dummy up some variously broken modules for testing
f941e658
JP
423 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
424 (my $package = basename($filename)) =~ s/\.pm$//;
425 print $fh "1;\n";
426 close $fh;
f34c6aaf 427
f941e658 428 eval "use lib '.'; use $package 3;";
317f7c8a 429 if ( $] < 5.008 ) {
f34c6aaf
JP
430 like($@, qr/$error_regex/,
431 'Replacement handles modules without package or VERSION');
c8a14fb6 432 }
317f7c8a 433 else {
f34c6aaf
JP
434 like($@, qr/defines neither package nor VERSION/,
435 'Replacement handles modules without package or VERSION');
c8a14fb6 436 }
f941e658 437 eval "use lib '.'; use $package; \$version = $package->VERSION";
317f7c8a
RGS
438 unlike ($@, qr/$error_regex/,
439 'Replacement handles modules without package or VERSION');
f34c6aaf 440 ok (!defined($version), "Called as class method");
f941e658 441 unlink $filename;
317f7c8a
RGS
442 }
443
444 { # dummy up some variously broken modules for testing
f941e658
JP
445 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
446 (my $package = basename($filename)) =~ s/\.pm$//;
447 print $fh "package $package;\n#look ma no VERSION\n1;\n";
448 close $fh;
449 eval "use lib '.'; use $package 3;";
f34c6aaf 450 like ($@, qr/$error_regex/,
317f7c8a 451 'Replacement handles modules without VERSION');
f941e658 452 eval "use lib '.'; use $package; print $package->VERSION";
f34c6aaf 453 unlike ($@, qr/$error_regex/,
317f7c8a 454 'Replacement handles modules without VERSION');
f941e658 455 unlink $filename;
317f7c8a
RGS
456 }
457
458 { # dummy up some variously broken modules for testing
f941e658
JP
459 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
460 (my $package = basename($filename)) =~ s/\.pm$//;
461 print $fh "package $package;\n\@VERSION = ();\n1;\n";
462 close $fh;
463 eval "use lib '.'; use $package 3;";
f34c6aaf 464 like ($@, qr/$error_regex/,
317f7c8a 465 'Replacement handles modules without VERSION');
f941e658 466 eval "use lib '.'; use $package; print $package->VERSION";
f34c6aaf 467 unlike ($@, qr/$error_regex/,
317f7c8a 468 'Replacement handles modules without VERSION');
f941e658 469 unlink $filename;
317f7c8a
RGS
470 }
471
137d6fc0 472SKIP: {
ac0e6a2f
RGS
473 skip 'Cannot test bare v-strings with Perl < 5.6.0', 4
474 if $] < 5.006_000;
f941e658
JP
475 diag "Tests with v-strings" unless $ENV{PERL_CORE};
476 $version = $CLASS->$method(1.2.3);
8cb289bd 477 ok("$version" == "v1.2.3", '"$version" == 1.2.3');
f941e658
JP
478 $version = $CLASS->$method(1.0.0);
479 $new_version = $CLASS->$method(1);
317f7c8a 480 ok($version == $new_version, '$version == $new_version');
f941e658
JP
481 skip "version require'd instead of use'd, cannot test declare", 1
482 unless defined $qv_declare;
483 $version = &$qv_declare(1.2.3);
484 ok("$version" == "v1.2.3", 'v-string initialized $qv_declare()');
317f7c8a
RGS
485 }
486
f941e658 487 diag "Tests with real-world (malformed) data" unless $ENV{PERL_CORE};
317f7c8a
RGS
488
489 # trailing zero testing (reported by Andreas Koenig).
f941e658 490 $version = $CLASS->$method("1");
317f7c8a 491 ok($version->numify eq "1.000", "trailing zeros preserved");
f941e658 492 $version = $CLASS->$method("1.0");
317f7c8a 493 ok($version->numify eq "1.000", "trailing zeros preserved");
f941e658 494 $version = $CLASS->$method("1.0.0");
317f7c8a 495 ok($version->numify eq "1.000000", "trailing zeros preserved");
f941e658 496 $version = $CLASS->$method("1.0.0.0");
317f7c8a
RGS
497 ok($version->numify eq "1.000000000", "trailing zeros preserved");
498
499 # leading zero testing (reported by Andreas Koenig).
f941e658 500 $version = $CLASS->$method(".7");
317f7c8a
RGS
501 ok($version->numify eq "0.700", "leading zero inferred");
502
503 # leading space testing (reported by Andreas Koenig).
f941e658 504 $version = $CLASS->$method(" 1.7");
317f7c8a
RGS
505 ok($version->numify eq "1.700", "leading space ignored");
506
507 # RT 19517 - deal with undef and 'undef' initialization
8cb289bd
RGS
508 ok("$version" ne 'undef', "Undef version comparison #1");
509 ok("$version" ne undef, "Undef version comparison #2");
f941e658 510 $version = $CLASS->$method('undef');
317f7c8a
RGS
511 unlike($warning, qr/^Version string 'undef' contains invalid data/,
512 "Version string 'undef'");
513
f941e658 514 $version = $CLASS->$method(undef);
317f7c8a
RGS
515 like($warning, qr/^Use of uninitialized value/,
516 "Version string 'undef'");
8cb289bd
RGS
517 ok($version == 'undef', "Undef version comparison #3");
518 ok($version == undef, "Undef version comparison #4");
f941e658 519 eval "\$version = \$CLASS->$method()"; # no parameter at all
317f7c8a 520 unlike($@, qr/^Bizarre copy of CODE/, "No initializer at all");
8cb289bd
RGS
521 ok($version == 'undef', "Undef version comparison #5");
522 ok($version == undef, "Undef version comparison #6");
317f7c8a 523
f941e658 524 $version = $CLASS->$method(0.000001);
317f7c8a
RGS
525 unlike($warning, qr/^Version string '1e-06' contains invalid data/,
526 "Very small version objects");
f34c6aaf 527 }
e0218a61 528
317f7c8a 529SKIP: {
f941e658
JP
530 my $warning;
531 local $SIG{__WARN__} = sub { $warning = $_[0] };
317f7c8a 532 # dummy up a legal module for testing RT#19017
f941e658
JP
533 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
534 (my $package = basename($filename)) =~ s/\.pm$//;
535 print $fh <<"EOF";
536package $package;
537use $CLASS; \$VERSION = ${CLASS}->new('0.0.4');
c8a14fb6
RGS
5381;
539EOF
f941e658 540 close $fh;
317f7c8a 541
f941e658
JP
542 eval "use lib '.'; use $package 0.000008;";
543 like ($@, qr/^$package version 0.000008 required/,
317f7c8a 544 "Make sure very small versions don't freak");
f941e658
JP
545 eval "use lib '.'; use $package 1;";
546 like ($@, qr/^$package version 1 required/,
317f7c8a 547 "Comparing vs. version with no decimal");
f941e658
JP
548 eval "use lib '.'; use $package 1.;";
549 like ($@, qr/^$package version 1 required/,
317f7c8a 550 "Comparing vs. version with decimal only");
ac0e6a2f 551 if ( $] < 5.006_000 ) {
ac0e6a2f 552 skip 'Cannot "use" extended versions with Perl < 5.6.0', 3;
d69f6151 553 }
f941e658
JP
554 eval "use lib '.'; use $package v0.0.8;";
555 my $regex = "^$package version v0.0.8 required";
ac0e6a2f 556 like ($@, qr/$regex/, "Make sure very small versions don't freak");
317f7c8a 557
ac0e6a2f 558 $regex =~ s/8/4/; # set for second test
f941e658 559 eval "use lib '.'; use $package v0.0.4;";
ac0e6a2f 560 unlike($@, qr/$regex/, 'Succeed - required == VERSION');
f941e658
JP
561 cmp_ok ( $package->VERSION, 'eq', '0.0.4', 'No undef warnings' );
562 unlink $filename;
317f7c8a
RGS
563 }
564
f941e658
JP
565SKIP: {
566 skip 'Cannot test "use base qw(version)" when require is used', 3
567 unless defined $qv_declare;
568 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
569 (my $package = basename($filename)) =~ s/\.pm$//;
570 print $fh <<"EOF";
571package $package;
92dcf8ce
JP
572use base qw(version);
5731;
574EOF
f941e658
JP
575 close $fh;
576 # need to eliminate any other $qv_declare()'s
577 undef *{"main\::$qv_declare"};
578 ok(!defined(&{"main\::$qv_declare"}), "make sure we cleared $qv_declare() properly");
579 eval "use lib '.'; use $package qw/declare qv/;";
580 ok(defined(&{"main\::$qv_declare"}), "make sure we exported $qv_declare() properly");
581 isa_ok( &$qv_declare(1.2), $package);
582 unlink $filename;
583}
d69f6151
JP
584
585SKIP: {
ac0e6a2f
RGS
586 if ( $] < 5.006_000 ) {
587 skip 'Cannot "use" extended versions with Perl < 5.6.0', 3;
588 }
f941e658
JP
589 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
590 (my $package = basename($filename)) =~ s/\.pm$//;
591 print $fh <<"EOF";
592package $package;
ac0e6a2f
RGS
593\$VERSION = 1.0;
5941;
595EOF
f941e658
JP
596 close $fh;
597 eval "use lib '.'; use $package 1.001;";
598 like ($@, qr/^$package version 1.001 required/,
ac0e6a2f 599 "User typed numeric so we error with numeric");
f941e658
JP
600 eval "use lib '.'; use $package v1.1.0;";
601 like ($@, qr/^$package version v1.1.0 required/,
ac0e6a2f 602 "User typed extended so we error with extended");
f941e658 603 unlink $filename;
ac0e6a2f
RGS
604 }
605
606SKIP: {
d69f6151 607 # test locale handling
f34c6aaf
JP
608 my $warning;
609 local $SIG{__WARN__} = sub { $warning = $_[0] };
f941e658
JP
610
611$DB::single = 1;
91152fc1
DG
612 my $v = eval { $CLASS->$method('1,7') };
613# is( $@, "", 'Directly test comma as decimal compliance');
f941e658 614
d69f6151 615 my $ver = 1.23; # has to be floating point number
f941e658 616 my $orig_loc = setlocale( LC_ALL );
d69f6151
JP
617 my $loc;
618 while (<DATA>) {
619 chomp;
f941e658
JP
620 $loc = setlocale( LC_ALL, $_);
621 last if localeconv()->{decimal_point} eq ',';
d69f6151
JP
622 }
623 skip 'Cannot test locale handling without a comma locale', 4
624 unless ( $loc and ($ver eq '1,23') );
625
f941e658 626 diag ("Testing locale handling with $loc") unless $ENV{PERL_CORE};
d69f6151 627
f941e658
JP
628 $v = $CLASS->$method($ver);
629 unlike($warning, qr/Version string '1,23' contains invalid data/,
d69f6151 630 "Process locale-dependent floating point");
8cb289bd 631 is ($v, "1.23", "Locale doesn't apply to version objects");
d69f6151 632 ok ($v == $ver, "Comparison to locale floating point");
f941e658
JP
633
634 setlocale( LC_ALL, $orig_loc); # reset this before possible skip
635 skip 'Cannot test RT#46921 with Perl < 5.008', 1
636 if ($] < 5.008);
637 skip 'Cannot test RT#46921 with pure Perl module', 1
638 if exists $INC{'version/vpp.pm'};
639 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
640 (my $package = basename($filename)) =~ s/\.pm$//;
641 print $fh <<"EOF";
642package $package;
643use POSIX qw(locale_h);
644\$^W = 1;
645use $CLASS;
646setlocale (LC_ALL, '$loc');
647use $CLASS ;
648eval "use Socket 1.7";
649setlocale( LC_ALL, '$orig_loc');
6501;
651EOF
652 close $fh;
653
654 eval "use lib '.'; use $package;";
655 unlike($warning, qr"Version string '1,7' contains invalid data",
656 'Handle locale action-at-a-distance');
d69f6151 657 }
f34c6aaf 658
f941e658 659 eval 'my $v = $CLASS->$method("1._1");';
f34c6aaf
JP
660 unlike($@, qr/^Invalid version format \(alpha with zero width\)/,
661 "Invalid version format 1._1");
ac0e6a2f 662
c812d146
JP
663 {
664 my $warning;
665 local $SIG{__WARN__} = sub { $warning = $_[0] };
f941e658 666 eval 'my $v = $CLASS->$method(~0);';
c812d146
JP
667 unlike($@, qr/Integer overflow in version/, "Too large version");
668 like($warning, qr/Integer overflow in version/, "Too large version");
669 }
670
72287d96
JP
671 {
672 # http://rt.cpan.org/Public/Bug/Display.html?id=30004
f941e658 673 my $v1 = $CLASS->$method("v0.1_1");
72287d96 674 (my $alpha1 = Dumper($v1)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
f941e658 675 my $v2 = $CLASS->$method($v1);
72287d96
JP
676 (my $alpha2 = Dumper($v2)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
677 is $alpha2, $alpha1, "Don't fall for Data::Dumper's tricks";
678 }
679
219bf418
RGS
680 {
681 # http://rt.perl.org/rt3/Ticket/Display.html?id=56606
682 my $badv = bless { version => [1,2,3] }, "version";
683 is $badv, '1.002003', "Deal with badly serialized versions from YAML";
684 my $badv2 = bless { qv => 1, version => [1,2,3] }, "version";
685 is $badv2, 'v1.2.3', "Deal with badly serialized versions from YAML ";
686 }
137d6fc0 687}
cb5772bb
RGS
688
6891;
d69f6151
JP
690
691__DATA__
692af_ZA
693af_ZA.utf8
694an_ES
695an_ES.utf8
696az_AZ.utf8
697be_BY
698be_BY.utf8
699bg_BG
700bg_BG.utf8
701br_FR
702br_FR@euro
703br_FR.utf8
704bs_BA
705bs_BA.utf8
706ca_ES
707ca_ES@euro
708ca_ES.utf8
709cs_CZ
710cs_CZ.utf8
711da_DK
712da_DK.utf8
713de_AT
714de_AT@euro
715de_AT.utf8
716de_BE
717de_BE@euro
718de_BE.utf8
719de_DE
720de_DE@euro
721de_DE.utf8
722de_LU
723de_LU@euro
724de_LU.utf8
725el_GR
726el_GR.utf8
727en_DK
728en_DK.utf8
729es_AR
730es_AR.utf8
731es_BO
732es_BO.utf8
733es_CL
734es_CL.utf8
735es_CO
736es_CO.utf8
737es_EC
738es_EC.utf8
739es_ES
740es_ES@euro
741es_ES.utf8
742es_PY
743es_PY.utf8
744es_UY
745es_UY.utf8
746es_VE
747es_VE.utf8
748et_EE
749et_EE.iso885915
750et_EE.utf8
751eu_ES
752eu_ES@euro
753eu_ES.utf8
754fi_FI
755fi_FI@euro
756fi_FI.utf8
757fo_FO
758fo_FO.utf8
759fr_BE
760fr_BE@euro
761fr_BE.utf8
762fr_CA
763fr_CA.utf8
764fr_CH
765fr_CH.utf8
766fr_FR
767fr_FR@euro
768fr_FR.utf8
769fr_LU
770fr_LU@euro
771fr_LU.utf8
772gl_ES
773gl_ES@euro
774gl_ES.utf8
775hr_HR
776hr_HR.utf8
777hu_HU
778hu_HU.utf8
779id_ID
780id_ID.utf8
781is_IS
782is_IS.utf8
783it_CH
784it_CH.utf8
785it_IT
786it_IT@euro
787it_IT.utf8
788ka_GE
789ka_GE.utf8
790kk_KZ
791kk_KZ.utf8
792kl_GL
793kl_GL.utf8
794lt_LT
795lt_LT.utf8
796lv_LV
797lv_LV.utf8
798mk_MK
799mk_MK.utf8
800mn_MN
801mn_MN.utf8
802nb_NO
803nb_NO.utf8
804nl_BE
805nl_BE@euro
806nl_BE.utf8
807nl_NL
808nl_NL@euro
809nl_NL.utf8
810nn_NO
811nn_NO.utf8
812no_NO
813no_NO.utf8
814oc_FR
815oc_FR.utf8
816pl_PL
817pl_PL.utf8
818pt_BR
819pt_BR.utf8
820pt_PT
821pt_PT@euro
822pt_PT.utf8
823ro_RO
824ro_RO.utf8
825ru_RU
826ru_RU.koi8r
827ru_RU.utf8
828ru_UA
829ru_UA.utf8
830se_NO
831se_NO.utf8
832sh_YU
833sh_YU.utf8
834sk_SK
835sk_SK.utf8
836sl_SI
837sl_SI.utf8
838sq_AL
839sq_AL.utf8
840sr_CS
841sr_CS.utf8
842sv_FI
843sv_FI@euro
844sv_FI.utf8
845sv_SE
846sv_SE.iso885915
847sv_SE.utf8
848tg_TJ
849tg_TJ.utf8
850tr_TR
851tr_TR.utf8
852tt_RU.utf8
853uk_UA
854uk_UA.utf8
855vi_VN
856vi_VN.tcvn
857wa_BE
858wa_BE@euro
859wa_BE.utf8
860