This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fixup Perl_magic_freemglob()
[perl5.git] / vxs.inc
diff --git a/vxs.inc b/vxs.inc
index d246837..80bb8eb 100644 (file)
--- a/vxs.inc
+++ b/vxs.inc
@@ -5,7 +5,7 @@
 #  define VXS_CLASS "version"
 #  define VXSp(name) XS_##name
 /* VXSXSDP = XSUB Details Proto */
-#  define VXSXSDP(x) x
+#  define VXSXSDP(x) x, 0
 #else
 #  define VXS_CLASS "version::vxs"
 #  define VXSp(name) VXS_##name
@@ -133,20 +133,16 @@ 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
+                          "%" 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",
+                            "%" 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",
@@ -162,7 +158,7 @@ VXS(universal_version)
        }
 
        if ( VCMP( req, sv ) > 0 ) {
-           if ( hv_existss(MUTABLE_HV(SvRV(req)), "qv") ) {
+           if ( hv_exists(MUTABLE_HV(SvRV(req)), "qv", 2 ) ) {
                req = VNORMAL(req);
                sv  = VNORMAL(sv);
            }
@@ -170,8 +166,8 @@ VXS(universal_version)
                req = VSTRINGIFY(req);
                sv  = VSTRINGIFY(sv);
            }
-           Perl_croak(aTHX_ "%"HEKf" version %"SVf" required--"
-               "this is only version %"SVf"", HEKfARG(HvNAME_HEK(pkg)),
+           Perl_croak(aTHX_ "%" HEKf " version %" SVf " required--"
+               "this is only version %" SVf, HEKfARG(HvNAME_HEK(pkg)),
                SVfARG(sv_2mortal(req)),
                SVfARG(sv_2mortal(sv)));
        }
@@ -205,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:
@@ -218,7 +210,7 @@ VXS(version_new)
         SvGETMAGIC(vs);
         if(SvOK(vs))
             break;
-        /* drop through */
+        /* fall through */
     case 1:
         /* no param or explicit undef */
         /* create empty object */
@@ -248,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);
 }
@@ -311,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;
@@ -321,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) )
               {
@@ -444,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);
     }