This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH: Synchronize version.pm CPAN with core
authorJohn Peacock <john.peacock@havurah-software.org>
Mon, 19 Aug 2013 12:16:50 +0000 (13:16 +0100)
committerSteve Hay <steve.m.hay@googlemail.com>
Mon, 19 Aug 2013 15:16:09 +0000 (16:16 +0100)
Date: Fri, 16 Aug 2013 08:59:49 -0400
Message-ID: <520E2245.3020309@havurah-software.org>

(Amended by the committer to preserve local changes in 07locale.t from
3fca3d61b552b8da4cb82e43e9eac517631ef737 (the first part of hunk #2 is not
in 0.9903) and 02aba72f9af3ac175d1dfacad3955de025cd7130 (not in 0.9903 at
all), and to fix a "tab after spaces" problem in version.pm. These changes
are being sent back upstream in CPAN RT#87513.)

cpan/version/lib/version.pm
cpan/version/t/01base.t
cpan/version/t/02derived.t
cpan/version/t/03require.t
cpan/version/t/04strict_lax.t
cpan/version/t/05sigdie.t
cpan/version/t/06noop.t
cpan/version/t/07locale.t
cpan/version/t/coretests.pm

index 27774bd..7b9d645 100644 (file)
@@ -6,7 +6,7 @@ use strict;
 
 use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
 
-$VERSION = 0.9902;
+$VERSION = 0.9903;
 
 $CLASS = 'version';
 
@@ -131,7 +131,7 @@ sub import {
        map { $args{$_} = 1 } @_
     }
     else { # no parameters at all on use line
-       %args = 
+       %args =
        (
            qv => 1,
            'UNIVERSAL::VERSION' => 1,
@@ -139,9 +139,9 @@ sub import {
     }
 
     my $callpkg = caller();
-    
+
     if (exists($args{declare})) {
-       *{$callpkg.'::declare'} = 
+       *{$callpkg.'::declare'} =
            sub {return $class->declare(shift) }
          unless defined(&{$callpkg.'::declare'});
     }
index 9aa8052..a178ab5 100644 (file)
@@ -5,14 +5,15 @@
 #########################
 
 use Test::More qw/no_plan/;
+my $Verbose;
 
 BEGIN {
     (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm';
     require $coretests;
-    use_ok('version', 0.9902);
+    use_ok('version', 0.9903);
 }
 
-diag "Tests with base class" unless $ENV{PERL_CORE};
+diag "Tests with base class" if $Verbose;
 
 BaseTests("version","new","qv");
 BaseTests("version","new","declare");
index c7afe0f..849a45a 100644 (file)
@@ -6,11 +6,12 @@
 
 use Test::More qw/no_plan/;
 use File::Temp qw/tempfile/;
+my $Verbose;
 
 BEGIN {
     (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm';
     require $coretests;
-    use_ok("version", 0.9902);
+    use_ok("version", 0.9903);
     # If we made it this far, we are ok.
 }
 
@@ -57,7 +58,7 @@ sub main_reset {
     undef &declare; undef *::declare; # avoid 'used once' warning
 }
 
-diag "Tests with empty derived class"  unless $ENV{PERL_CORE};
+diag "Tests with empty derived class"  if $Verbose;
 
 use_ok($package, 0.001);
 my $testobj = $package->new(1.002_003);
@@ -80,7 +81,7 @@ main_reset;
 use_ok($package, 0.001, "declare");
 BaseTests($package, "parse", "declare");
 
-diag "tests with bad subclass"  unless $ENV{PERL_CORE};
+diag "tests with bad subclass"  if $Verbose;
 $testobj = version::Bad->new(1.002_003);
 isa_ok( $testobj, "version::Bad" );
 eval { my $string = $testobj->numify };
index 66c6bd3..7f3e26a 100644 (file)
@@ -5,6 +5,7 @@
 #########################
 
 use Test::More qw/no_plan/;
+my $Verbose;
 
 BEGIN {
     (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm';
@@ -14,12 +15,12 @@ BEGIN {
 # Don't want to use, because we need to make sure that the import doesn't
 # fire just yet (some code does this to avoid importing qv() and delare()).
 require_ok("version");
-is $version::VERSION, 0.9902, "Make sure we have the correct class";
+is $version::VERSION, 0.9903, "Make sure we have the correct class";
 ok(!"main"->can("qv"), "We don't have the imported qv()");
 ok(!"main"->can("declare"), "We don't have the imported declare()");
 
 
-diag "Tests with base class" unless $ENV{PERL_CORE};
+diag "Tests with base class" if $Verbose;
 
 BaseTests("version","new",undef);
 BaseTests("version","parse",undef);
index 24a7215..2c94448 100644 (file)
@@ -5,6 +5,7 @@
 #########################
 
 use Test::More qw/no_plan/;
+my $Verbose;
 
 # do strict lax tests in a sub to isolate a package to test importing
 SKIP: {
index 188f185..bcc0776 100644 (file)
@@ -15,7 +15,7 @@ BEGIN {
 
 
 BEGIN {
-    use version 0.9902;
+    use version 0.9903;
 }
 
 pass "Didn't get caught by the wrong DIE handler, which is a good thing";
index 9d113ed..2f15b39 100644 (file)
@@ -7,7 +7,7 @@
 use Test::More qw/no_plan/;
 
 BEGIN {
-    use_ok('version', 0.9902);
+    use_ok('version', 0.9903);
 }
 
 my $v1 = version->new('1.2');
index d6dc8c9..dcb0536 100644 (file)
@@ -9,18 +9,21 @@ use File::Temp qw/tempfile/;
 use POSIX qw/locale_h/;
 use Test::More tests => 7;
 use Config;
+my $Verbose;
 
 BEGIN {
-    use_ok('version', 0.9902);
+    use_ok('version', 0.9903);
 }
 
 SKIP: {
-        skip 'No locale testing for Perl < 5.6.0', 6 if $] < 5.006;
-        skip 'No locale testing without d_setlocale', 6 if(!$Config{d_setlocale});
+       skip 'No locale testing for Perl < 5.6.0', 6 if $] < 5.006;
+       skip 'No locale testing without d_setlocale', 6
+           if(!$Config{d_setlocale});
+
        # test locale handling
        my $warning;
 
-        use locale;
+       use locale;
 
        local $SIG{__WARN__} = sub { $warning = $_[0] };
 
@@ -28,9 +31,9 @@ SKIP: {
        my $loc;
        my $orig_loc = setlocale(LC_NUMERIC);
        ok ($ver eq "1.23", 'Not using locale yet');  # Don't use is(),
-                                                      # because have to
-                                                      # evaluate in current
-                                                      # scope
+                                                     # because have to
+                                                     # evaluate in current
+                                                     # scope
        while (<DATA>) {
            chomp;
            $loc = setlocale( LC_ALL, $_);
@@ -39,9 +42,9 @@ SKIP: {
        skip 'Cannot test locale handling without a comma locale', 5
            unless $loc and localeconv()->{decimal_point} eq ',';
 
-       diag ("Testing locale handling with $loc") unless $ENV{PERL_CORE};
+       diag ("Testing locale handling with $loc") if $Verbose;
 
-        setlocale(LC_NUMERIC, $loc);
+       setlocale(LC_NUMERIC, $loc);
        ok ($ver eq "1,23", "Using locale: $loc");
        $v = version->new($ver);
        unlike($warning, qr/Version string '1,23' contains invalid data/,
index 15a1f1f..92aeae2 100644 (file)
@@ -2,6 +2,7 @@
 package main;
 require Test::Harness;
 *Verbose = \$Test::Harness::Verbose;
+*Verbose = 0 if $ENV{PERL_CORE};
 use Data::Dumper;
 use File::Temp qw/tempfile/;
 use File::Basename;
@@ -26,21 +27,21 @@ sub BaseTests {
     # its man page ( perldoc Test ) for help writing this test script.
 
     # Test bare number processing
-    diag "tests with bare numbers" unless $ENV{PERL_CORE};
+    diag "tests with bare numbers" if $Verbose;
     $version = $CLASS->$method(5.005_03);
     is ( "$version" , "5.00503" , '5.005_03 eq 5.00503' );
     $version = $CLASS->$method(1.23);
     is ( "$version" , "1.23" , '1.23 eq "1.23"' );
 
     # Test quoted number processing
-    diag "tests with quoted numbers" unless $ENV{PERL_CORE};
+    diag "tests with quoted numbers" if $Verbose;
     $version = $CLASS->$method("5.005_03");
     is ( "$version" , "5.005_03" , '"5.005_03" eq "5.005_03"' );
     $version = $CLASS->$method("v1.23");
     is ( "$version" , "v1.23" , '"v1.23" eq "v1.23"' );
 
     # Test stringify operator
-    diag "tests with stringify" unless $ENV{PERL_CORE};
+    diag "tests with stringify" if $Verbose;
     $version = $CLASS->$method("5.005");
     is ( "$version" , "5.005" , '5.005 eq "5.005"' );
     $version = $CLASS->$method("5.006.001");
@@ -50,7 +51,7 @@ sub BaseTests {
     is ( "$version" , "v1.2.3_4" , 'alpha version 1.2.3_4 eq v1.2.3_4' );
 
     # test illegal formats
-    diag "test illegal formats" unless $ENV{PERL_CORE};
+    diag "test illegal formats" if $Verbose;
     eval {my $version = $CLASS->$method("1.2_3_4")};
     like($@, qr/multiple underscores/,
        "Invalid version format (multiple underscores)");
@@ -92,7 +93,7 @@ sub BaseTests {
     isa_ok ( $version, $CLASS );
 
     # Test comparison operators with self
-    diag "tests with self" unless $ENV{PERL_CORE};
+    diag "tests with self" if $Verbose;
     is ( $version <=> $version, 0, '$version <=> $version == 0' );
     ok ( $version == $version, '$version == $version' );
 
@@ -100,7 +101,7 @@ sub BaseTests {
     # test first with non-object
     $version = $CLASS->$method("5.006.001");
     $new_version = "5.8.0";
-    diag "numeric tests with non-objects" unless $ENV{PERL_CORE};
+    diag "numeric tests with non-objects" if $Verbose;
     ok ( $version == $version, '$version == $version' );
     ok ( $version < $new_version, '$version < $new_version' );
     ok ( $new_version > $version, '$new_version > $version' );
@@ -108,20 +109,20 @@ sub BaseTests {
 
     # now test with existing object
     $new_version = $CLASS->$method($new_version);
-    diag "numeric tests with objects" unless $ENV{PERL_CORE};
+    diag "numeric tests with objects" if $Verbose;
     ok ( $version < $new_version, '$version < $new_version' );
     ok ( $new_version > $version, '$new_version > $version' );
     ok ( $version != $new_version, '$version != $new_version' );
 
     # now test with actual numbers
-    diag "numeric tests with numbers" unless $ENV{PERL_CORE};
+    diag "numeric tests with numbers" if $Verbose;
     ok ( $version->numify() == 5.006001, '$version->numify() == 5.006001' );
     ok ( $version->numify() <= 5.006001, '$version->numify() <= 5.006001' );
     ok ( $version->numify() < 5.008, '$version->numify() < 5.008' );
     #ok ( $version->numify() > v5.005_02, '$version->numify() > 5.005_02' );
 
     # test with long decimals
-    diag "Tests with extended decimal versions" unless $ENV{PERL_CORE};
+    diag "Tests with extended decimal versions" if $Verbose;
     $version = $CLASS->$method(1.002003);
     ok ( $version == "1.2.3", '$version == "1.2.3"');
     ok ( $version->numify == 1.002003, '$version->numify == 1.002003');
@@ -133,14 +134,14 @@ sub BaseTests {
     # now test with alpha version form with string
     $version = $CLASS->$method("1.2.3");
     $new_version = "1.2.3_4";
-    diag "numeric tests with alpha-style non-objects" unless $ENV{PERL_CORE};
+    diag "numeric tests with alpha-style non-objects" if $Verbose;
     ok ( $version < $new_version, '$version < $new_version' );
     ok ( $new_version > $version, '$new_version > $version' );
     ok ( $version != $new_version, '$version != $new_version' );
 
     $version = $CLASS->$method("1.2.4");
     diag "numeric tests with alpha-style non-objects"
-       unless $ENV{PERL_CORE};
+       if $Verbose;
     ok ( $version > $new_version, '$version > $new_version' );
     ok ( $new_version < $version, '$new_version < $version' );
     ok ( $version != $new_version, '$version != $new_version' );
@@ -148,7 +149,7 @@ sub BaseTests {
     # now test with alpha version form with object
     $version = $CLASS->$method("1.2.3");
     $new_version = $CLASS->$method("1.2.3_4");
-    diag "tests with alpha-style objects" unless $ENV{PERL_CORE};
+    diag "tests with alpha-style objects" if $Verbose;
     ok ( $version < $new_version, '$version < $new_version' );
     ok ( $new_version > $version, '$new_version > $version' );
     ok ( $version != $new_version, '$version != $new_version' );
@@ -156,7 +157,7 @@ sub BaseTests {
     ok ( $new_version->is_alpha, '$new_version->is_alpha');
 
     $version = $CLASS->$method("1.2.4");
-    diag "tests with alpha-style objects" unless $ENV{PERL_CORE};
+    diag "tests with alpha-style objects" if $Verbose;
     ok ( $version > $new_version, '$version > $new_version' );
     ok ( $new_version < $version, '$new_version < $version' );
     ok ( $version != $new_version, '$version != $new_version' );
@@ -164,12 +165,12 @@ sub BaseTests {
     $version = $CLASS->$method("1.2.3.4");
     $new_version = $CLASS->$method("1.2.3_4");
     diag "tests with alpha-style objects with same subversion"
-       unless $ENV{PERL_CORE};
+       if $Verbose;
     ok ( $version > $new_version, '$version > $new_version' );
     ok ( $new_version < $version, '$new_version < $version' );
     ok ( $version != $new_version, '$version != $new_version' );
 
-    diag "test implicit [in]equality" unless $ENV{PERL_CORE};
+    diag "test implicit [in]equality" if $Verbose;
     $version = $CLASS->$method("v1.2.3");
     $new_version = $CLASS->$method("1.2.3.0");
     ok ( $version == $new_version, '$version == $new_version' );
@@ -182,13 +183,16 @@ sub BaseTests {
     $new_version = $CLASS->$method("1.1.999");
     ok ( $version > $new_version, '$version > $new_version' );
 
-    diag "test with version class names" unless $ENV{PERL_CORE};
+    diag "test with version class names" if $Verbose;
     $version = $CLASS->$method("v1.2.3");
     eval { () = $version < 'version' };
-    like $@, qr/^Invalid version format/, "error with $version < 'version'";
+    # this test, and only this test, I have to do this or else $@ gets
+    # "reset" before like() has a chance to evaluate it.  Quite maddening!!!
+    my $err = $@;
+    like $err, qr/^Invalid version format/, "error with $version < 'version'";
 
     # that which is not expressly permitted is forbidden
-    diag "forbidden operations" unless $ENV{PERL_CORE};
+    diag "forbidden operations" if $Verbose;
     ok ( !eval { ++$version }, "noop ++" );
     ok ( !eval { --$version }, "noop --" );
     ok ( !eval { $version/1 }, "noop /" );
@@ -199,7 +203,7 @@ SKIP: {
     skip "version require'd instead of use'd, cannot test $qv_declare", 3
        unless defined $qv_declare;
     # test the $qv_declare() sub
-    diag "testing $qv_declare" unless $ENV{PERL_CORE};
+    diag "testing $qv_declare" if $Verbose;
     $version = $CLASS->$qv_declare("1.2");
     is ( "$version", "v1.2", $qv_declare.'("1.2") == "1.2.0"' );
     $version = $CLASS->$qv_declare(1.2);
@@ -208,7 +212,7 @@ SKIP: {
 }
 
     # test creation from existing version object
-    diag "create new from existing version" unless $ENV{PERL_CORE};
+    diag "create new from existing version" if $Verbose;
     ok (eval {$new_version = $CLASS->$method($version)},
            "new from existing object");
     ok ($new_version == $version, "class->$method($version) identical");
@@ -219,21 +223,21 @@ SKIP: {
     is ($new_version, "1.2.3" , '$version->$method("1.2.3") works too');
 
     # test the CVS revision mode
-    diag "testing CVS Revision" unless $ENV{PERL_CORE};
+    diag "testing CVS Revision" if $Verbose;
     $version = new $CLASS qw$Revision: 1.2$;
     ok ( $version == "1.2.0", 'qw$Revision: 1.2$ == 1.2.0' );
     $version = new $CLASS qw$Revision: 1.2.3.4$;
     ok ( $version == "1.2.3.4", 'qw$Revision: 1.2.3.4$ == 1.2.3.4' );
 
     # test the CPAN style reduced significant digit form
-    diag "testing CPAN-style versions" unless $ENV{PERL_CORE};
+    diag "testing CPAN-style versions" if $Verbose;
     $version = $CLASS->$method("1.23_01");
     is ( "$version" , "1.23_01", "CPAN-style alpha version" );
     ok ( $version > 1.23, "1.23_01 > 1.23");
     ok ( $version < 1.24, "1.23_01 < 1.24");
 
     # test reformed UNIVERSAL::VERSION
-    diag "Replacement UNIVERSAL::VERSION tests" unless $ENV{PERL_CORE};
+    diag "Replacement UNIVERSAL::VERSION tests" if $Verbose;
 
     my $error_regex = $] < 5.006
        ? 'version \d required'
@@ -351,7 +355,7 @@ SKIP:    { # https://rt.perl.org/rt3/Ticket/Display.html?id=95544
 SKIP:  {
        skip 'Cannot test bare v-strings with Perl < 5.6.0', 4
                if $] < 5.006_000;
-       diag "Tests with v-strings" unless $ENV{PERL_CORE};
+       diag "Tests with v-strings" if $Verbose;
        $version = $CLASS->$method(1.2.3);
        ok("$version" eq "v1.2.3", '"$version" eq 1.2.3');
        $version = $CLASS->$method(1.0.0);
@@ -366,14 +370,14 @@ SKIP:     {
 SKIP:  {
        skip 'Cannot test bare alpha v-strings with Perl < 5.8.1', 2
                if $] lt 5.008_001;
-       diag "Tests with bare alpha v-strings" unless $ENV{PERL_CORE};
+       diag "Tests with bare alpha v-strings" if $Verbose;
        $version = $CLASS->$method(v1.2.3_4);
        is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4"');
        $version = $CLASS->$method(eval "v1.2.3_4");
        is($version, "v1.2.3_4", '"$version" eq "v1.2.3_4" (from eval)');
     }
 
-    diag "Tests with real-world (malformed) data" unless $ENV{PERL_CORE};
+    diag "Tests with real-world (malformed) data" if $Verbose;
 
     # trailing zero testing (reported by Andreas Koenig).
     $version = $CLASS->$method("1");
@@ -452,13 +456,13 @@ EOF
     }
 
 SKIP: {
-    skip 'Cannot test "use base qw(version)"  when require is used', 3
+    skip 'Cannot test "use parent qw(version)"  when require is used', 3
        unless defined $qv_declare;
     my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
     (my $package = basename($filename)) =~ s/\.pm$//;
     print $fh <<"EOF";
 package $package;
-use base qw(version);
+use parent qw(version);
 1;
 EOF
     close $fh;