This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
7bce0ebbd91bde0c6505ac539be4b0bdaebc4ec9
[perl5.git] / lib / version.t
1 #! /usr/local/perl -w
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'
4
5 #########################
6
7 use Test::More qw(no_plan);
8 use Data::Dumper;
9 require Test::Harness;
10 no warnings 'once';
11 *Verbose = \$Test::Harness::Verbose;
12 use POSIX qw/locale_h/;
13 use File::Temp qw/tempfile/;
14 use File::Basename;
15
16 BEGIN {
17     use_ok("version", 0.77);
18     # If we made it this far, we are ok.
19 }
20
21 my $Verbose;
22
23 diag "Tests with base class" unless $ENV{PERL_CORE};
24
25 BaseTests("version","new","qv");
26 BaseTests("version","new","declare");
27 BaseTests("version","parse", "qv");
28 BaseTests("version","parse", "declare");
29
30 # dummy up a redundant call to satify David Wheeler
31 local $SIG{__WARN__} = sub { die $_[0] };
32 eval 'use version;';
33 unlike ($@, qr/^Subroutine main::declare redefined/,
34     "Only export declare once per package (to prevent redefined warnings)."); 
35
36 package version::Bad;
37 use base 'version';
38 sub new { my($self,$n)=@_;  bless \$n, $self }
39
40 package main;
41
42 my $warning;
43 local $SIG{__WARN__} = sub { $warning = $_[0] };
44 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
45 (my $package = basename($filename)) =~ s/\.pm$//;
46 print $fh <<"EOF";
47 # This is an empty subclass
48 package $package;
49 use base 'version';
50 use vars '\$VERSION';
51 \$VERSION=0.001;
52 EOF
53 close $fh;
54
55 sub 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
61 diag "Tests with empty derived class"  unless $ENV{PERL_CORE};
62
63 use_ok($package, 0.001);
64 my $testobj = $package->new(1.002_003);
65 isa_ok( $testobj, $package );
66 ok( $testobj->numify == 1.002003, "Numified correctly" );
67 ok( $testobj->stringify eq "1.002003", "Stringified correctly" );
68 ok( $testobj->normal eq "v1.2.3", "Normalified correctly" );
69
70 my $verobj = version::->new("1.2.4");
71 ok( $verobj > $testobj, "Comparison vs parent class" );
72
73 BaseTests($package, "new", "qv");
74 main_reset;
75 use_ok($package, 0.001, "declare");
76 BaseTests($package, "new", "declare");
77 main_reset;
78 use_ok($package, 0.001);
79 BaseTests($package, "parse", "qv");
80 main_reset;
81 use_ok($package, 0.001, "declare");
82 BaseTests($package, "parse", "declare");
83
84 diag "tests with bad subclass"  unless $ENV{PERL_CORE};
85 $testobj = version::Bad->new(1.002_003);
86 isa_ok( $testobj, "version::Bad" );
87 eval { my $string = $testobj->numify };
88 like($@, qr/Invalid version object/,
89     "Bad subclass numify");
90 eval { my $string = $testobj->normal };
91 like($@, qr/Invalid version object/,
92     "Bad subclass normal");
93 eval { my $string = $testobj->stringify };
94 like($@, qr/Invalid version object/,
95     "Bad subclass stringify");
96 eval { my $test = ($testobj > 1.0) };
97 like($@, qr/Invalid version object/,
98     "Bad subclass vcmp");
99 strict_lax_tests();
100
101 # do strict lax tests in a sub to isolate a package to test importing
102 sub 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';
107 1.00            pass    pass
108 1.00001         pass    pass
109 0.123           pass    pass
110 12.345          pass    pass
111 42              pass    pass
112 0               pass    pass
113 0.0             pass    pass
114 v1.2.3          pass    pass
115 v1.2.3.4        pass    pass
116 v0.1.2          pass    pass
117 v0.0.0          pass    pass
118 01              fail    pass
119 01.0203         fail    pass
120 v01             fail    pass
121 v01.02.03       fail    pass
122 .1              fail    pass
123 .1.2            fail    pass
124 1.              fail    pass
125 1.a             fail    fail
126 1._             fail    fail
127 1.02_03         fail    pass
128 v1.2_3          fail    pass
129 v1.02_03        fail    pass
130 v1.2_3_4        fail    fail
131 v1.2_3.4        fail    fail
132 1.2_3.4         fail    fail
133 0_              fail    fail
134 1_              fail    fail
135 1_.             fail    fail
136 1.1_            fail    fail
137 1.02_03_04      fail    fail
138 1.2.3           fail    pass
139 v1.2            fail    pass
140 v0              fail    pass
141 v1              fail    pass
142 v.1.2.3         fail    fail
143 v               fail    fail
144 v1.2345.6       fail    pass
145 undef           fail    pass
146 1a              fail    fail
147 1.2a3           fail    fail
148 bar             fail    fail
149 _               fail    fail
150 CASE_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 }
162
163 sub BaseTests {
164
165     my ($CLASS, $method, $qv_declare) = @_;
166     my $warning;
167     local $SIG{__WARN__} = sub { $warning = $_[0] };
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
173     diag "tests with bare numbers" unless $ENV{PERL_CORE};
174     $version = $CLASS->$method(5.005_03);
175     is ( "$version" , "5.00503" , '5.005_03 eq 5.00503' );
176     $version = $CLASS->$method(1.23);
177     is ( "$version" , "1.23" , '1.23 eq "1.23"' );
178     
179     # Test quoted number processing
180     diag "tests with quoted numbers" unless $ENV{PERL_CORE};
181     $version = $CLASS->$method("5.005_03");
182     is ( "$version" , "5.005_03" , '"5.005_03" eq "5.005_03"' );
183     $version = $CLASS->$method("v1.23");
184     is ( "$version" , "v1.23" , '"v1.23" eq "v1.23"' );
185     
186     # Test stringify operator
187     diag "tests with stringify" unless $ENV{PERL_CORE};
188     $version = $CLASS->$method("5.005");
189     is ( "$version" , "5.005" , '5.005 eq "5.005"' );
190     $version = $CLASS->$method("5.006.001");
191     is ( "$version" , "5.006.001" , '5.006.001 eq v5.6.1' );
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' );
195     
196     # test illegal formats
197     diag "test illegal formats" unless $ENV{PERL_CORE};
198     eval {$version = $CLASS->$method("1.2_3_4")};
199     like($@, qr/multiple underscores/,
200         "Invalid version format (multiple underscores)");
201     
202     eval {$version = $CLASS->$method("1.2_3.4")};
203     like($@, qr/underscores before decimal/,
204         "Invalid version format (underscores before decimal)");
205     
206     eval {$version = $CLASS->$method("1_2")};
207     like($@, qr/alpha without decimal/,
208         "Invalid version format (alpha without decimal)");
209     
210     eval { $version = $CLASS->$method("1.2b3")};
211     like($@, qr/non-numeric data/,
212         "Invalid version format (non-numeric data)");
213
214     # from here on out capture the warning and test independently
215     {
216     eval{$version = $CLASS->$method("99 and 44/100 pure")};
217
218     like($@, qr/non-numeric data/,
219         "Invalid version format (non-numeric data)");
220     
221     eval{$version = $CLASS->$method("something")};
222     like($@, qr/non-numeric data/,
223         "Invalid version format (non-numeric data)");
224     
225     # reset the test object to something reasonable
226     $version = $CLASS->$method("1.2.3");
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
235     diag "tests with self" unless $ENV{PERL_CORE};
236     is ( $version <=> $version, 0, '$version <=> $version == 0' );
237     ok ( $version == $version, '$version == $version' );
238     
239     # Test Numeric Comparison operators
240     # test first with non-object
241     $version = $CLASS->$method("5.006.001");
242     $new_version = "5.8.0";
243     diag "numeric tests with non-objects" unless $ENV{PERL_CORE};
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
250     $new_version = $CLASS->$method($new_version);
251     diag "numeric tests with objects" unless $ENV{PERL_CORE};
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
257     diag "numeric tests with numbers" unless $ENV{PERL_CORE};
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
264     diag "Tests with extended decimal versions" unless $ENV{PERL_CORE};
265     $version = $CLASS->$method(1.002003);
266     ok ( $version == "1.2.3", '$version == "1.2.3"');
267     ok ( $version->numify == 1.002003, '$version->numify == 1.002003');
268     $version = $CLASS->$method("2002.09.30.1");
269     ok ( $version == "2002.9.30.1",'$version == 2002.9.30.1');
270     ok ( $version->numify == 2002.009030001,
271         '$version->numify == 2002.009030001');
272     
273     # now test with alpha version form with string
274     $version = $CLASS->$method("1.2.3");
275     $new_version = "1.2.3_4";
276     diag "numeric tests with alpha-style non-objects" unless $ENV{PERL_CORE};
277     ok ( $version < $new_version, '$version < $new_version' );
278     ok ( $new_version > $version, '$new_version > $version' );
279     ok ( $version != $new_version, '$version != $new_version' );
280     
281     $version = $CLASS->$method("1.2.4");
282     diag "numeric tests with alpha-style non-objects"
283         unless $ENV{PERL_CORE};
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
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};
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     
298     $version = $CLASS->$method("1.2.4");
299     diag "tests with alpha-style objects" unless $ENV{PERL_CORE};
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     
304     $version = $CLASS->$method("1.2.3.4");
305     $new_version = $CLASS->$method("1.2.3_4");
306     diag "tests with alpha-style objects with same subversion"
307         unless $ENV{PERL_CORE};
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     
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");
315     ok ( $version == $new_version, '$version == $new_version' );
316     $new_version = $CLASS->$method("1.2.3_0");
317     ok ( $version == $new_version, '$version == $new_version' );
318     $new_version = $CLASS->$method("1.2.3.1");
319     ok ( $version < $new_version, '$version < $new_version' );
320     $new_version = $CLASS->$method("1.2.3_1");
321     ok ( $version < $new_version, '$version < $new_version' );
322     $new_version = $CLASS->$method("1.1.999");
323     ok ( $version > $new_version, '$version > $new_version' );
324     
325     # that which is not expressly permitted is forbidden
326     diag "forbidden operations" unless $ENV{PERL_CORE};
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" );
332
333 SKIP: {
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 );
343 }
344
345     # test creation from existing version object
346     diag "create new from existing version" unless $ENV{PERL_CORE};
347     ok (eval {$new_version = $CLASS->$method($version)},
348             "new from existing object");
349     ok ($new_version == $version, "class->$method($version) identical");
350     $new_version = $version->$method();
351     isa_ok ($new_version, $CLASS );
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');
355
356     # test the CVS revision mode
357     diag "testing CVS Revision" unless $ENV{PERL_CORE};
358     $version = new $CLASS qw$Revision: 1.2$;
359     ok ( $version == "1.2.0", 'qw$Revision: 1.2$ == 1.2.0' );
360     $version = new $CLASS qw$Revision: 1.2.3.4$;
361     ok ( $version == "1.2.3.4", 'qw$Revision: 1.2.3.4$ == 1.2.3.4' );
362     
363     # test the CPAN style reduced significant digit form
364     diag "testing CPAN-style versions" unless $ENV{PERL_CORE};
365     $version = $CLASS->$method("1.23_01");
366     is ( "$version" , "1.23_01", "CPAN-style alpha version" );
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
371     diag "Replacement UNIVERSAL::VERSION tests" unless $ENV{PERL_CORE};
372
373     my $error_regex = $] < 5.006
374         ? 'version \d required'
375         : 'does not define \$t.{7}::VERSION';
376     
377     {
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;
382
383         $version = 0.58;
384         eval "use lib '.'; use $package $version";
385         unlike($@, qr/$package version $version/,
386                 'Replacement eval works with exact version');
387         
388         # test as class method
389         $new_version = $package->VERSION;
390         cmp_ok($new_version,'==',$version, "Called as class method");
391
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
403         $version += 0.01;
404         eval "use lib '.'; use $package $version";
405         like($@, qr/$package version $version/,
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
410         eval "use lib '.'; use $package $version";
411         unlike($@, qr/$package version $version/,
412                 'Replacement eval works with single digit');
413         
414         # this would fail with old UNIVERSAL::VERSION
415         $version += 0.1;
416         eval "use lib '.'; use $package $version";
417         like($@, qr/$package version $version/,
418                 'Replacement eval works with incremented digit');
419         unlink $filename;
420     }
421
422     { # dummy up some variously broken modules for testing
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;
427
428         eval "use lib '.'; use $package 3;";
429         if ( $] < 5.008 ) {
430             like($@, qr/$error_regex/,
431                 'Replacement handles modules without package or VERSION'); 
432         }
433         else {
434             like($@, qr/defines neither package nor VERSION/,
435                 'Replacement handles modules without package or VERSION'); 
436         }
437         eval "use lib '.'; use $package; \$version = $package->VERSION";
438         unlike ($@, qr/$error_regex/,
439             'Replacement handles modules without package or VERSION'); 
440         ok (!defined($version), "Called as class method");
441         unlink $filename;
442     }
443     
444     { # dummy up some variously broken modules for testing
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;";
450         like ($@, qr/$error_regex/,
451             'Replacement handles modules without VERSION'); 
452         eval "use lib '.'; use $package; print $package->VERSION";
453         unlike ($@, qr/$error_regex/,
454             'Replacement handles modules without VERSION'); 
455         unlink $filename;
456     }
457
458     { # dummy up some variously broken modules for testing
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;";
464         like ($@, qr/$error_regex/,
465             'Replacement handles modules without VERSION'); 
466         eval "use lib '.'; use $package; print $package->VERSION";
467         unlike ($@, qr/$error_regex/,
468             'Replacement handles modules without VERSION'); 
469         unlink $filename;
470     }
471
472 SKIP:   {
473         skip 'Cannot test bare v-strings with Perl < 5.6.0', 4
474                 if $] < 5.006_000; 
475         diag "Tests with v-strings" unless $ENV{PERL_CORE};
476         $version = $CLASS->$method(1.2.3);
477         ok("$version" == "v1.2.3", '"$version" == 1.2.3');
478         $version = $CLASS->$method(1.0.0);
479         $new_version = $CLASS->$method(1);
480         ok($version == $new_version, '$version == $new_version');
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()');
485     }
486
487     diag "Tests with real-world (malformed) data" unless $ENV{PERL_CORE};
488
489     # trailing zero testing (reported by Andreas Koenig).
490     $version = $CLASS->$method("1");
491     ok($version->numify eq "1.000", "trailing zeros preserved");
492     $version = $CLASS->$method("1.0");
493     ok($version->numify eq "1.000", "trailing zeros preserved");
494     $version = $CLASS->$method("1.0.0");
495     ok($version->numify eq "1.000000", "trailing zeros preserved");
496     $version = $CLASS->$method("1.0.0.0");
497     ok($version->numify eq "1.000000000", "trailing zeros preserved");
498     
499     # leading zero testing (reported by Andreas Koenig).
500     $version = $CLASS->$method(".7");
501     ok($version->numify eq "0.700", "leading zero inferred");
502
503     # leading space testing (reported by Andreas Koenig).
504     $version = $CLASS->$method(" 1.7");
505     ok($version->numify eq "1.700", "leading space ignored");
506
507     # RT 19517 - deal with undef and 'undef' initialization
508     ok("$version" ne 'undef', "Undef version comparison #1");
509     ok("$version" ne undef, "Undef version comparison #2");
510     $version = $CLASS->$method('undef');
511     unlike($warning, qr/^Version string 'undef' contains invalid data/,
512         "Version string 'undef'");
513
514     $version = $CLASS->$method(undef);
515     like($warning, qr/^Use of uninitialized value/,
516         "Version string 'undef'");
517     ok($version == 'undef', "Undef version comparison #3");
518     ok($version ==  undef,  "Undef version comparison #4");
519     eval "\$version = \$CLASS->$method()"; # no parameter at all
520     unlike($@, qr/^Bizarre copy of CODE/, "No initializer at all");
521     ok($version == 'undef', "Undef version comparison #5");
522     ok($version ==  undef,  "Undef version comparison #6");
523
524     $version = $CLASS->$method(0.000001);
525     unlike($warning, qr/^Version string '1e-06' contains invalid data/,
526         "Very small version objects");
527     }
528
529 SKIP: {
530         my $warning;
531         local $SIG{__WARN__} = sub { $warning = $_[0] };
532         # dummy up a legal module for testing RT#19017
533         my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
534         (my $package = basename($filename)) =~ s/\.pm$//;
535         print $fh <<"EOF";
536 package $package;
537 use $CLASS; \$VERSION = ${CLASS}->new('0.0.4');
538 1;
539 EOF
540         close $fh;
541
542         eval "use lib '.'; use $package 0.000008;";
543         like ($@, qr/^$package version 0.000008 required/,
544             "Make sure very small versions don't freak"); 
545         eval "use lib '.'; use $package 1;";
546         like ($@, qr/^$package version 1 required/,
547             "Comparing vs. version with no decimal"); 
548         eval "use lib '.'; use $package 1.;";
549         like ($@, qr/^$package version 1 required/,
550             "Comparing vs. version with decimal only"); 
551         if ( $] < 5.006_000 ) {
552             skip 'Cannot "use" extended versions with Perl < 5.6.0', 3; 
553         }
554         eval "use lib '.'; use $package v0.0.8;";
555         my $regex = "^$package version v0.0.8 required";
556         like ($@, qr/$regex/, "Make sure very small versions don't freak"); 
557
558         $regex =~ s/8/4/; # set for second test
559         eval "use lib '.'; use $package v0.0.4;";
560         unlike($@, qr/$regex/, 'Succeed - required == VERSION');
561         cmp_ok ( $package->VERSION, 'eq', '0.0.4', 'No undef warnings' );
562         unlink $filename;
563     }
564
565 SKIP: {
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";
571 package $package;
572 use base qw(version);
573 1;
574 EOF
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 }
584
585 SKIP: {
586         if ( $] < 5.006_000 ) {
587             skip 'Cannot "use" extended versions with Perl < 5.6.0', 3; 
588         }
589         my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
590         (my $package = basename($filename)) =~ s/\.pm$//;
591         print $fh <<"EOF";
592 package $package;
593 \$VERSION = 1.0;
594 1;
595 EOF
596         close $fh;
597         eval "use lib '.'; use $package 1.001;";
598         like ($@, qr/^$package version 1.001 required/,
599             "User typed numeric so we error with numeric"); 
600         eval "use lib '.'; use $package v1.1.0;";
601         like ($@, qr/^$package version v1.1.0 required/,
602             "User typed extended so we error with extended"); 
603         unlink $filename;
604     }
605
606 SKIP: {
607         # test locale handling
608         my $warning;
609         local $SIG{__WARN__} = sub { $warning = $_[0] };
610
611 $DB::single = 1;
612         my $v = eval { $CLASS->$method('1,7') };
613 #       is( $@, "", 'Directly test comma as decimal compliance');
614
615         my $ver = 1.23;  # has to be floating point number
616         my $orig_loc = setlocale( LC_ALL );
617         my $loc;
618         while (<DATA>) {
619             chomp;
620             $loc = setlocale( LC_ALL, $_);
621             last if localeconv()->{decimal_point} eq ',';
622         }
623         skip 'Cannot test locale handling without a comma locale', 4
624             unless ( $loc and ($ver eq '1,23') );
625
626         diag ("Testing locale handling with $loc") unless $ENV{PERL_CORE};
627
628         $v = $CLASS->$method($ver);
629         unlike($warning, qr/Version string '1,23' contains invalid data/,
630             "Process locale-dependent floating point");
631         is ($v, "1.23", "Locale doesn't apply to version objects");
632         ok ($v == $ver, "Comparison to locale floating point");
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";
642 package $package;
643 use POSIX qw(locale_h);
644 \$^W = 1;
645 use $CLASS;
646 setlocale (LC_ALL, '$loc');
647 use $CLASS ;
648 eval "use Socket 1.7";
649 setlocale( LC_ALL, '$orig_loc');
650 1;
651 EOF
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');
657     }
658
659     eval 'my $v = $CLASS->$method("1._1");';
660     unlike($@, qr/^Invalid version format \(alpha with zero width\)/,
661         "Invalid version format 1._1");
662
663     {
664         my $warning;
665         local $SIG{__WARN__} = sub { $warning = $_[0] };
666         eval 'my $v = $CLASS->$method(~0);';
667         unlike($@, qr/Integer overflow in version/, "Too large version");
668         like($warning, qr/Integer overflow in version/, "Too large version");
669     }
670
671     {
672         # http://rt.cpan.org/Public/Bug/Display.html?id=30004
673         my $v1 = $CLASS->$method("v0.1_1");
674         (my $alpha1 = Dumper($v1)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
675         my $v2 = $CLASS->$method($v1);
676         (my $alpha2 = Dumper($v2)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
677         is $alpha2, $alpha1, "Don't fall for Data::Dumper's tricks";
678     }
679
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     }
687 }
688
689 1;
690
691 __DATA__
692 af_ZA
693 af_ZA.utf8
694 an_ES
695 an_ES.utf8
696 az_AZ.utf8
697 be_BY
698 be_BY.utf8
699 bg_BG
700 bg_BG.utf8
701 br_FR
702 br_FR@euro
703 br_FR.utf8
704 bs_BA
705 bs_BA.utf8
706 ca_ES
707 ca_ES@euro
708 ca_ES.utf8
709 cs_CZ
710 cs_CZ.utf8
711 da_DK
712 da_DK.utf8
713 de_AT
714 de_AT@euro
715 de_AT.utf8
716 de_BE
717 de_BE@euro
718 de_BE.utf8
719 de_DE
720 de_DE@euro
721 de_DE.utf8
722 de_LU
723 de_LU@euro
724 de_LU.utf8
725 el_GR
726 el_GR.utf8
727 en_DK
728 en_DK.utf8
729 es_AR
730 es_AR.utf8
731 es_BO
732 es_BO.utf8
733 es_CL
734 es_CL.utf8
735 es_CO
736 es_CO.utf8
737 es_EC
738 es_EC.utf8
739 es_ES
740 es_ES@euro
741 es_ES.utf8
742 es_PY
743 es_PY.utf8
744 es_UY
745 es_UY.utf8
746 es_VE
747 es_VE.utf8
748 et_EE
749 et_EE.iso885915
750 et_EE.utf8
751 eu_ES
752 eu_ES@euro
753 eu_ES.utf8
754 fi_FI
755 fi_FI@euro
756 fi_FI.utf8
757 fo_FO
758 fo_FO.utf8
759 fr_BE
760 fr_BE@euro
761 fr_BE.utf8
762 fr_CA
763 fr_CA.utf8
764 fr_CH
765 fr_CH.utf8
766 fr_FR
767 fr_FR@euro
768 fr_FR.utf8
769 fr_LU
770 fr_LU@euro
771 fr_LU.utf8
772 gl_ES
773 gl_ES@euro
774 gl_ES.utf8
775 hr_HR
776 hr_HR.utf8
777 hu_HU
778 hu_HU.utf8
779 id_ID
780 id_ID.utf8
781 is_IS
782 is_IS.utf8
783 it_CH
784 it_CH.utf8
785 it_IT
786 it_IT@euro
787 it_IT.utf8
788 ka_GE
789 ka_GE.utf8
790 kk_KZ
791 kk_KZ.utf8
792 kl_GL
793 kl_GL.utf8
794 lt_LT
795 lt_LT.utf8
796 lv_LV
797 lv_LV.utf8
798 mk_MK
799 mk_MK.utf8
800 mn_MN
801 mn_MN.utf8
802 nb_NO
803 nb_NO.utf8
804 nl_BE
805 nl_BE@euro
806 nl_BE.utf8
807 nl_NL
808 nl_NL@euro
809 nl_NL.utf8
810 nn_NO
811 nn_NO.utf8
812 no_NO
813 no_NO.utf8
814 oc_FR
815 oc_FR.utf8
816 pl_PL
817 pl_PL.utf8
818 pt_BR
819 pt_BR.utf8
820 pt_PT
821 pt_PT@euro
822 pt_PT.utf8
823 ro_RO
824 ro_RO.utf8
825 ru_RU
826 ru_RU.koi8r
827 ru_RU.utf8
828 ru_UA
829 ru_UA.utf8
830 se_NO
831 se_NO.utf8
832 sh_YU
833 sh_YU.utf8
834 sk_SK
835 sk_SK.utf8
836 sl_SI
837 sl_SI.utf8
838 sq_AL
839 sq_AL.utf8
840 sr_CS
841 sr_CS.utf8
842 sv_FI
843 sv_FI@euro
844 sv_FI.utf8
845 sv_SE
846 sv_SE.iso885915
847 sv_SE.utf8
848 tg_TJ
849 tg_TJ.utf8
850 tr_TR
851 tr_TR.utf8
852 tt_RU.utf8
853 uk_UA
854 uk_UA.utf8
855 vi_VN
856 vi_VN.tcvn
857 wa_BE
858 wa_BE@euro
859 wa_BE.utf8
860