X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/abc6d7382c177cc56ee6e74fdc91fa07bc0ada01..HEAD:/vxs.inc

diff --git a/vxs.inc b/vxs.inc
index 697be74..80bb8eb 100644
--- a/vxs.inc
+++ b/vxs.inc
@@ -1,41 +1,96 @@
 /* This file is part of the "version" CPAN distribution.  Please avoid
    editing it in the perl core. */
 
+#ifdef PERL_CORE
+#  define VXS_CLASS "version"
+#  define VXSp(name) XS_##name
+/* VXSXSDP = XSUB Details Proto */
+#  define VXSXSDP(x) x, 0
+#else
+#  define VXS_CLASS "version::vxs"
+#  define VXSp(name) VXS_##name
+/* proto member is unused in version, it is used in CORE by non version xsubs */
+#  define VXSXSDP(x)
+#endif
+
+#ifndef XS_INTERNAL
+#  define XS_INTERNAL(name) static XSPROTO(name)
+#endif
+
+#define VXS(name) XS_INTERNAL(VXSp(name)); XS_INTERNAL(VXSp(name))
+
+/* uses PUSHs, so SP must be at start, PUSHs sv on Perl stack, then returns from
+   xsub; this is a little more machine code/tailcall friendly than mPUSHs(foo);
+   PUTBACK; return; */
+
+#define VXS_RETURN_M_SV(sv) \
+    STMT_START {							\
+	SV * sv_vtc = sv;						\
+	PUSHs(sv_vtc);							\
+	PUTBACK;							\
+	sv_2mortal(sv_vtc);						\
+	return;								\
+    } STMT_END
+
+
 #ifdef VXS_XSUB_DETAILS
