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