From d4e59e6254ff1d23c1f1d03bd4c8447f98b277c9 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Tue, 10 Sep 2013 00:33:19 -0700 Subject: [PATCH] vutil.c: Add preproc code specific to CPAN The purpose is to bring the files into synch so that later version.pm upgrades involve dropping files into place. This requires changing vutil.h a bit to work in the core. --- vutil.c | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++++++----------- vutil.h | 17 ++++++++++++---- 2 files changed, 73 insertions(+), 16 deletions(-) diff --git a/vutil.c b/vutil.c index b1ff941..08b2373 100644 --- a/vutil.c +++ b/vutil.c @@ -1,6 +1,19 @@ /* This file is part of the "version" CPAN distribution. Please avoid editing it in the perl core. */ +#ifndef PERL_CORE +# include "EXTERN.h" +# include "perl.h" +# include "XSUB.h" +# define NEED_my_snprintf +# define NEED_newRV_noinc +# define NEED_vnewSVpvf +# define NEED_newSVpvn_flags_GLOBAL +# define NEED_warner +# include "ppport.h" +#endif +#include "vutil.h" + #define VERSION_MAX 0x7FFFFFFF /* @@ -14,7 +27,11 @@ some time when tokenizing. =cut */ const char * +#if VUTIL_REPLACE_CORE +Perl_prescan_version2(pTHX_ const char *s, bool strict, +#else Perl_prescan_version(pTHX_ const char *s, bool strict, +#endif const char **errstr, bool *sqv, int *ssaw_decimal, int *swidth, bool *salpha) { bool qv = (sqv ? *sqv : FALSE); @@ -241,7 +258,11 @@ it doesn't. */ const char * +#if VUTIL_REPLACE_CORE +Perl_scan_version2(pTHX_ const char *s, SV *rv, bool qv) +#else Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv) +#endif { const char *start = s; const char *pos; @@ -259,7 +280,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv) while (isSPACE(*s)) /* leading whitespace is OK */ s++; - last = prescan_version(s, FALSE, &errstr, &qv, &saw_decimal, &width, &alpha); + last = PRESCAN_VERSION(s, FALSE, &errstr, &qv, &saw_decimal, &width, &alpha); if (errstr) { /* "undef" is a special case and not an error */ if ( ! ( *s == 'u' && strEQ(s,"undef")) ) { @@ -432,13 +453,16 @@ want to upgrade the SV. */ SV * +#if VUTIL_REPLACE_CORE +Perl_new_version2(pTHX_ SV *ver) +#else Perl_new_version(pTHX_ SV *ver) +#endif { dVAR; SV * const rv = newSV(0); PERL_ARGS_ASSERT_NEW_VERSION; - if ( sv_isobject(ver) && sv_derived_from(ver, "version") ) - /* can just copy directly */ + if ( ISA_CLASS_OBJ(ver,"version") ) /* can just copy directly */ { SSize_t key; AV * const av = newAV(); @@ -502,7 +526,7 @@ Perl_new_version(pTHX_ SV *ver) } } #endif - return upg_version(rv, FALSE); + return UPG_VERSION(rv, FALSE); } /* @@ -519,7 +543,11 @@ to force this SV to be interpreted as an "extended" version. */ SV * +#if VUTIL_REPLACE_CORE +Perl_upg_version2(pTHX_ SV *ver, bool qv) +#else Perl_upg_version(pTHX_ SV *ver, bool qv) +#endif { const char *version, *s; #ifdef SvVOK @@ -610,7 +638,7 @@ Perl_upg_version(pTHX_ SV *ver, bool qv) #endif } - s = scan_version(version, ver, qv); + s = SCAN_VERSION(version, ver, qv); if ( *s != '\0' ) Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Version string '%s' contains invalid data; " @@ -646,7 +674,11 @@ confused by derived classes which may contain additional hash entries): */ SV * +#if VUTIL_REPLACE_CORE +Perl_vverify2(pTHX_ SV *vs) +#else Perl_vverify(pTHX_ SV *vs) +#endif { SV *sv; @@ -682,7 +714,11 @@ The SV returned has a refcount of 1. */ SV * +#if VUTIL_REPLACE_CORE +Perl_vnumify2(pTHX_ SV *vs) +#else Perl_vnumify(pTHX_ SV *vs) +#endif { SSize_t i, len; I32 digit; @@ -694,7 +730,7 @@ Perl_vnumify(pTHX_ SV *vs) PERL_ARGS_ASSERT_VNUMIFY; /* extract the HV from the object */ - vs = vverify(vs); + vs = VVERIFY(vs); if ( ! vs ) Perl_croak(aTHX_ "Invalid version object"); @@ -764,7 +800,11 @@ The SV returned has a refcount of 1. */ SV * +#if VUTIL_REPLACE_CORE +Perl_vnormal2(pTHX_ SV *vs) +#else Perl_vnormal(pTHX_ SV *vs) +#endif { I32 i, len, digit; bool alpha = FALSE; @@ -774,7 +814,7 @@ Perl_vnormal(pTHX_ SV *vs) PERL_ARGS_ASSERT_VNORMAL; /* extract the HV from the object */ - vs = vverify(vs); + vs = VVERIFY(vs); if ( ! vs ) Perl_croak(aTHX_ "Invalid version object"); @@ -825,12 +865,16 @@ The SV returned has a refcount of 1. */ SV * +#if VUTIL_REPLACE_CORE +Perl_vstringify2(pTHX_ SV *vs) +#else Perl_vstringify(pTHX_ SV *vs) +#endif { PERL_ARGS_ASSERT_VSTRINGIFY; /* extract the HV from the object */ - vs = vverify(vs); + vs = VVERIFY(vs); if ( ! vs ) Perl_croak(aTHX_ "Invalid version object"); @@ -844,9 +888,9 @@ Perl_vstringify(pTHX_ SV *vs) } else { if ( hv_exists(MUTABLE_HV(vs), "qv", 2) ) - return vnormal(vs); + return VNORMAL(vs); else - return vnumify(vs); + return VNUMIFY(vs); } } @@ -860,7 +904,11 @@ converted into version objects. */ int +#if VUTIL_REPLACE_CORE +Perl_vcmp2(pTHX_ SV *lhv, SV *rhv) +#else Perl_vcmp(pTHX_ SV *lhv, SV *rhv) +#endif { SSize_t i,l,m,r; I32 retval; @@ -873,8 +921,8 @@ Perl_vcmp(pTHX_ SV *lhv, SV *rhv) PERL_ARGS_ASSERT_VCMP; /* extract the HVs from the objects */ - lhv = vverify(lhv); - rhv = vverify(rhv); + lhv = VVERIFY(lhv); + rhv = VVERIFY(rhv); if ( ! ( lhv && rhv ) ) Perl_croak(aTHX_ "Invalid version object"); diff --git a/vutil.h b/vutil.h index d307843..f86631d 100644 --- a/vutil.h +++ b/vutil.h @@ -1,4 +1,9 @@ -#include "ppport.h" +/* 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; @@ -80,7 +85,7 @@ Perl_ck_warner(pTHX_ U32 err, const char* pat, ...) #define ISA_CLASS_OBJ(v,c) (sv_isobject(v) && sv_derived_from(v,c)) -#if PERL_VERSION_GE(5,9,0) +#if PERL_VERSION_GE(5,9,0) && !defined(PERL_CORE) # define VUTIL_REPLACE_CORE 1 @@ -131,10 +136,14 @@ const char * Perl_prescan_version(pTHX_ const char *s, bool strict, const char** # define VCMP(a,b) Perl_vcmp(aTHX_ a,b) # define PRESCAN_VERSION(a,b,c,d,e,f,g) Perl_prescan_version(aTHX_ a,b,c,d,e,f,g) -# define is_LAX_VERSION(a,b) \ +# ifndef is_LAX_VERSION +# define is_LAX_VERSION(a,b) \ (a != Perl_prescan_version(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL)) -# define is_STRICT_VERSION(a,b) \ +# endif +# ifndef is_STRICT_VERSION +# define is_STRICT_VERSION(a,b) \ (a != Perl_prescan_version(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL)) +# endif #endif -- 1.8.3.1