This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
lib/version.t: suppress warning
[perl5.git] / lib / version.t
1 #! /usr/local/perl -w
2
3 use Test::More qw(no_plan);
4 use Data::Dumper;
5 require Test::Harness;
6 no warnings 'once';
7 *Verbose = \$Test::Harness::Verbose;
8 use POSIX qw/locale_h/;
9 use File::Temp qw/tempfile/;
10 use File::Basename;
11
12 BEGIN {
13     use_ok("version", 0.77);
14     # If we made it this far, we are ok.
15 }
16
17 my $Verbose;
18
19 diag "Tests with base class" unless $ENV{PERL_CORE};
20
21 BaseTests("version","new","qv");
22 BaseTests("version","new","declare");
23 BaseTests("version","parse", "qv");
24 BaseTests("version","parse", "declare");
25
26 # dummy up a redundant call to satisfy David Wheeler
27 local $SIG{__WARN__} = sub { die $_[0] };
28 eval 'use version;';
29 unlike ($@, qr/^Subroutine main::declare redefined/,
30     "Only export declare once per package (to prevent redefined warnings)."); 
31
32 package version::Bad;
33 use base 'version';
34 sub new { my($self,$n)=@_;  bless \$n, $self }
35
36 package main;
37
38 my $warning;
39 local $SIG{__WARN__} = sub { $warning = $_[0] };
40 my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
41 (my $package = basename($filename)) =~ s/\.pm$//;
42 print $fh <<"EOF";
43 # This is an empty subclass
44 package $package;
45 use base 'version';
46 use vars '\$VERSION';
47 \$VERSION=0.001;
48 EOF
49 close $fh;
50
51 sub main_reset {
52     delete $main::INC{'$package'};
53     undef &qv; undef *::qv; # avoid 'used once' warning
54     undef &declare; undef *::declare; # avoid 'used once' warning
55 }
56
57 diag "Tests with empty derived class"  unless $ENV{PERL_CORE};
58
59 use_ok($package, 0.001);
60 my $testobj = $package->new(1.002_003);
61 isa_ok( $testobj, $package );
62 ok( $testobj->numify == 1.002003, "Numified correctly" );
63 ok( $testobj->stringify eq "1.002003", "Stringified correctly" );
64 ok( $testobj->normal eq "v1.2.3", "Normalified correctly" );
65
66 my $verobj = version::->new("1.2.4");
67 ok( $verobj > $testobj, "Comparison vs parent class" );
68
69 BaseTests($package, "new", "qv");
70 main_reset;
71 use_ok($package, 0.001, "declare");
72 BaseTests($package, "new", "declare");
73 main_reset;
74 use_ok($package, 0.001);
75 BaseTests($package, "parse", "qv");
76 main_reset;
77 use_ok($package, 0.001, "declare");
78 BaseTests($package, "parse", "declare");
79
80 diag "tests with bad subclass"  unless $ENV{PERL_CORE};
81 $testobj = version::Bad->new(1.002_003);
82 isa_ok( $testobj, "version::Bad" );
83 eval { my $string = $testobj->numify };
84 like($@, qr/Invalid version object/,
85     "Bad subclass numify");
86 eval { my $string = $testobj->normal };
87 like($@, qr/Invalid version object/,
88     "Bad subclass normal");
89 eval { my $string = $testobj->stringify };
90 like($@, qr/Invalid version object/,
91     "Bad subclass stringify");
92 eval { my $test = ($testobj > 1.0) };
93 like($@, qr/Invalid version object/,
94     "Bad subclass vcmp");
95
96 # Invalid structure
97 eval { $a = \\version->new(1); bless $a, "version"; print "# $a\n" };
98 like($@, qr/Invalid version object/,
99     "Bad internal structure (RT#78286)");
100
101 # do strict lax tests in a sub to isolate a package to test importing
102 strict_lax_tests();
103
104 sub strict_lax_tests {
105   package temp12345;
106   # copied from perl core test t/op/packagev.t
107   # format: STRING STRICT_OK LAX_OK
108   my $strict_lax_data = << 'CASE_DATA';
109 1.00            pass    pass
110 1.00001         pass    pass
111 0.123           pass    pass
112 12.345          pass    pass
113 42              pass    pass
114 0               pass    pass
115 0.0             pass    pass
116 v1.2.3          pass    pass
117 v1.2.3.4        pass    pass
118 v0.1.2          pass    pass
119 v0.0.0          pass    pass
120 01              fail    pass
121 01.0203         fail    pass
122 v01             fail    pass
123 v01.02.03       fail    pass
124 .1              fail    pass
125 .1.2            fail    pass
126 1.              fail    pass
127 1.a             fail    fail
128 1._             fail    fail
129 1.02_03         fail    pass
130 v1.2_3          fail    pass
131 v1.02_03        fail    pass
132 v1.2_3_4        fail    fail
133 v1.2_3.4        fail    fail
134 1.2_3.4         fail    fail
135 0_              fail    fail
136 1_              fail    fail
137 1_.             fail    fail
138 1.1_            fail    fail
139 1.02_03_04      fail    fail
140 1.2.3           fail    pass
141 v1.2            fail    pass
142 v0              fail    pass
143 v1              fail    pass
144 v.1.2.3         fail    fail
145 v               fail    fail
146 v1.2345.6       fail    pass
147 undef           fail    pass
148 1a              fail    fail
149 1.2a3           fail    fail
150 bar             fail    fail
151 _               fail    fail
152 CASE_DATA
153
154   require version;
155   version->import( qw/is_strict is_lax/ );
156   for my $case ( split qr/\n/, $strict_lax_data ) {
157     my ($v, $strict, $lax) = split qr/\t+/, $case;
158     main::ok( $strict eq 'pass' ? is_strict($v) : ! is_strict($v), "is_strict($v) [$strict]" );
159     main::ok( $strict eq 'pass' ? version::is_strict($v) : ! version::is_strict($v), "version::is_strict($v) [$strict]" );
160     main::ok( $lax eq 'pass' ? is_lax($v) : ! is_lax($v), "is_lax($v) [$lax]" );
161     main::ok( $lax eq 'pass' ? version::is_lax($v) : ! version::is_lax($v), "version::is_lax($v) [$lax]" );
162   }
163 }
164
165 sub BaseTests {
166
167     my ($CLASS, $method, $qv_declare) = @_;
168     my $warning;
169     local $SIG{__WARN__} = sub { $warning = $_[0] };
170     
171     # Insert your test code below, the Test module is use()ed here so read
172     # its man page ( perldoc Test ) for help writing this test script.
173     
174     # Test bare number processing
175     diag "tests with bare numbers" unless $ENV{PERL_CORE};
176     $version = $CLASS->$method(5.005_03);
177     is ( "$version" , "5.00503" , '5.005_03 eq 5.00503' );
178     $version = $CLASS->$method(1.23);
179     is ( "$version" , "1.23" , '1.23 eq "1.23"' );
180     
181     # Test quoted number processing
182     diag "tests with quoted numbers" unless $ENV{PERL_CORE};
183     $version = $CLASS->$method("5.005_03");
184     is ( "$version" , "5.005_03" , '"5.005_03" eq "5.005_03"' );
185     $version = $CLASS->$method("v1.23");
186     is ( "$version" , "v1.23" , '"v1.23" eq "v1.23"' );
187     
188     # Test stringify operator
189     diag "tests with stringify" unless $ENV{PERL_CORE};
190     $version = $CLASS->$method("5.005");
191     is ( "$version" , "5.005" , '5.005 eq "5.005"' );
192     $version = $CLASS->$method("5.006.001");
193     is ( "$version" , "5.006.001" , '5.006.001 eq v5.6.1' );
194     unlike ($warning, qr/v-string without leading 'v' deprecated/, 'No leading v');
195     $version = $CLASS->$method("v1.2.3_4");
196     is ( "$version" , "v1.2.3_4" , 'alpha version 1.2.3_4 eq v1.2.3_4' );
197     
198     # test illegal formats
199     diag "test illegal formats" unless $ENV{PERL_CORE};
200     eval {my $version = $CLASS->$method("1.2_3_4")};
201     like($@, qr/multiple underscores/,
202         "Invalid version format (multiple underscores)");
203     
204     eval {my $version = $CLASS->$method("1.2_3.4")};
205     like($@, qr/underscores before decimal/,
206         "Invalid version format (underscores before decimal)");
207     
208     eval {my $version = $CLASS->$method("1_2")};
209     like($@, qr/alpha without decimal/,
210         "Invalid version format (alpha without decimal)");
211     
212     eval { $version = $CLASS->$method("1.2b3")};
213     like($@, qr/non-numeric data/,
214         "Invalid version format (non-numeric data)");
215
216     eval { $version = $CLASS->$method("-1.23")};
217     like($@, qr/negative version number/,
218         "Invalid version format (negative version number)");
219
220     # from here on out capture the warning and test independently
221     {
222     eval{$version = $CLASS->$method("99 and 44/100 pure")};
223
224     like($@, qr/non-numeric data/,
225         "Invalid version format (non-numeric data)");
226     
227     eval{$version = $CLASS->$method("something")};
228     like($@, qr/non-numeric data/,
229         "Invalid version format (non-numeric data)");
230     
231     # reset the test object to something reasonable
232     $version = $CLASS->$method("1.2.3");
233     
234     # Test boolean operator
235     ok ($version, 'boolean');
236     
237     # Test class membership
238     isa_ok ( $version, $CLASS );
239     
240     # Test comparison operators with self
241     diag "tests with self" unless $ENV{PERL_CORE};
242     is ( $version <=> $version, 0, '$version <=> $version == 0' );
243     ok ( $version == $version, '$version == $version' );
244     
245     # Test Numeric Comparison operators
246     # test first with non-object
247     $version = $CLASS->$method("5.006.001");
248     $new_version = "5.8.0";
249     diag "numeric tests with non-objects" unless $ENV{PERL_CORE};
250     ok ( $version == $version, '$version == $version' );
251     ok ( $version < $new_version, '$version < $new_version' );
252     ok ( $new_version > $version, '$new_version > $version' );
253     ok ( $version != $new_version, '$version != $new_version' );
254     
255     # now test with existing object
256     $new_version = $CLASS->$method($new_version);
257     diag "numeric tests with objects" unless $ENV{PERL_CORE};
258     ok ( $version < $new_version, '$version < $new_version' );
259     ok ( $new_version > $version, '$new_version > $version' );
260     ok ( $version != $new_version, '$version != $new_version' );
261     
262     # now test with actual numbers
263     diag "numeric tests with numbers" unless $ENV{PERL_CORE};
264     ok ( $version->numify() == 5.006001, '$version->numify() == 5.006001' );
265     ok ( $version->numify() <= 5.006001, '$version->numify() <= 5.006001' );
266     ok ( $version->numify() < 5.008, '$version->numify() < 5.008' );
267     #ok ( $version->numify() > v5.005_02, '$version->numify() > 5.005_02' );
268     
269     # test with long decimals
270     diag "Tests with extended decimal versions" unless $ENV{PERL_CORE};
271     $version = $CLASS->$method(1.002003);
272     ok ( $version == "1.2.3", '$version == "1.2.3"');
273     ok ( $version->numify == 1.002003, '$version->numify == 1.002003');
274     $version = $CLASS->$method("2002.09.30.1");
275     ok ( $version == "2002.9.30.1",'$version == 2002.9.30.1');
276     ok ( $version->numify == 2002.009030001,
277         '$version->numify == 2002.009030001');
278     
279     # now test with alpha version form with string
280     $version = $CLASS->$method("1.2.3");
281     $new_version = "1.2.3_4";
282     diag "numeric tests with alpha-style non-objects" unless $ENV{PERL_CORE};
283     ok ( $version < $new_version, '$version < $new_version' );
284     ok ( $new_version > $version, '$new_version > $version' );
285     ok ( $version != $new_version, '$version != $new_version' );
286     
287     $version = $CLASS->$method("1.2.4");
288     diag "numeric tests with alpha-style non-objects"
289         unless $ENV{PERL_CORE};
290     ok ( $version > $new_version, '$version > $new_version' );
291     ok ( $new_version < $version, '$new_version < $version' );
292     ok ( $version != $new_version, '$version != $new_version' );
293     
294     # now test with alpha version form with object
295     $version = $CLASS->$method("1.2.3");
296     $new_version = $CLASS->$method("1.2.3_4");
297     diag "tests with alpha-style objects" unless $ENV{PERL_CORE};
298     ok ( $version < $new_version, '$version < $new_version' );
299     ok ( $new_version > $version, '$new_version > $version' );
300     ok ( $version != $new_version, '$version != $new_version' );
301     ok ( !$version->is_alpha, '!$version->is_alpha');
302     ok ( $new_version->is_alpha, '$new_version->is_alpha');
303     
304     $version = $CLASS->$method("1.2.4");
305     diag "tests with alpha-style objects" unless $ENV{PERL_CORE};
306     ok ( $version > $new_version, '$version > $new_version' );
307     ok ( $new_version < $version, '$new_version < $version' );
308     ok ( $version != $new_version, '$version != $new_version' );
309     
310     $version = $CLASS->$method("1.2.3.4");
311     $new_version = $CLASS->$method("1.2.3_4");
312     diag "tests with alpha-style objects with same subversion"
313         unless $ENV{PERL_CORE};
314     ok ( $version > $new_version, '$version > $new_version' );
315     ok ( $new_version < $version, '$new_version < $version' );
316     ok ( $version != $new_version, '$version != $new_version' );
317     
318     diag "test implicit [in]equality" unless $ENV{PERL_CORE};
319     $version = $CLASS->$method("v1.2.3");
320     $new_version = $CLASS->$method("1.2.3.0");
321     ok ( $version == $new_version, '$version == $new_version' );
322     $new_version = $CLASS->$method("1.2.3_0");
323     ok ( $version == $new_version, '$version == $new_version' );
324     $new_version = $CLASS->$method("1.2.3.1");
325     ok ( $version < $new_version, '$version < $new_version' );
326     $new_version = $CLASS->$method("1.2.3_1");
327     ok ( $version < $new_version, '$version < $new_version' );
328     $new_version = $CLASS->$method("1.1.999");
329     ok ( $version > $new_version, '$version > $new_version' );
330     
331     diag "test with version class names" unless $ENV{PERL_CORE};
332     $version = $CLASS->$method("v1.2.3");
333     eval { () = $version < $CLASS };
334     like $@, qr/^Invalid version format/, "error with $version < $CLASS";
335     
336     # that which is not expressly permitted is forbidden
337     diag "forbidden operations" unless $ENV{PERL_CORE};
338     ok ( !eval { ++$version }, "noop ++" );
339     ok ( !eval { --$version }, "noop --" );
340     ok ( !eval { $version/1 }, "noop /" );
341     ok ( !eval { $version*3 }, "noop *" );
342     ok ( !eval { abs($version) }, "noop abs" );
343
344 SKIP: {
345     skip "version require'd instead of use'd, cannot test $qv_declare", 3
346         unless defined $qv_declare;
347     # test the $qv_declare() sub
348     diag "testing $qv_declare" unless $ENV{PERL_CORE};
349     $version = $CLASS->$qv_declare("1.2");
350     is ( "$version", "v1.2", $qv_declare.'("1.2") == "1.2.0"' );
351     $version = $CLASS->$qv_declare(1.2);
352     is ( "$version", "v1.2", $qv_declare.'(1.2) == "1.2.0"' );
353     isa_ok( $CLASS->$qv_declare('5.008'), $CLASS );
354 }
355
356     # test creation from existing version object
357     diag "create new from existing version" unless $ENV{PERL_CORE};
358     ok (eval {$new_version = $CLASS->$method($version)},
359             "new from existing object");
360     ok ($new_version == $version, "class->$method($version) identical");
361     $new_version = $version->$method(0);
362     isa_ok ($new_version, $CLASS );
363     is ($new_version, "0", "version->$method() doesn't clone");
364     $new_version = $version->$method("1.2.3");
365     is ($new_version, "1.2.3" , '$version->$method("1.2.3") works too');
366
367     # test the CVS revision mode
368     diag "testing CVS Revision" unless $ENV{PERL_CORE};
369     $version = new $CLASS qw$Revision: 1.2$;
370     ok ( $version == "1.2.0", 'qw$Revision: 1.2$ == 1.2.0' );
371     $version = new $CLASS qw$Revision: 1.2.3.4$;
372     ok ( $version == "1.2.3.4", 'qw$Revision: 1.2.3.4$ == 1.2.3.4' );
373     
374     # test the CPAN style reduced significant digit form
375     diag "testing CPAN-style versions" unless $ENV{PERL_CORE};
376     $version = $CLASS->$method("1.23_01");
377     is ( "$version" , "1.23_01", "CPAN-style alpha version" );
378     ok ( $version > 1.23, "1.23_01 > 1.23");
379     ok ( $version < 1.24, "1.23_01 < 1.24");
380
381     # test reformed UNIVERSAL::VERSION
382     diag "Replacement UNIVERSAL::VERSION tests" unless $ENV{PERL_CORE};
383
384     my $error_regex = $] < 5.006
385         ? 'version \d required'
386         : 'does not define \$t.{7}::VERSION';
387     
388     {
389         my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
390         (my $package = basename($filename)) =~ s/\.pm$//;
391         print $fh "package $package;\n\$$package\::VERSION=0.58;\n1;\n";
392         close $fh;
393
394         $version = 0.58;
395         eval "use lib '.'; use $package $version";
396         unlike($@, qr/$package version $version/,
397                 'Replacement eval works with exact version');
398         
399         # test as class method
400         $new_version = $package->VERSION;
401         cmp_ok($new_version,'==',$version, "Called as class method");
402
403         eval "print Completely::Unknown::Module->VERSION";
404         if ( $] < 5.008 ) {
405             unlike($@, qr/$error_regex/,
406                 "Don't freak if the module doesn't even exist");
407         }
408         else {
409             unlike($@, qr/defines neither package nor VERSION/,
410                 "Don't freak if the module doesn't even exist");
411         }
412
413         # this should fail even with old UNIVERSAL::VERSION
414         $version += 0.01;
415         eval "use lib '.'; use $package $version";
416         like($@, qr/$package version $version/,
417                 'Replacement eval works with incremented version');
418         
419         $version =~ s/0+$//; #convert to string and remove trailing 0's
420         chop($version); # shorten by 1 digit, should still succeed
421         eval "use lib '.'; use $package $version";
422         unlike($@, qr/$package version $version/,
423                 'Replacement eval works with single digit');
424         
425         # this would fail with old UNIVERSAL::VERSION
426         $version += 0.1;
427         eval "use lib '.'; use $package $version";
428         like($@, qr/$package version $version/,
429                 'Replacement eval works with incremented digit');
430         unlink $filename;
431     }
432
433     { # dummy up some variously broken modules for testing
434         my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
435         (my $package = basename($filename)) =~ s/\.pm$//;
436         print $fh "1;\n";
437         close $fh;
438
439         eval "use lib '.'; use $package 3;";
440         if ( $] < 5.008 ) {
441             like($@, qr/$error_regex/,
442                 'Replacement handles modules without package or VERSION'); 
443         }
444         else {
445             like($@, qr/defines neither package nor VERSION/,
446                 'Replacement handles modules without package or VERSION'); 
447         }
448         eval "use lib '.'; use $package; \$version = $package->VERSION";
449         unlike ($@, qr/$error_regex/,
450             'Replacement handles modules without package or VERSION'); 
451         ok (!defined($version), "Called as class method");
452         unlink $filename;
453     }
454     
455     { # dummy up some variously broken modules for testing
456         my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
457         (my $package = basename($filename)) =~ s/\.pm$//;
458         print $fh "package $package;\n#look ma no VERSION\n1;\n";
459         close $fh;
460         eval "use lib '.'; use $package 3;";
461         like ($@, qr/$error_regex/,
462             'Replacement handles modules without VERSION'); 
463         eval "use lib '.'; use $package; print $package->VERSION";
464         unlike ($@, qr/$error_regex/,
465             'Replacement handles modules without VERSION'); 
466         unlink $filename;
467     }
468
469     { # dummy up some variously broken modules for testing
470         my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
471         (my $package = basename($filename)) =~ s/\.pm$//;
472         print $fh "package $package;\n\@VERSION = ();\n1;\n";
473         close $fh;
474         eval "use lib '.'; use $package 3;";
475         like ($@, qr/$error_regex/,
476             'Replacement handles modules without VERSION'); 
477         eval "use lib '.'; use $package; print $package->VERSION";
478         unlike ($@, qr/$error_regex/,
479             'Replacement handles modules without VERSION'); 
480         unlink $filename;
481     }
482 SKIP:    { # https://rt.perl.org/rt3/Ticket/Display.html?id=95544
483         skip "version require'd instead of use'd, cannot test UNIVERSAL::VERSION", 2
484             unless defined $qv_declare;
485         my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
486         (my $package = basename($filename)) =~ s/\.pm$//;
487         print $fh "package $package;\n\$VERSION = '3alpha';\n1;\n";
488         close $fh;
489         eval "use lib '.'; use $package; die $package->VERSION";
490         ok ($@ =~ /3alpha/, 'Even a bad $VERSION is returned');
491         eval "use lib '.'; use $package;";
492         unlike ($@, qr/Invalid version format \(non-numeric data\)/,
493             'Do not warn about bad $VERSION unless asked');
494         eval "use lib '.'; use $package 1;";
495         like ($@, qr/Invalid version format \(non-numeric data\)/,
496             'Warn about bad $VERSION when asked');
497     }
498
499 SKIP:   {
500         skip 'Cannot test bare v-strings with Perl < 5.6.0', 4
501                 if $] < 5.006_000; 
502         diag "Tests with v-strings" unless $ENV{PERL_CORE};
503         $version = $CLASS->$method(1.2.3);
504         ok("$version" eq "v1.2.3", '"$version" eq 1.2.3');
505         $version = $CLASS->$method(1.0.0);
506         $new_version = $CLASS->$method(1);
507         ok($version == $new_version, '$version == $new_version');
508         skip "version require'd instead of use'd, cannot test declare", 1
509             unless defined $qv_declare;
510         $version = &$qv_declare(1.2.3);
511         ok("$version" eq "v1.2.3", 'v-string initialized $qv_declare()');
512     }
513
514 SKIP:   {
515         skip 'Cannot test bare alpha v-strings with Perl < 5.8.1', 2
516                 if $] lt 5.008_001; 
517         diag "Tests with bare alpha v-strings" unless $ENV{PERL_CORE};
518         $version = $CLASS->$method(v1.2.3_4);
519         is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4"');
520         $version = $CLASS->$method(eval "v1.2.3_4");
521         is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4" (from eval)');
522     }
523
524     diag "Tests with real-world (malformed) data" unless $ENV{PERL_CORE};
525
526     # trailing zero testing (reported by Andreas Koenig).
527     $version = $CLASS->$method("1");
528     ok($version->numify eq "1.000", "trailing zeros preserved");
529     $version = $CLASS->$method("1.0");
530     ok($version->numify eq "1.000", "trailing zeros preserved");
531     $version = $CLASS->$method("1.0.0");
532     ok($version->numify eq "1.000000", "trailing zeros preserved");
533     $version = $CLASS->$method("1.0.0.0");
534     ok($version->numify eq "1.000000000", "trailing zeros preserved");
535     
536     # leading zero testing (reported by Andreas Koenig).
537     $version = $CLASS->$method(".7");
538     ok($version->numify eq "0.700", "leading zero inferred");
539
540     # leading space testing (reported by Andreas Koenig).
541     $version = $CLASS->$method(" 1.7");
542     ok($version->numify eq "1.700", "leading space ignored");
543
544     # RT 19517 - deal with undef and 'undef' initialization
545     ok("$version" ne 'undef', "Undef version comparison #1");
546     ok("$version" ne undef, "Undef version comparison #2");
547     $version = $CLASS->$method('undef');
548     unlike($warning, qr/^Version string 'undef' contains invalid data/,
549         "Version string 'undef'");
550
551     $version = $CLASS->$method(undef);
552     like($warning, qr/^Use of uninitialized value/,
553         "Version string 'undef'");
554     ok($version == 'undef', "Undef version comparison #3");
555     ok($version ==  undef,  "Undef version comparison #4");
556     eval "\$version = \$CLASS->$method()"; # no parameter at all
557     unlike($@, qr/^Bizarre copy of CODE/, "No initializer at all");
558     ok($version == 'undef', "Undef version comparison #5");
559     ok($version ==  undef,  "Undef version comparison #6");
560
561     $version = $CLASS->$method(0.000001);
562     unlike($warning, qr/^Version string '1e-06' contains invalid data/,
563         "Very small version objects");
564     }
565
566 SKIP: {
567         my $warning;
568         local $SIG{__WARN__} = sub { $warning = $_[0] };
569         # dummy up a legal module for testing RT#19017
570         my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
571         (my $package = basename($filename)) =~ s/\.pm$//;
572         print $fh <<"EOF";
573 package $package;
574 use $CLASS; \$VERSION = ${CLASS}->new('0.0.4');
575 1;
576 EOF
577         close $fh;
578
579         eval "use lib '.'; use $package 0.000008;";
580         like ($@, qr/^$package version 0.000008 required/,
581             "Make sure very small versions don't freak"); 
582         eval "use lib '.'; use $package 1;";
583         like ($@, qr/^$package version 1 required/,
584             "Comparing vs. version with no decimal"); 
585         eval "use lib '.'; use $package 1.;";
586         like ($@, qr/^$package version 1 required/,
587             "Comparing vs. version with decimal only"); 
588         if ( $] < 5.006_000 ) {
589             skip 'Cannot "use" extended versions with Perl < 5.6.0', 3; 
590         }
591         eval "use lib '.'; use $package v0.0.8;";
592         my $regex = "^$package version v0.0.8 required";
593         like ($@, qr/$regex/, "Make sure very small versions don't freak"); 
594
595         $regex =~ s/8/4/; # set for second test
596         eval "use lib '.'; use $package v0.0.4;";
597         unlike($@, qr/$regex/, 'Succeed - required == VERSION');
598         cmp_ok ( $package->VERSION, 'eq', '0.0.4', 'No undef warnings' );
599         unlink $filename;
600     }
601
602 SKIP: {
603     skip 'Cannot test "use base qw(version)"  when require is used', 3
604         unless defined $qv_declare;
605     my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
606     (my $package = basename($filename)) =~ s/\.pm$//;
607     print $fh <<"EOF";
608 package $package;
609 use base qw(version);
610 1;
611 EOF
612     close $fh;
613     # need to eliminate any other $qv_declare()'s
614     undef *{"main\::$qv_declare"};
615     ok(!defined(&{"main\::$qv_declare"}), "make sure we cleared $qv_declare() properly");
616     eval "use lib '.'; use $package qw/declare qv/;";
617     ok(defined(&{"main\::$qv_declare"}), "make sure we exported $qv_declare() properly");
618     isa_ok( &$qv_declare(1.2), $package);
619     unlink $filename;
620 }
621
622 SKIP: {
623         if ( $] < 5.006_000 ) {
624             skip 'Cannot "use" extended versions with Perl < 5.6.0', 3; 
625         }
626         my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
627         (my $package = basename($filename)) =~ s/\.pm$//;
628         print $fh <<"EOF";
629 package $package;
630 \$VERSION = 1.0;
631 1;
632 EOF
633         close $fh;
634         eval "use lib '.'; use $package 1.001;";
635         like ($@, qr/^$package version 1.001 required/,
636             "User typed numeric so we error with numeric"); 
637         eval "use lib '.'; use $package v1.1.0;";
638         like ($@, qr/^$package version v1.1.0 required/,
639             "User typed extended so we error with extended"); 
640         unlink $filename;
641     }
642
643 SKIP: {
644         # test locale handling
645         my $warning;
646         local $SIG{__WARN__} = sub { $warning = $_[0] };
647
648         my $v = eval { $CLASS->$method('1,7') };
649 #       is( $@, "", 'Directly test comma as decimal compliance');
650
651         my $ver = 1.23;  # has to be floating point number
652         my $orig_loc = setlocale( LC_ALL );
653         my $loc;
654         while (<DATA>) {
655             chomp;
656             $loc = setlocale( LC_ALL, $_);
657             last if localeconv()->{decimal_point} eq ',';
658         }
659         skip 'Cannot test locale handling without a comma locale', 4
660             unless ( $loc and ($ver eq '1,23') );
661
662         diag ("Testing locale handling with $loc") unless $ENV{PERL_CORE};
663
664         $v = $CLASS->$method($ver);
665         unlike($warning, qr/Version string '1,23' contains invalid data/,
666             "Process locale-dependent floating point");
667         is ($v, "1.23", "Locale doesn't apply to version objects");
668         ok ($v == $ver, "Comparison to locale floating point");
669
670         setlocale( LC_ALL, $orig_loc); # reset this before possible skip
671         skip 'Cannot test RT#46921 with Perl < 5.008', 1
672             if ($] < 5.008);
673         skip 'Cannot test RT#46921 with pure Perl module', 1
674             if exists $INC{'version/vpp.pm'};
675         my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
676         (my $package = basename($filename)) =~ s/\.pm$//;
677         print $fh <<"EOF";
678 package $package;
679 use POSIX qw(locale_h);
680 \$^W = 1;
681 use $CLASS;
682 setlocale (LC_ALL, '$loc');
683 use $CLASS ;
684 eval "use Socket 1.7";
685 setlocale( LC_ALL, '$orig_loc');
686 1;
687 EOF
688         close $fh;
689
690         eval "use lib '.'; use $package;";
691         unlike($warning, qr"Version string '1,7' contains invalid data",
692             'Handle locale action-at-a-distance');
693     }
694
695     eval 'my $v = $CLASS->$method("1._1");';
696     unlike($@, qr/^Invalid version format \(alpha with zero width\)/,
697         "Invalid version format 1._1");
698
699     {
700         my $warning;
701         local $SIG{__WARN__} = sub { $warning = $_[0] };
702         eval 'my $v = $CLASS->$method(~0);';
703         unlike($@, qr/Integer overflow in version/, "Too large version");
704         like($warning, qr/Integer overflow in version/, "Too large version");
705     }
706
707     {
708         # http://rt.cpan.org/Public/Bug/Display.html?id=30004
709         my $v1 = $CLASS->$method("v0.1_1");
710         (my $alpha1 = Dumper($v1)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
711         my $v2 = $CLASS->$method($v1);
712         (my $alpha2 = Dumper($v2)) =~ s/.+'alpha' => ([^,]+),.+/$1/ms;
713         is $alpha2, $alpha1, "Don't fall for Data::Dumper's tricks";
714     }
715
716     {
717         # http://rt.perl.org/rt3/Ticket/Display.html?id=56606
718         my $badv = bless { version => [1,2,3] }, "version";
719         is $badv, '1.002003', "Deal with badly serialized versions from YAML";  
720         my $badv2 = bless { qv => 1, version => [1,2,3] }, "version";
721         is $badv2, 'v1.2.3', "Deal with badly serialized versions from YAML ";  
722     }
723 SKIP: {
724         if ( $] < 5.006_000 ) {
725             skip 'No v-string support at all < 5.6.0', 2; 
726         }
727         # https://rt.cpan.org/Ticket/Display.html?id=49348
728         my $v = $CLASS->$method("420");
729         is "$v", "420", 'Correctly guesses this is not a v-string';
730         $v = $CLASS->$method(4.2.0);
731         is "$v", 'v4.2.0', 'Correctly guess that this is a v-string';
732     }
733 SKIP: {
734         if ( $] < 5.006_000 ) {
735             skip 'No v-string support at all < 5.6.0', 4; 
736         }
737         # https://rt.cpan.org/Ticket/Display.html?id=50347
738         # Check that the qv() implementation does not change
739
740         ok $CLASS->$method(1.2.3) < $CLASS->$method(1.2.3.1), 'Compare 3 and 4 digit v-strings' ;
741         ok $CLASS->$method(v1.2.3) < $CLASS->$method(v1.2.3.1), 'Compare 3 and 4 digit v-strings, leaving v';
742         ok $CLASS->$method("1.2.3") < $CLASS->$method("1.2.3.1"), 'Compare 3 and 4 digit v-strings, quoted';
743         ok $CLASS->$method("v1.2.3") < $CLASS->$method("v1.2.3.1"), 'Compare 3 and 4 digit v-strings, quoted leading v';
744     }
745 }
746
747 eval { version->new("version") };
748 pass('no crash with version->new("version")');
749 {
750     package _102586;
751     sub TIESCALAR { bless [] }
752     sub FETCH { "version" }
753     sub STORE { }
754     tie my $v, __PACKAGE__;
755     $v = version->new(1);
756     eval { version->new($v) };
757 }
758 pass('no crash with version->new($tied) where $tied returns "version"');
759
760 1;
761
762 __DATA__
763 af_ZA
764 af_ZA.utf8
765 an_ES
766 an_ES.utf8
767 az_AZ.utf8
768 be_BY
769 be_BY.utf8
770 bg_BG
771 bg_BG.utf8
772 br_FR
773 br_FR@euro
774 br_FR.utf8
775 bs_BA
776 bs_BA.utf8
777 ca_ES
778 ca_ES@euro
779 ca_ES.utf8
780 cs_CZ
781 cs_CZ.utf8
782 da_DK
783 da_DK.utf8
784 de_AT
785 de_AT@euro
786 de_AT.utf8
787 de_BE
788 de_BE@euro
789 de_BE.utf8
790 de_DE
791 de_DE@euro
792 de_DE.utf8
793 de_LU
794 de_LU@euro
795 de_LU.utf8
796 el_GR
797 el_GR.utf8
798 en_DK
799 en_DK.utf8
800 es_AR
801 es_AR.utf8
802 es_BO
803 es_BO.utf8
804 es_CL
805 es_CL.utf8
806 es_CO
807 es_CO.utf8
808 es_EC
809 es_EC.utf8
810 es_ES
811 es_ES@euro
812 es_ES.utf8
813 es_PY
814 es_PY.utf8
815 es_UY
816 es_UY.utf8
817 es_VE
818 es_VE.utf8
819 et_EE
820 et_EE.iso885915
821 et_EE.utf8
822 eu_ES
823 eu_ES@euro
824 eu_ES.utf8
825 fi_FI
826 fi_FI@euro
827 fi_FI.utf8
828 fo_FO
829 fo_FO.utf8
830 fr_BE
831 fr_BE@euro
832 fr_BE.utf8
833 fr_CA
834 fr_CA.utf8
835 fr_CH
836 fr_CH.utf8
837 fr_FR
838 fr_FR@euro
839 fr_FR.utf8
840 fr_LU
841 fr_LU@euro
842 fr_LU.utf8
843 gl_ES
844 gl_ES@euro
845 gl_ES.utf8
846 hr_HR
847 hr_HR.utf8
848 hu_HU
849 hu_HU.utf8
850 id_ID
851 id_ID.utf8
852 is_IS
853 is_IS.utf8
854 it_CH
855 it_CH.utf8
856 it_IT
857 it_IT@euro
858 it_IT.utf8
859 ka_GE
860 ka_GE.utf8
861 kk_KZ
862 kk_KZ.utf8
863 kl_GL
864 kl_GL.utf8
865 lt_LT
866 lt_LT.utf8
867 lv_LV
868 lv_LV.utf8
869 mk_MK
870 mk_MK.utf8
871 mn_MN
872 mn_MN.utf8
873 nb_NO
874 nb_NO.utf8
875 nl_BE
876 nl_BE@euro
877 nl_BE.utf8
878 nl_NL
879 nl_NL@euro
880 nl_NL.utf8
881 nn_NO
882 nn_NO.utf8
883 no_NO
884 no_NO.utf8
885 oc_FR
886 oc_FR.utf8
887 pl_PL
888 pl_PL.utf8
889 pt_BR
890 pt_BR.utf8
891 pt_PT
892 pt_PT@euro
893 pt_PT.utf8
894 ro_RO
895 ro_RO.utf8
896 ru_RU
897 ru_RU.koi8r
898 ru_RU.utf8
899 ru_UA
900 ru_UA.utf8
901 se_NO
902 se_NO.utf8
903 sh_YU
904 sh_YU.utf8
905 sk_SK
906 sk_SK.utf8
907 sl_SI
908 sl_SI.utf8
909 sq_AL
910 sq_AL.utf8
911 sr_CS
912 sr_CS.utf8
913 sv_FI
914 sv_FI@euro
915 sv_FI.utf8
916 sv_SE
917 sv_SE.iso885915
918 sv_SE.utf8
919 tg_TJ
920 tg_TJ.utf8
921 tr_TR
922 tr_TR.utf8
923 tt_RU.utf8
924 uk_UA
925 uk_UA.utf8
926 vi_VN
927 vi_VN.tcvn
928 wa_BE
929 wa_BE@euro
930 wa_BE.utf8
931