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