diff options
-rw-r--r-- | cpan/version/lib/version.pm | 2 | ||||
-rw-r--r-- | cpan/version/lib/version.pod | 4 | ||||
-rw-r--r-- | cpan/version/lib/version/regex.pm | 2 | ||||
-rw-r--r-- | cpan/version/t/01base.t | 8 | ||||
-rw-r--r-- | cpan/version/t/02derived.t | 8 | ||||
-rw-r--r-- | cpan/version/t/03require.t | 2 | ||||
-rw-r--r-- | cpan/version/t/04strict_lax.t | 2 | ||||
-rw-r--r-- | cpan/version/t/05sigdie.t | 2 | ||||
-rw-r--r-- | cpan/version/t/06noop.t | 4 | ||||
-rw-r--r-- | cpan/version/t/07locale.t | 10 | ||||
-rw-r--r-- | cpan/version/t/08_corelist.t | 6 | ||||
-rw-r--r-- | cpan/version/t/09_list_util.t | 2 | ||||
-rw-r--r-- | cpan/version/t/10_lyon.t | 48 | ||||
-rw-r--r-- | cpan/version/t/coretests.pm | 6 | ||||
-rw-r--r-- | t/porting/customized.dat | 4 | ||||
-rw-r--r-- | vutil.c | 11 | ||||
-rw-r--r-- | vutil.h | 19 | ||||
-rw-r--r-- | vxs.inc | 27 |
18 files changed, 77 insertions, 90 deletions
diff --git a/cpan/version/lib/version.pm b/cpan/version/lib/version.pm index 72e78403d9..5531d76428 100644 --- a/cpan/version/lib/version.pm +++ b/cpan/version/lib/version.pm @@ -8,7 +8,7 @@ if ($] >= 5.015) { warnings::register_categories(qw/version/); } -our $VERSION = 0.9924; +our $VERSION = 0.9928; our $CLASS = 'version'; our (@ISA, $STRICT, $LAX); diff --git a/cpan/version/lib/version.pod b/cpan/version/lib/version.pod index 9f3b27d0f4..274868508e 100644 --- a/cpan/version/lib/version.pod +++ b/cpan/version/lib/version.pod @@ -224,11 +224,11 @@ term will be converted to a version object using C<parse()>. This may give surprising results: $v1 = version->parse("v0.95.0"); - $bool = $v1 < 0.96; # FALSE since 0.96 is v0.960.0 + $bool = $v1 < 0.94; # TRUE since 0.94 is v0.940.0 Always comparing to a version object will help avoid surprises: - $bool = $v1 < version->parse("v0.96.0"); # TRUE + $bool = $v1 < version->parse("v0.94.0"); # FALSE Note that "alpha" version objects (where the version string contains a trailing underscore segment) compare as less than the equivalent diff --git a/cpan/version/lib/version/regex.pm b/cpan/version/lib/version/regex.pm index dd9103cb7c..3b221beba0 100644 --- a/cpan/version/lib/version/regex.pm +++ b/cpan/version/lib/version/regex.pm @@ -2,7 +2,7 @@ package version::regex; use strict; -our $VERSION = 0.9924; +our $VERSION = 0.9928; #--------------------------------------------------------------------------# # Version regexp components diff --git a/cpan/version/t/01base.t b/cpan/version/t/01base.t index 8d7d4cb18d..65f4aa31a7 100644 --- a/cpan/version/t/01base.t +++ b/cpan/version/t/01base.t @@ -14,7 +14,7 @@ BEGIN { ) ); require $coretests; - use_ok('version', 0.9924); + use_ok('version', 0.9928); } BaseTests("version","new","qv"); @@ -47,3 +47,9 @@ ok defined($v), 'Fix for RT #47980'; like $@, qr'Usage: version::new\(class, version\)', 'No implicit object creation when called as function'; } + +{ + eval { version::vcmp($^V) }; + like $@, qr{Usage: version::\S+\(lobj, robj, \.\.\.\)}, + 'vcmp method throws error on single argument'; +} diff --git a/cpan/version/t/02derived.t b/cpan/version/t/02derived.t index a8da5b841a..4bab2a216f 100644 --- a/cpan/version/t/02derived.t +++ b/cpan/version/t/02derived.t @@ -15,19 +15,19 @@ BEGIN { ) ); require $coretests; - use_ok("version", 0.9924); + use_ok("version", 0.9928); # If we made it this far, we are ok. } use lib qw/./; package version::Bad; -use parent 'version'; +use base 'version'; sub new { my($self,$n)=@_; bless \$n, $self } # Bad subclass for SemVer failures seen with pure Perl version.pm only package version::Bad2; -use parent 'version'; +use base 'version'; sub new { my ($class, $val) = @_; die 'Invalid version string format' unless version::is_strict($val); @@ -50,7 +50,7 @@ my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1); print $fh <<"EOF"; # This is an empty subclass package $package; -use parent 'version'; +use base 'version'; our \$VERSION = 0.001; EOF close $fh; diff --git a/cpan/version/t/03require.t b/cpan/version/t/03require.t index a28b897508..35efa7b0a3 100644 --- a/cpan/version/t/03require.t +++ b/cpan/version/t/03require.t @@ -19,7 +19,7 @@ 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.9924, "Make sure we have the correct class"; +is $version::VERSION, 0.9928, "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()"); diff --git a/cpan/version/t/04strict_lax.t b/cpan/version/t/04strict_lax.t index 861e4df2b5..ee14a2f607 100644 --- a/cpan/version/t/04strict_lax.t +++ b/cpan/version/t/04strict_lax.t @@ -90,7 +90,7 @@ _ fail fail CASE_DATA require version; - version->import( qw/is_strict is_lax/ ); + 'version'->import( qw/is_strict is_lax/ ); for my $case ( split qr/\n/, $strict_lax_data ) { my ($v, $strict, $lax) = split qr/\t+/, $case; main::ok( $strict eq 'pass' ? is_strict($v) : ! is_strict($v), "is_strict($v) [$strict]" ); diff --git a/cpan/version/t/05sigdie.t b/cpan/version/t/05sigdie.t index 399739c43b..5429731bb3 100644 --- a/cpan/version/t/05sigdie.t +++ b/cpan/version/t/05sigdie.t @@ -14,7 +14,7 @@ BEGIN { } BEGIN { - use version 0.9924; + use version 0.9928; } 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 7db76cec5d..eb0a45edbe 100644 --- a/cpan/version/t/06noop.t +++ b/cpan/version/t/06noop.t @@ -7,10 +7,10 @@ use Test::More qw/no_plan/; BEGIN { - use_ok('version', 0.9924); + use_ok('version', 0.9928); } -my $v1 = version->new('1.2'); +my $v1 = 'version'->new('1.2'); eval {$v1 = $v1 + 1}; like $@, qr/operation not supported with version object/, 'No math ops with version objects'; eval {$v1 = $v1 - 1}; diff --git a/cpan/version/t/07locale.t b/cpan/version/t/07locale.t index a6f6e33d54..ad63e787b0 100644 --- a/cpan/version/t/07locale.t +++ b/cpan/version/t/07locale.t @@ -11,12 +11,12 @@ use Test::More tests => 8; use Config; BEGIN { - use_ok('version', 0.9924); + use_ok('version', 0.9928); } SKIP: { - skip 'No locale testing for Perl < 5.6.0', 6 if $] < 5.006; - skip 'No locale testing without d_setlocale', 6 + skip 'No locale testing for Perl < 5.6.0', 7 if $] < 5.006; + skip 'No locale testing without d_setlocale', 7 if(!$Config{d_setlocale}); # test locale handling @@ -44,7 +44,7 @@ SKIP: { setlocale(LC_NUMERIC, $loc); $ver = 1.23; # has to be floating point number ok ($ver eq "1,23", "Using locale: $loc"); - $v = version->new($ver); + $v = 'version'->new($ver); unlike($warning, qr/Version string '1,23' contains invalid data/, "Process locale-dependent floating point"); ok ($v eq "1.23", "Locale doesn't apply to version objects"); @@ -52,7 +52,7 @@ SKIP: { TODO: { # Resolve https://rt.cpan.org/Ticket/Display.html?id=102272 local $TODO = 'Fails for Perl 5.x.0 < 5.19.0' if $] < 5.019000; - $ver = version->new($]); + $ver = 'version'->new($]); is "$ver", "$]", 'Use PV for dualvars'; } setlocale( LC_ALL, $orig_loc); # reset this before possible skip diff --git a/cpan/version/t/08_corelist.t b/cpan/version/t/08_corelist.t index 86398b0d07..886b23ced8 100644 --- a/cpan/version/t/08_corelist.t +++ b/cpan/version/t/08_corelist.t @@ -5,7 +5,7 @@ ######################### use Test::More tests => 3; -use_ok("version", 0.9924); +use_ok("version", 0.9928); # do strict lax tests in a sub to isolate a package to test importing SKIP: { @@ -13,10 +13,10 @@ SKIP: { skip 'No tied hash in Modules::CoreList in Perl', 2 if $@; - my $foo = version->parse($Module::CoreList::version{5.008_000}{base}); + my $foo = "version"->parse($Module::CoreList::version{5.008_000}{base}); is $foo, 1.03, 'Correctly handle tied hash'; - $foo = version->qv($Module::CoreList::version{5.008_000}{Unicode}); + $foo = "version"->qv($Module::CoreList::version{5.008_000}{Unicode}); is $foo, '3.2.0', 'Correctly handle tied hash with dotted decimal'; } diff --git a/cpan/version/t/09_list_util.t b/cpan/version/t/09_list_util.t index 63ff66761b..bcd88a3d88 100644 --- a/cpan/version/t/09_list_util.t +++ b/cpan/version/t/09_list_util.t @@ -4,7 +4,7 @@ ######################### use strict; -use_ok("version", 0.9924); +use_ok("version", 0.9928); use Test::More; BEGIN { diff --git a/cpan/version/t/10_lyon.t b/cpan/version/t/10_lyon.t index 4f927aa65f..e4a52b4b21 100644 --- a/cpan/version/t/10_lyon.t +++ b/cpan/version/t/10_lyon.t @@ -7,38 +7,38 @@ use version; # These values are from the Lyon consensus, as taken from # https://gist.github.com/dagolden/9559280 -ok(version->new(1.0203) == version->new('1.0203')); -ok(version->new(1.02_03) == version->new('1.02_03')); -ok(version->new(v1.2.3) == version->new('v1.2.3')); +ok('version'->new(1.0203) == 'version'->new('1.0203')); +ok('version'->new(1.02_03) == 'version'->new('1.02_03')); +ok('version'->new(v1.2.3) == 'version'->new('v1.2.3')); if ($] >= 5.008_001) { - ok(version->new(v1.2.3_0) == version->new('v1.2.3_0')); + ok('version'->new(v1.2.3_0) == 'version'->new('v1.2.3_0')); } -cmp_ok(version->new(1.0203), '==', version->new('1.0203')); -cmp_ok(version->new(1.02_03), '==', version->new('1.02_03')); -cmp_ok(version->new(v1.2.3), '==', version->new('v1.2.3')); +cmp_ok('version'->new(1.0203), '==', 'version'->new('1.0203')); +cmp_ok('version'->new(1.02_03), '==', 'version'->new('1.02_03')); +cmp_ok('version'->new(v1.2.3), '==', 'version'->new('v1.2.3')); if ($] >= 5.008_001) { - cmp_ok(version->new(v1.2.3_0), '==', version->new('v1.2.3_0')); + cmp_ok('version'->new(v1.2.3_0), '==', 'version'->new('v1.2.3_0')); } -cmp_ok(version->new('1.0203')->numify, '==', '1.0203'); -is(version->new('1.0203')->normal, 'v1.20.300'); +cmp_ok('version'->new('1.0203')->numify, '==', '1.0203'); +is('version'->new('1.0203')->normal, 'v1.20.300'); -cmp_ok(version->new('1.02_03')->numify, '==', '1.0203'); -is(version->new('1.02_03')->normal, 'v1.20.300'); +cmp_ok('version'->new('1.02_03')->numify, '==', '1.0203'); +is('version'->new('1.02_03')->normal, 'v1.20.300'); -cmp_ok(version->new('v1.2.30')->numify, '==', '1.002030'); -is(version->new('v1.2.30')->normal, 'v1.2.30'); -cmp_ok(version->new('v1.2.3_0')->numify, '==', '1.002030'); -is(version->new('v1.2.3_0')->normal, 'v1.2.30'); +cmp_ok('version'->new('v1.2.30')->numify, '==', '1.002030'); +is('version'->new('v1.2.30')->normal, 'v1.2.30'); +cmp_ok('version'->new('v1.2.3_0')->numify, '==', '1.002030'); +is('version'->new('v1.2.3_0')->normal, 'v1.2.30'); -is(version->new("1.0203")->stringify, "1.0203"); -is(version->new("1.02_03")->stringify, "1.02_03"); -is(version->new("v1.2.30")->stringify, "v1.2.30"); -is(version->new("v1.2.3_0")->stringify, "v1.2.3_0"); -is(version->new(1.0203)->stringify, "1.0203"); -is(version->new(1.02_03)->stringify, "1.0203"); -is(version->new(v1.2.30)->stringify, "v1.2.30"); +is('version'->new("1.0203")->stringify, "1.0203"); +is('version'->new("1.02_03")->stringify, "1.02_03"); +is('version'->new("v1.2.30")->stringify, "v1.2.30"); +is('version'->new("v1.2.3_0")->stringify, "v1.2.3_0"); +is('version'->new(1.0203)->stringify, "1.0203"); +is('version'->new(1.02_03)->stringify, "1.0203"); +is('version'->new(v1.2.30)->stringify, "v1.2.30"); if ($] >= 5.008_001) { - is(version->new(v1.2.3_0)->stringify, "v1.2.30"); + is('version'->new(v1.2.3_0)->stringify, "v1.2.30"); } diff --git a/cpan/version/t/coretests.pm b/cpan/version/t/coretests.pm index 07cc82e614..b38b275c7d 100644 --- a/cpan/version/t/coretests.pm +++ b/cpan/version/t/coretests.pm @@ -435,7 +435,7 @@ SKIP: { (my $package = basename($filename)) =~ s/\.pm$//; print $fh <<"EOF"; package $package; -use parent $CLASS; +use base $CLASS; 1; EOF close $fh; @@ -581,8 +581,8 @@ SKIP: { { # https://rt.cpan.org/Ticket/Display.html?id=88495 @ver::ISA = $CLASS; - is ref(ver->new), 'ver', 'ver can inherit from version'; - is ref(ver->qv("1.2.3")), 'ver', 'ver can inherit from version'; + is ref('ver'->new), 'ver', 'ver can inherit from version'; + is ref('ver'->qv("1.2.3")), 'ver', 'ver can inherit from version'; } { # discovered while integrating with bleadperl diff --git a/t/porting/customized.dat b/t/porting/customized.dat index 7bfdf04f2b..92f7e2e103 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -33,5 +33,5 @@ Pod::Perldoc cpan/Pod-Perldoc/lib/Pod/Perldoc.pm 582be34c077c9ff44d99914724a0cc2 Win32API::File cpan/Win32API-File/File.pm 8fd212857f821cb26648878b96e57f13bf21b99e Win32API::File cpan/Win32API-File/File.xs beb870fed4490d2faa547b4a8576b8d64d1d27c5 experimental cpan/experimental/t/basic.t cb9da8dd05b854375809872a05dd32637508d5da -version cpan/version/lib/version.pm 7ef9219d1d5f1d71f08a79f3b0577df138b21b12 -version vutil.c 7a416b6630a498e737aae03891d0873aaeb066f0 +version cpan/version/lib/version.pm 9a4d4c2a89cc95c0c946de6742d6df41e546c12c +version vutil.c 1fc71f632e905d65e1b24afbd36f1ebda894ef02 @@ -8,8 +8,6 @@ #define VERSION_MAX 0x7FFFFFFF /* -=for apidoc_section Versioning - =for apidoc prescan_version Validate that a given string can be parsed as a version object, but doesn't @@ -573,11 +571,6 @@ Perl_upg_version2(pTHX_ SV *ver, bool qv) Perl_upg_version(pTHX_ SV *ver, bool qv) #endif { - -#ifdef dVAR - dVAR; -#endif - const char *version, *s; #ifdef SvVOK const MAGIC *mg; @@ -704,7 +697,7 @@ VER_NV: #endif if (sv) { - Perl_sv_catpvf(aTHX_ sv, "%.9" NVff, SvNVX(ver)); + Perl_sv_setpvf(aTHX_ sv, "%.9" NVff, SvNVX(ver)); len = SvCUR(sv); buf = SvPVX(sv); } @@ -766,7 +759,6 @@ VER_PV: version = savepvn(SvPV(ver,len), SvCUR(ver)); SAVEFREEPV(version); #ifndef SvVOK -# if PERL_VERSION > 5 /* This will only be executed for 5.6.0 - 5.8.0 inclusive */ if ( len >= 3 && !instr(version,".") && !instr(version,"_")) { /* may be a v-string */ @@ -799,7 +791,6 @@ VER_PV: } } } -# endif #endif } #if PERL_VERSION_LT(5,17,2) @@ -1,10 +1,6 @@ /* This file is part of the "version" CPAN distribution. Please avoid editing it in the perl core. */ -#ifndef PERL_CORE -# include "ppport.h" -#endif - /* The MUTABLE_*() macros cast pointers to the types shown, in such a way * (compiler permitting) that casting away const-ness will give a warning; * e.g.: @@ -20,12 +16,24 @@ # else # define MUTABLE_PTR(p) ((void *) (p)) # endif +#endif +#ifndef MUTABLE_AV # define MUTABLE_AV(p) ((AV *)MUTABLE_PTR(p)) +#endif +#ifndef MUTABLE_CV # define MUTABLE_CV(p) ((CV *)MUTABLE_PTR(p)) +#endif +#ifndef MUTABLE_GV # define MUTABLE_GV(p) ((GV *)MUTABLE_PTR(p)) +#endif +#ifndef MUTABLE_HV # define MUTABLE_HV(p) ((HV *)MUTABLE_PTR(p)) +#endif +#ifndef MUTABLE_IO # define MUTABLE_IO(p) ((IO *)MUTABLE_PTR(p)) +#endif +#ifndef MUTABLE_SV # define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p)) #endif @@ -81,7 +89,6 @@ Perl_ck_warner(pTHX_ U32 err, const char* pat, ...) # define ISA_VERSION_OBJ(v) (sv_isobject(v) && sv_derived_from_pvn(v,"version",7,0)) #endif - #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params) @@ -216,7 +223,7 @@ const char * Perl_prescan_version(pTHX_ const char *s, bool strict, const char** #if PERL_VERSION_LT(5,27,9) -# define LC_NUMERIC_LOCK +# define LC_NUMERIC_LOCK(cond) # define LC_NUMERIC_UNLOCK # if PERL_VERSION_LT(5,19,0) # undef STORE_LC_NUMERIC_SET_STANDARD @@ -5,7 +5,7 @@ # define VXS_CLASS "version" # define VXSp(name) XS_##name /* VXSXSDP = XSUB Details Proto */ -# define VXSXSDP(x) x, 0 +# define VXSXSDP(x) x #else # define VXS_CLASS "version::vxs" # define VXSp(name) VXS_##name @@ -133,18 +133,13 @@ VXS(universal_version) if (undef) { if (pkg) { const HVNAME* const name = HvNAME_HEK(pkg); -#if PERL_VERSION == 5 - Perl_croak(aTHX_ "%s version %s required--this is only version ", - name, SvPVx_nolen_const(req)); -#else Perl_croak(aTHX_ "%" HEKf " does not define $%" HEKf "::VERSION--version check failed", HEKfARG(name), HEKfARG(name)); -#endif } else { -#if PERL_VERSION >= 8 +#if PERL_VERSION_GE(5,8,0) Perl_croak(aTHX_ "%" SVf " defines neither package nor VERSION--" "version check failed", @@ -206,11 +201,7 @@ VXS(version_new) SV * svarg2; vs = sv_newmortal(); svarg2 = ST(2); -#if PERL_VERSION == 5 - sv_setpvf(vs,"v%s",SvPV_nolen_const(svarg2)); -#else Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(svarg2)); -#endif break; } case 2: @@ -249,11 +240,7 @@ VXS(version_new) rv = NEW_VERSION(vs); if ( len != sizeof(VXS_CLASS)-1 || strcmp(classname,VXS_CLASS) != 0 ) /* inherited new() */ -#if PERL_VERSION == 5 - sv_bless(rv, gv_stashpv((char *)classname, GV_ADD)); -#else sv_bless(rv, gv_stashpvn(classname, len, GV_ADD | flags)); -#endif VXS_RETURN_M_SV(rv); } @@ -312,8 +299,8 @@ VXS(version_normal) VXS(version_vcmp) { dXSARGS; - if (items < 1) - croak_xs_usage(cv, "lobj, ..."); + if (items < 2) + croak_xs_usage(cv, "lobj, robj, ..."); SP -= items; { SV * lobj; @@ -322,7 +309,7 @@ VXS(version_vcmp) SV *rs; SV *rvs; SV * robj = ST(1); - const IV swap = (IV)SvIV(ST(2)); + const int swap = items > 2 ? SvTRUE(ST(2)) : 0; if ( !ISA_VERSION_OBJ(robj) ) { @@ -445,11 +432,7 @@ VXS(version_qv) } if ( items == 2 && (len != 7 || strcmp(classname,"version")) ) { /* inherited new() */ -#if PERL_VERSION == 5 - sv_bless(rv, gv_stashpv((char *)classname, GV_ADD)); -#else sv_bless(rv, gv_stashpvn(classname, len, GV_ADD | flags)); -#endif } PUSHs(rv); } |