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.

diff --git a/vutil.c b/vutil.c
index b1ff941..08b2373 100644 (file)
--- 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 (file)
--- 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