-    {"UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, NULL},
-    {"version::()", XS_version_noop, NULL},
-    {"version::new", XS_version_new, NULL},
-    {"version::parse", XS_version_new, NULL},
-    {"version::(\"\"", XS_version_stringify, NULL},
-    {"version::stringify", XS_version_stringify, NULL},
-    {"version::(0+", XS_version_numify, NULL},
-    {"version::numify", XS_version_numify, NULL},
-    {"version::normal", XS_version_normal, NULL},
-    {"version::(cmp", XS_version_vcmp, NULL},
-    {"version::(<=>", XS_version_vcmp, NULL},
-    {"version::vcmp", XS_version_vcmp, NULL},
-    {"version::(bool", XS_version_boolean, NULL},
-    {"version::boolean", XS_version_boolean, NULL},
-    {"version::(+", XS_version_noop, NULL},
-    {"version::(-", XS_version_noop, NULL},
-    {"version::(*", XS_version_noop, NULL},
-    {"version::(/", XS_version_noop, NULL},
-    {"version::(+=", XS_version_noop, NULL},
-    {"version::(-=", XS_version_noop, NULL},
-    {"version::(*=", XS_version_noop, NULL},
-    {"version::(/=", XS_version_noop, NULL},
-    {"version::(abs", XS_version_noop, NULL},
-    {"version::(nomethod", XS_version_noop, NULL},
-    {"version::noop", XS_version_noop, NULL},
-    {"version::is_alpha", XS_version_is_alpha, NULL},
-    {"version::qv", XS_version_qv, NULL},
-    {"version::declare", XS_version_qv, NULL},
-    {"version::is_qv", XS_version_is_qv, NULL},
+#  ifdef PERL_CORE
+    {"UNIVERSAL::VERSION", VXSp(universal_version), VXSXSDP(NULL)},
+#  endif
+    {VXS_CLASS "::_VERSION", VXSp(universal_version), VXSXSDP(NULL)},
+    {VXS_CLASS "::()", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::new", VXSp(version_new), VXSXSDP(NULL)},
+    {VXS_CLASS "::parse", VXSp(version_new), VXSXSDP(NULL)},
+    {VXS_CLASS "::(\"\"", VXSp(version_stringify), VXSXSDP(NULL)},
+    {VXS_CLASS "::stringify", VXSp(version_stringify), VXSXSDP(NULL)},
+    {VXS_CLASS "::(0+", VXSp(version_numify), VXSXSDP(NULL)},
+    {VXS_CLASS "::numify", VXSp(version_numify), VXSXSDP(NULL)},
+    {VXS_CLASS "::normal", VXSp(version_normal), VXSXSDP(NULL)},
+    {VXS_CLASS "::(cmp", VXSp(version_vcmp), VXSXSDP(NULL)},
+    {VXS_CLASS "::(<=>", VXSp(version_vcmp), VXSXSDP(NULL)},
+#  ifdef PERL_CORE
+    {VXS_CLASS "::vcmp", XS_version_vcmp, VXSXSDP(NULL)},
+#  else
+    {VXS_CLASS "::VCMP", VXS_version_vcmp, VXSXSDP(NULL)},
+#  endif
+    {VXS_CLASS "::(bool", VXSp(version_boolean), VXSXSDP(NULL)},
+    {VXS_CLASS "::boolean", VXSp(version_boolean), VXSXSDP(NULL)},
+    {VXS_CLASS "::(+", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(-", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(*", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(/", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(+=", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(-=", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(*=", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(/=", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(abs", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(nomethod", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::noop", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::is_alpha", VXSp(version_is_alpha), VXSXSDP(NULL)},
+    {VXS_CLASS "::qv", VXSp(version_qv), VXSXSDP(NULL)},
+    {VXS_CLASS "::declare", VXSp(version_qv), VXSXSDP(NULL)},
+    {VXS_CLASS "::is_qv", VXSp(version_is_qv), VXSXSDP(NULL)},
+#else
+
+#ifndef dVAR
+#  define dVAR
+#endif
+
+#ifdef HvNAME_HEK
+typedef HEK HVNAME;
+#  ifndef HEKf
+#    define HEKfARG(arg)	((void*)(sv_2mortal(newSVhek(arg))))
+#    define HEKf		SVf
+#  endif
 #else
+typedef char HVNAME;
+#  define HvNAME_HEK	HvNAME_get
+#  define HEKfARG(arg)	arg
+#  define HEKf		"s"
+#endif
 
-XS(XS_UNIVERSAL_VERSION)
+VXS(universal_version)
 {
-    dVAR;
     dXSARGS;
     HV *pkg;
     GV **gvp;
@@ -44,25 +99,27 @@ XS(XS_UNIVERSAL_VERSION)
     const char *undef;
     PERL_UNUSED_ARG(cv);
 
-    if (SvROK(ST(0))) {
-        sv = MUTABLE_SV(SvRV(ST(0)));
+    if (items < 1)
+       Perl_croak(aTHX_ "Usage: UNIVERSAL::VERSION(sv, ...)");
+
+    sv = ST(0);
+
+    if (SvROK(sv)) {
+        sv = (SV*)SvRV(sv);
         if (!SvOBJECT(sv))
             Perl_croak(aTHX_ "Cannot find version of an unblessed reference");
         pkg = SvSTASH(sv);
     }
     else {
-        pkg = gv_stashsv(ST(0), 0);
+        pkg = gv_stashsv(sv, FALSE);
     }
 
-    gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
+    gvp = pkg ? (GV**)hv_fetchs(pkg,"VERSION",FALSE) : (GV**)NULL;
 
     if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
-        SV * const nsv = sv_newmortal();
-        sv_setsv(nsv, sv);
-        sv = nsv;
-	if ( !sv_isobject(sv) || !sv_derived_from(sv, "version"))
-	    upg_version(sv, FALSE);
-
+        sv = sv_mortalcopy(sv);
+	if ( ! ISA_VERSION_OBJ(sv) )
+	    UPG_VERSION(sv, FALSE);
         undef = NULL;
     }
     else {
@@ -75,42 +132,50 @@ XS(XS_UNIVERSAL_VERSION)
 
 	if (undef) {
 	    if (pkg) {
-		const HEK * const name = HvNAME_HEK(pkg);
+		const HVNAME* const name = HvNAME_HEK(pkg);
 		Perl_croak(aTHX_
-			   "%"HEKf" does not define $%"HEKf
+			   "%" HEKf " does not define $%" HEKf
 			   "::VERSION--version check failed",
 			   HEKfARG(name), HEKfARG(name));
-	    } else {
+	    }
+	    else {
+#if PERL_VERSION_GE(5,8,0)
 		Perl_croak(aTHX_
-			     "%"SVf" defines neither package nor VERSION--version check failed",
-			     SVfARG(ST(0)) );
+			     "%" SVf " defines neither package nor VERSION--"
+                             "version check failed",
+			     (void*)(ST(0)) );
+#else
+		Perl_croak(aTHX_ "%s does not define $%s::VERSION--version check failed",
+			   SvPVx_nolen_const(ST(0)),
+			   SvPVx_nolen_const(ST(0)) );
+#endif
 	    }
 	}
 
-	if ( !sv_isobject(req) || !sv_derived_from(req, "version")) {
+	if ( ! ISA_VERSION_OBJ(req) ) {
 	    /* req may very well be R/O, so create a new object */
-	    req = sv_2mortal( new_version(req) );
+	    req = sv_2mortal( NEW_VERSION(req) );
 	}
 
-	if ( vcmp( req, sv ) > 0 ) {
+	if ( VCMP( req, sv ) > 0 ) {
 	    if ( hv_exists(MUTABLE_HV(SvRV(req)), "qv", 2 ) ) {
-		Perl_croak(aTHX_ "%"HEKf" version %"SVf" required--"
-		       "this is only version %"SVf"",
-                       HEKfARG(HvNAME_HEK(pkg)),
-		       SVfARG(sv_2mortal(vnormal(req))),
-		       SVfARG(sv_2mortal(vnormal(sv))));
-	    } else {
-		Perl_croak(aTHX_ "%"HEKf" version %"SVf" required--"
-		       "this is only version %"SVf,
-                       HEKfARG(HvNAME_HEK(pkg)),
-		       SVfARG(sv_2mortal(vstringify(req))),
-		       SVfARG(sv_2mortal(vstringify(sv))));
+		req = VNORMAL(req);
+		sv  = VNORMAL(sv);
 	    }
+	    else {
+		req = VSTRINGIFY(req);
+		sv  = VSTRINGIFY(sv);
+	    }
+	    Perl_croak(aTHX_ "%" HEKf " version %" SVf " required--"
+		"this is only version %" SVf, HEKfARG(HvNAME_HEK(pkg)),
+		SVfARG(sv_2mortal(req)),
+		SVfARG(sv_2mortal(sv)));
 	}
     }
 
-    if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
-	ST(0) = sv_2mortal(vstringify(sv));
+    /* if the package's $VERSION is not undef, it is upgraded to be a version object */
+    if (ISA_VERSION_OBJ(sv)) {
+	ST(0) = sv_2mortal(VSTRINGIFY(sv));
     } else {
 	ST(0) = sv;
     }
@@ -118,268 +183,255 @@ XS(XS_UNIVERSAL_VERSION)
     XSRETURN(1);
 }
 
-XS(XS_version_new)
+VXS(version_new)
 {
-    dVAR;
     dXSARGS;
-    if (items > 3 || items < 1)
-	croak_xs_usage(cv, "class, version");
-    SP -= items;
-    {
-        SV *vs = ST(1);
-	SV *rv;
-        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);
-            len       = HvNAMELEN(stash);
-            flags     = HvNAMEUTF8(stash) ? SVf_UTF8 : 0;
-        }
-        else {
-	    classname = SvPV(ST(0), len);
-            flags     = SvUTF8(ST(0));
-        }
+    SV *vs;
+    SV *rv;
+    const char * classname = "";
+    STRLEN len;
+    U32 flags = 0;
+    SV * svarg0 = NULL;
+    PERL_UNUSED_VAR(cv);
 
-	if ( items == 1 || ! SvOK(vs) ) { /* no param or explicit undef */
-	    /* create empty object */
-	    vs = sv_newmortal();
-	    sv_setpvs(vs, "0");
-	}
-	else if ( items == 3 ) {
-	    vs = sv_newmortal();
-	    Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2)));
-	}
+    SP -= items;
 
-	rv = new_version(vs);
-	if ( strnNE(classname,"version", len) ) /* inherited new() */
-	    sv_bless(rv, gv_stashpvn(classname, len, GV_ADD | flags));
+    switch((U32)items) {
+    case 3: {
+        SV * svarg2;
+        vs = sv_newmortal();
+        svarg2 = ST(2);
+        Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(svarg2));
+        break;
+    }
+    case 2:
+        vs = ST(1);
+    /* Just in case this is something like a tied hash */
+        SvGETMAGIC(vs);
+        if(SvOK(vs))
+            break;
+        /* fall through */
+    case 1:
+        /* no param or explicit undef */
+        /* create empty object */
+        vs = sv_newmortal();
+        sv_setpvs(vs,"undef");
+        break;
+    default:
+    case 0:
+        Perl_croak_nocontext("Usage: version::new(class, version)");
+    }
 
-	mPUSHs(rv);
-	PUTBACK;
-	return;
+    svarg0 = ST(0);
+    if ( sv_isobject(svarg0) ) {
+	/* get the class if called as an object method */
+	const HV * stash = SvSTASH(SvRV(svarg0));
+	classname = HvNAME_get(stash);
+	len	  = HvNAMELEN_get(stash);
+#ifdef HvNAMEUTF8
+	flags	  = HvNAMEUTF8(stash) ? SVf_UTF8 : 0;
+#endif
+    }
+    else {
+	classname = SvPV_nomg(svarg0, len);
+	flags     = SvUTF8(svarg0);
     }
+
+    rv = NEW_VERSION(vs);
+    if ( len != sizeof(VXS_CLASS)-1
+      || strcmp(classname,VXS_CLASS) != 0 ) /* inherited new() */
+        sv_bless(rv, gv_stashpvn(classname, len, GV_ADD | flags));
+
+    VXS_RETURN_M_SV(rv);
 }
 
-XS(XS_version_stringify)
+#define VTYPECHECK(var, val, varname) \
+    STMT_START {							\
+	SV * sv_vtc = val;						\
+	if (ISA_VERSION_OBJ(sv_vtc)) {				\
+	    (var) = SvRV(sv_vtc);						\
+	}								\
+	else								\
+	    Perl_croak_nocontext(varname " is not of type version");	\
+    } STMT_END
+
+VXS(version_stringify)
 {
-     dVAR;
      dXSARGS;
      if (items < 1)
 	 croak_xs_usage(cv, "lobj, ...");
      SP -= items;
      {
-	  SV *	lobj = ST(0);
-
-	  if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
-	       lobj = SvRV(lobj);
-	  }
-	  else
-	       Perl_croak(aTHX_ "lobj is not of type version");
+	  SV *	lobj;
+	  VTYPECHECK(lobj, ST(0), "lobj");
 
-	  mPUSHs(vstringify(lobj));
-
-	  PUTBACK;
-	  return;
+	  VXS_RETURN_M_SV(VSTRINGIFY(lobj));
      }
 }
 
-XS(XS_version_numify)
+VXS(version_numify)
 {
-     dVAR;
      dXSARGS;
      if (items < 1)
 	 croak_xs_usage(cv, "lobj, ...");
      SP -= items;
      {
-	  SV *	lobj = ST(0);
-
-	  if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
-	       lobj = SvRV(lobj);
-	  }
-	  else
-	       Perl_croak(aTHX_ "lobj is not of type version");
-
-	  mPUSHs(vnumify(lobj));
-
-	  PUTBACK;
-	  return;
+	  SV *	lobj;
+	  VTYPECHECK(lobj, ST(0), "lobj");
+	  VXS_RETURN_M_SV(VNUMIFY(lobj));
      }
 }
 
-XS(XS_version_normal)
+VXS(version_normal)
 {
-     dVAR;
      dXSARGS;
-     if (items < 1)
-	 croak_xs_usage(cv, "lobj, ...");
+     if (items != 1)
+	 croak_xs_usage(cv, "ver");
      SP -= items;
      {
-	  SV *	lobj = ST(0);
-
-	  if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
-	       lobj = SvRV(lobj);
-	  }
-	  else
-	       Perl_croak(aTHX_ "lobj is not of type version");
+	  SV *	ver;
+	  VTYPECHECK(ver, ST(0), "ver");
 
-	  mPUSHs(vnormal(lobj));
-
-	  PUTBACK;
-	  return;
+	  VXS_RETURN_M_SV(VNORMAL(ver));
      }
 }
 
-XS(XS_version_vcmp)
+VXS(version_vcmp)
 {
-     dVAR;
      dXSARGS;
-     if (items < 1)
-	 croak_xs_usage(cv, "lobj, ...");
+     if (items < 2)
+	 croak_xs_usage(cv, "lobj, robj, ...");
      SP -= items;
      {
-	  SV *	lobj = ST(0);
-
-	  if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
-	       lobj = SvRV(lobj);
-	  }
-	  else
-	       Perl_croak(aTHX_ "lobj is not of type version");
-
+	  SV *	lobj;
+	  VTYPECHECK(lobj, ST(0), "lobj");
 	  {
 	       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 ( !sv_isobject(robj) || !sv_derived_from(robj, "version") )
+	       if ( !ISA_VERSION_OBJ(robj) )
 	       {
-		    robj = new_version(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
-		    sv_2mortal(robj);
+		    robj = sv_2mortal(NEW_VERSION(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP)));
 	       }
 	       rvs = SvRV(robj);
 
 	       if ( swap )
 	       {
-		    rs = newSViv(vcmp(rvs,lobj));
+		    rs = newSViv(VCMP(rvs,lobj));
 	       }
 	       else
 	       {
-		    rs = newSViv(vcmp(lobj,rvs));
+		    rs = newSViv(VCMP(lobj,rvs));
 	       }
 
-	       mPUSHs(rs);
+	       VXS_RETURN_M_SV(rs);
 	  }
-
-	  PUTBACK;
-	  return;
      }
 }
 
