In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/5565c73819a0eed045991803240cb7122b86b800?hp=db76cb3c1e2e7b3cb18b6ea4cef832197fd90c8e>
- Log ----------------------------------------------------------------- commit 5565c73819a0eed045991803240cb7122b86b800 Author: Steve Hay <[email protected]> Date: Tue Sep 3 08:48:47 2013 +0100 version has been upgraded from version 0.9903 to 0.9904 M MANIFEST M Porting/Maintainers.pl M pod/perldelta.pod M t/porting/customized.dat commit 0c1d6ad7c56336f44f5ca9213891dc048565bb49 Author: John Peacock <[email protected]> Date: Mon Sep 2 18:49:50 2013 -0400 Sync core with CPAN version.pm release Remove pointless diag lines, which were more trouble than they were worth. Add code to ensure that SV's with magic are handled properly, and include a test for it as well. A couple of whitespace changes and one last set of I32 -> SSize_t upgrade for array indices. M cpan/version/lib/version.pm M cpan/version/t/01base.t M cpan/version/t/02derived.t M cpan/version/t/03require.t M cpan/version/t/05sigdie.t M cpan/version/t/06noop.t M cpan/version/t/07locale.t A cpan/version/t/08_corelist.t M cpan/version/t/coretests.pm M universal.c M util.c ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + Porting/Maintainers.pl | 8 ++------ cpan/version/lib/version.pm | 2 +- cpan/version/t/01base.t | 5 +---- cpan/version/t/02derived.t | 6 +----- cpan/version/t/03require.t | 6 +----- cpan/version/t/05sigdie.t | 3 +-- cpan/version/t/06noop.t | 2 +- cpan/version/t/07locale.t | 5 +---- cpan/version/t/08_corelist.t | 20 ++++++++++++++++++++ cpan/version/t/coretests.pm | 30 ------------------------------ pod/perldelta.pod | 7 +++++++ t/porting/customized.dat | 10 +++------- universal.c | 14 ++++++++++++-- util.c | 18 +++++++++--------- 15 files changed, 61 insertions(+), 76 deletions(-) create mode 100644 cpan/version/t/08_corelist.t diff --git a/MANIFEST b/MANIFEST index 90f563e..8b4fd50 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2860,6 +2860,7 @@ cpan/version/t/04strict_lax.t Tests for version objects cpan/version/t/05sigdie.t Tests for version objects cpan/version/t/06noop.t Tests for version objects cpan/version/t/07locale.t Tests for version objects +cpan/version/t/08_corelist.t Tests for version objects cpan/version/t/coretests.pm Tests for version objects cpan/Win32API-File/buffers.h Win32API::File extension cpan/Win32API-File/cFile.h Win32API::File extension diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index d999003..8ee8fc2 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1952,7 +1952,7 @@ use File::Glob qw(:case); 'version' => { 'MAINTAINER' => 'jpeacock', - 'DISTRIBUTION' => 'JPEACOCK/version-0.9903.tar.gz', + 'DISTRIBUTION' => 'JPEACOCK/version-0.9904.tar.gz', 'FILES' => q[cpan/version], 'EXCLUDED' => [ qr{^vutil/}, @@ -1964,12 +1964,8 @@ use File::Glob qw(:case); # Waiting to be merged upstream: see CPAN RT#87513 'CUSTOMIZED' => [ qw( lib/version.pm - t/01base.t - t/02derived.t - t/03require.t - t/04strict_lax.t t/07locale.t - t/coretests.pm + t/08_corelist.t ), ], diff --git a/cpan/version/lib/version.pm b/cpan/version/lib/version.pm index 7b9d645..1e86ac2 100644 --- a/cpan/version/lib/version.pm +++ b/cpan/version/lib/version.pm @@ -6,7 +6,7 @@ use strict; use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv); -$VERSION = 0.9903; +$VERSION = 0.9904; $CLASS = 'version'; diff --git a/cpan/version/t/01base.t b/cpan/version/t/01base.t index e6df81a..7e83058 100644 --- a/cpan/version/t/01base.t +++ b/cpan/version/t/01base.t @@ -5,16 +5,13 @@ ######################### use Test::More qw/no_plan/; -our $Verbose; BEGIN { (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm'; require $coretests; - use_ok('version', 0.9903); + use_ok('version', 0.9904); } -diag "Tests with base class" if $Verbose; - BaseTests("version","new","qv"); BaseTests("version","new","declare"); BaseTests("version","parse", "qv"); diff --git a/cpan/version/t/02derived.t b/cpan/version/t/02derived.t index afdf531..6ed9524 100644 --- a/cpan/version/t/02derived.t +++ b/cpan/version/t/02derived.t @@ -6,12 +6,11 @@ use Test::More qw/no_plan/; use File::Temp qw/tempfile/; -our $Verbose; BEGIN { (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm'; require $coretests; - use_ok("version", 0.9903); + use_ok("version", 0.9904); # If we made it this far, we are ok. } @@ -58,8 +57,6 @@ sub main_reset { undef &declare; undef *::declare; # avoid 'used once' warning } -diag "Tests with empty derived class" if $Verbose; - use_ok($package, 0.001); my $testobj = $package->new(1.002_003); isa_ok( $testobj, $package ); @@ -81,7 +78,6 @@ main_reset; use_ok($package, 0.001, "declare"); BaseTests($package, "parse", "declare"); -diag "tests with bad subclass" if $Verbose; $testobj = version::Bad->new(1.002_003); isa_ok( $testobj, "version::Bad" ); eval { my $string = $testobj->numify }; diff --git a/cpan/version/t/03require.t b/cpan/version/t/03require.t index 316ea24..d579579 100644 --- a/cpan/version/t/03require.t +++ b/cpan/version/t/03require.t @@ -5,7 +5,6 @@ ######################### use Test::More qw/no_plan/; -our $Verbose; BEGIN { (my $coretests = $0) =~ s'[^/]+\.t'coretests.pm'; @@ -15,12 +14,9 @@ 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.9903, "Make sure we have the correct class"; +is $version::VERSION, 0.9904, "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" if $Verbose; - BaseTests("version","new",undef); BaseTests("version","parse",undef); diff --git a/cpan/version/t/05sigdie.t b/cpan/version/t/05sigdie.t index bcc0776..bac5534 100644 --- a/cpan/version/t/05sigdie.t +++ b/cpan/version/t/05sigdie.t @@ -13,9 +13,8 @@ BEGIN { }; } - BEGIN { - use version 0.9903; + use version 0.9904; } pass "Didn't get caught by the wrong DIE handler, which is a good thing"; diff --git a/cpan/version/t/06noop.t b/cpan/version/t/06noop.t index 2f15b39..e26532f 100644 --- a/cpan/version/t/06noop.t +++ b/cpan/version/t/06noop.t @@ -7,7 +7,7 @@ use Test::More qw/no_plan/; BEGIN { - use_ok('version', 0.9903); + use_ok('version', 0.9904); } my $v1 = version->new('1.2'); diff --git a/cpan/version/t/07locale.t b/cpan/version/t/07locale.t index ab2affc..93662ed 100644 --- a/cpan/version/t/07locale.t +++ b/cpan/version/t/07locale.t @@ -9,10 +9,9 @@ use File::Temp qw/tempfile/; use POSIX qw/locale_h/; use Test::More tests => 7; use Config; -our $Verbose; BEGIN { - use_ok('version', 0.9903); + use_ok('version', 0.9904); } SKIP: { @@ -42,8 +41,6 @@ SKIP: { skip 'Cannot test locale handling without a comma locale', 5 unless $loc and localeconv()->{decimal_point} eq ','; - diag ("Testing locale handling with $loc") if $Verbose; - setlocale(LC_NUMERIC, $loc); ok ($ver eq "1,23", "Using locale: $loc"); $v = version->new($ver); diff --git a/cpan/version/t/08_corelist.t b/cpan/version/t/08_corelist.t new file mode 100644 index 0000000..5e548a9 --- /dev/null +++ b/cpan/version/t/08_corelist.t @@ -0,0 +1,20 @@ +#! /usr/local/perl -w +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### + +use Test::More tests => 2; +use_ok("version", 0.9904); + +# do strict lax tests in a sub to isolate a package to test importing +SKIP: { + eval "use Module::CoreList 2.76"; + skip 'No tied hash in Modules::CoreList in Perl', 1 + if $@; + + my $foo = version->parse($Module::CoreList::version{5.008_000}{base}); + + is $foo, $Module::CoreList::version{5.008_000}{base}, + 'Correctly handle tied hash'; +} diff --git a/cpan/version/t/coretests.pm b/cpan/version/t/coretests.pm index df1984a..080b6ae 100644 --- a/cpan/version/t/coretests.pm +++ b/cpan/version/t/coretests.pm @@ -1,8 +1,6 @@ #! /usr/local/perl -w 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; @@ -27,21 +25,18 @@ sub BaseTests { # its man page ( perldoc Test ) for help writing this test script. # Test bare number processing - 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" 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" if $Verbose; $version = $CLASS->$method("5.005"); is ( "$version" , "5.005" , '5.005 eq "5.005"' ); $version = $CLASS->$method("5.006.001"); @@ -51,7 +46,6 @@ 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" if $Verbose; eval {my $version = $CLASS->$method("1.2_3_4")}; like($@, qr/multiple underscores/, "Invalid version format (multiple underscores)"); @@ -93,7 +87,6 @@ sub BaseTests { isa_ok ( $version, $CLASS ); # Test comparison operators with self - diag "tests with self" if $Verbose; is ( $version <=> $version, 0, '$version <=> $version == 0' ); ok ( $version == $version, '$version == $version' ); @@ -101,7 +94,6 @@ sub BaseTests { # test first with non-object $version = $CLASS->$method("5.006.001"); $new_version = "5.8.0"; - 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' ); @@ -109,20 +101,17 @@ sub BaseTests { # now test with existing object $new_version = $CLASS->$method($new_version); - 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" 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" 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'); @@ -134,14 +123,11 @@ 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" 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" - if $Verbose; ok ( $version > $new_version, '$version > $new_version' ); ok ( $new_version < $version, '$new_version < $version' ); ok ( $version != $new_version, '$version != $new_version' ); @@ -149,7 +135,6 @@ 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" if $Verbose; ok ( $version < $new_version, '$version < $new_version' ); ok ( $new_version > $version, '$new_version > $version' ); ok ( $version != $new_version, '$version != $new_version' ); @@ -157,20 +142,16 @@ sub BaseTests { ok ( $new_version->is_alpha, '$new_version->is_alpha'); $version = $CLASS->$method("1.2.4"); - 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' ); $version = $CLASS->$method("1.2.3.4"); $new_version = $CLASS->$method("1.2.3_4"); - diag "tests with alpha-style objects with same subversion" - 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" if $Verbose; $version = $CLASS->$method("v1.2.3"); $new_version = $CLASS->$method("1.2.3.0"); ok ( $version == $new_version, '$version == $new_version' ); @@ -183,7 +164,6 @@ sub BaseTests { $new_version = $CLASS->$method("1.1.999"); ok ( $version > $new_version, '$version > $new_version' ); - diag "test with version class names" if $Verbose; $version = $CLASS->$method("v1.2.3"); eval { () = $version < 'version' }; # this test, and only this test, I have to do this or else $@ gets @@ -192,7 +172,6 @@ sub BaseTests { like $err, qr/^Invalid version format/, "error with $version < 'version'"; # that which is not expressly permitted is forbidden - diag "forbidden operations" if $Verbose; ok ( !eval { ++$version }, "noop ++" ); ok ( !eval { --$version }, "noop --" ); ok ( !eval { $version/1 }, "noop /" ); @@ -203,7 +182,6 @@ 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" 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); @@ -212,7 +190,6 @@ SKIP: { } # test creation from existing version object - 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"); @@ -223,21 +200,18 @@ SKIP: { is ($new_version, "1.2.3" , '$version->$method("1.2.3") works too'); # test the CVS revision mode - 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" 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" if $Verbose; my $error_regex = $] < 5.006 ? 'version \d required' @@ -355,7 +329,6 @@ 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" 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); @@ -370,15 +343,12 @@ 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" 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" if $Verbose; - # trailing zero testing (reported by Andreas Koenig). $version = $CLASS->$method("1"); ok($version->numify eq "1.000", "trailing zeros preserved"); diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 76a9456..1983c58 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -322,6 +322,13 @@ overridden. =item * +L<version> has been upgraded from version 0.9903 to 0.9904. + +No changes have been made to the installed code other than the version bump to +keep in sync with the latest CPAN release. + +=item * + L<warnings> has been upgraded from version 1.18 to 1.19. The C<syscalls> warnings category has been added to check for embedded NUL diff --git a/t/porting/customized.dat b/t/porting/customized.dat index 81605ae..9574846 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -20,10 +20,6 @@ libnet cpan/libnet/Makefile.PL 6b10ac98e672bfebb8f49b9720a93442645208b3 podlators cpan/podlators/scripts/pod2man.PL f81acf53f3ff46cdcc5ebdd661c5d13eb35d20d6 podlators cpan/podlators/scripts/pod2text.PL b4693fcfe4a0a1b38a215cfb8985a65d5d025d69 podlators pod/perlpodstyle.pod dcf4b8f67d963e215f0e2e1cd214246705163a79 -version cpan/version/lib/version.pm b85a5137501de9be734c475d3b0bcaba95f92b1f -version cpan/version/t/01base.t 10b3cee80d3028797fc5bd4fdbfaf582b791e8dc -version cpan/version/t/02derived.t 304eca7c9ba2bcf4a2adc4a4713a80deda2d1a3f -version cpan/version/t/03require.t 39c905bbb6ef69902655bf8c4cfab756cef17c27 -version cpan/version/t/04strict_lax.t 4bc2722e914d98a7cbd948704288d4be977a0e29 -version cpan/version/t/07locale.t 53a04fd4985e1f6f157523c9f470dceaa23400bd -version cpan/version/t/coretests.pm 71efdf84f5011c045596fcc569a12850778e2317 +version cpan/version/lib/version.pm e9d5df9a053ac6882c6e73f7e29db74e01b15841 +version cpan/version/t/07locale.t c7e86c2706622d5055b617a4b0119ea874be8a7b +version cpan/version/t/08_corelist.t bd1c900f8be98e87dbf88896b8337f0694e4b4d3 diff --git a/universal.c b/universal.c index 847de55..8337e2b 100644 --- a/universal.c +++ b/universal.c @@ -508,6 +508,10 @@ XS(XS_version_new) STRLEN len; const char *classname; U32 flags; + + /* Just in case this is something like a tied hash */ + SvGETMAGIC(vs); + if ( sv_isobject(ST(0)) ) { /* get the class if called as an object method */ const HV * stash = SvSTASH(SvRV(ST(0))); classname = HvNAME(stash); @@ -725,8 +729,14 @@ XS(XS_version_qv) STRLEN len = 0; const char * classname = ""; U32 flags = 0; - if ( items == 2 && SvOK(ST(1)) ) { - ver = ST(1); + if ( items == 2 ) { + SvGETMAGIC(ST(1)); + if (SvOK(ST(1))) { + ver = ST(1); + } + else { + Perl_croak(aTHX_ "Invalid version format (version required)"); + } if ( sv_isobject(ST(0)) ) { /* class called as an object method */ const HV * stash = SvSTASH(SvRV(ST(0))); classname = HvNAME(stash); diff --git a/util.c b/util.c index 0cd99f3..a2c2513 100644 --- a/util.c +++ b/util.c @@ -4468,10 +4468,10 @@ Perl_upg_version(pTHX_ SV *ver, bool qv) char *buf; #ifdef USE_LOCALE_NUMERIC char *loc = NULL; - if (! PL_numeric_standard) { - loc = savepv(setlocale(LC_NUMERIC, NULL)); - setlocale(LC_NUMERIC, "C"); - } + if (! PL_numeric_standard) { + loc = savepv(setlocale(LC_NUMERIC, NULL)); + setlocale(LC_NUMERIC, "C"); + } #endif if (sv) { Perl_sv_setpvf(aTHX_ sv, "%.9"NVff, SvNVX(ver)); @@ -4482,10 +4482,10 @@ Perl_upg_version(pTHX_ SV *ver, bool qv) buf = tbuf; } #ifdef USE_LOCALE_NUMERIC - if (loc) { - setlocale(LC_NUMERIC, loc); - Safefree(loc); - } + if (loc) { + setlocale(LC_NUMERIC, loc); + Safefree(loc); + } #endif while (buf[len-1] == '0' && len > 0) len--; if ( buf[len-1] == '.' ) len--; /* eat the trailing decimal */ @@ -4792,7 +4792,7 @@ converted into version objects. int Perl_vcmp(pTHX_ SV *lhv, SV *rhv) { - I32 i,l,m,r; + SSize_t i,l,m,r; I32 retval; bool lalpha = FALSE; bool ralpha = FALSE; -- Perl5 Master Repository