-XS(XS_version_boolean)
+VXS(version_boolean)
 {
-    dVAR;
     dXSARGS;
+    SV *lobj;
     if (items < 1)
 	croak_xs_usage(cv, "lobj, ...");
     SP -= items;
-    if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "version")) {
-	SV * const lobj = SvRV(ST(0));
+    VTYPECHECK(lobj, ST(0), "lobj");
+    {
 	SV * const rs =
-	    newSViv( vcmp(lobj,
-			  sv_2mortal(new_version(
+	    newSViv( VCMP(lobj,
+			  sv_2mortal(NEW_VERSION(
 					sv_2mortal(newSVpvs("0"))
 				    ))
 			 )
 		   );
-	mPUSHs(rs);
-	PUTBACK;
-	return;
+	VXS_RETURN_M_SV(rs);
     }
-    else
-	Perl_croak(aTHX_ "lobj is not of type version");
 }
 
-XS(XS_version_noop)
+VXS(version_noop)
 {
-    dVAR;
     dXSARGS;
     if (items < 1)
 	croak_xs_usage(cv, "lobj, ...");
-    if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "version"))
+    if (ISA_VERSION_OBJ(ST(0)))
 	Perl_croak(aTHX_ "operation not supported with version object");
     else
 	Perl_croak(aTHX_ "lobj is not of type version");
-#ifndef HASATTRIBUTE_NORETURN
     XSRETURN_EMPTY;
-#endif
 }
 
-XS(XS_version_is_alpha)
+static
+void
+S_version_check_key(pTHX_ CV * cv, const char * key, int keylen)
 {
-    dVAR;
     dXSARGS;
     if (items != 1)
 	croak_xs_usage(cv, "lobj");
-    SP -= items;
-    if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "version")) {
-	SV * const lobj = ST(0);
-	if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "alpha", 5 ) )
-	    XSRETURN_YES;
+    {
+	SV *lobj = POPs;
+	SV *ret;
+	VTYPECHECK(lobj, lobj, "lobj");
+	if ( hv_exists(MUTABLE_HV(lobj), key, keylen ) )
+	    ret = &PL_sv_yes;
 	else
-	    XSRETURN_NO;
+	    ret = &PL_sv_no;
+	PUSHs(ret);
 	PUTBACK;
 	return;
     }
-    else
-	Perl_croak(aTHX_ "lobj is not of type version");
 }
 
-XS(XS_version_qv)
+VXS(version_is_alpha)
+{
+    S_version_check_key(aTHX_ cv, "alpha", 5);
+}
+
+VXS(version_qv)
 {
-    dVAR;
     dXSARGS;
     PERL_UNUSED_ARG(cv);
     SP -= items;
     {
 	SV * ver = ST(0);
+	SV * sv0 = ver;
 	SV * rv;
         STRLEN len = 0;
         const char * classname = "";
         U32 flags = 0;
         if ( items == 2 ) {
-	    SvGETMAGIC(ST(1));
-	    if (SvOK(ST(1))) {
-		ver = ST(1);
+	    SV * sv1 = ST(1);
+	    SvGETMAGIC(sv1);
+	    if (SvOK(sv1)) {
+		ver = sv1;
 	    }
 	    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);
-                len       = HvNAMELEN(stash);
+            if ( sv_isobject(sv0) ) { /* class called as an object method */
+                const HV * stash = SvSTASH(SvRV(sv0));
+                classname = HvNAME_get(stash);
+                len       = HvNAMELEN_get(stash);
+#ifdef HvNAMEUTF8
                 flags     = HvNAMEUTF8(stash) ? SVf_UTF8 : 0;
+#endif
             }
             else {
-	       classname = SvPV(ST(0), len);
-                flags     = SvUTF8(ST(0));
+	       classname = SvPV(sv0, len);
+                flags     = SvUTF8(sv0);
             }
-        }
+	}
 	if ( !SvVOK(ver) ) { /* not already a v-string */
 	    rv = sv_newmortal();
-	    sv_setsv(rv,ver); /* make a duplicate */
-	    upg_version(rv, TRUE);
+	    SvSetSV_nosteal(rv,ver); /* make a duplicate */
+	    UPG_VERSION(rv, TRUE);
 	} else {
-	    rv = sv_2mortal(new_version(ver));
+	    rv = sv_2mortal(NEW_VERSION(ver));
 	}
-	if ( items == 2
-                && strnNE(classname,"version", len) ) { /* inherited new() */
+	if ( items == 2 && (len != 7
+                || strcmp(classname,"version")) ) { /* inherited new() */
 	    sv_bless(rv, gv_stashpvn(classname, len, GV_ADD | flags));
         }
 	PUSHs(rv);
@@ -388,24 +440,10 @@ XS(XS_version_qv)
     return;
 }
 
-XS(XS_version_is_qv)
+
+VXS(version_is_qv)
 {
-    dVAR;
-    dXSARGS;
-    if (items != 1)
-	croak_xs_usage(cv, "lobj");
-    SP -= items;
-    if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "version")) {
-	SV * const lobj = ST(0);
-	if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "qv", 2 ) )
-	    XSRETURN_YES;
-	else
-	    XSRETURN_NO;
-	PUTBACK;
-	return;
-    }
-    else
-	Perl_croak(aTHX_ "lobj is not of type version");
+    S_version_check_key(aTHX_ cv, "qv", 2);
 }
 
 #endif