#ifdef PERL_CORE
# define VXS_CLASS "version"
+# define VXSp(name) XS_##name
#else
# define VXS_CLASS "version::vxs"
+# define VXSp(name) VXS_##name
#endif
+#define VXS(name) XS(VXSp(name))
#ifdef VXS_XSUB_DETAILS
# ifdef PERL_CORE
{"UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, NULL},
# else
- {VXS_CLASS "::_VERSION", XS_UNIVERSAL_VERSION, NULL},
+ {VXS_CLASS "::_VERSION", VXS_UNIVERSAL_VERSION, NULL},
# endif
- {VXS_CLASS "::()", XS_version_noop, NULL},
- {VXS_CLASS "::new", XS_version_new, NULL},
- {VXS_CLASS "::parse", XS_version_new, NULL},
- {VXS_CLASS "::(\"\"", XS_version_stringify, NULL},
- {VXS_CLASS "::stringify", XS_version_stringify, NULL},
- {VXS_CLASS "::(0+", XS_version_numify, NULL},
- {VXS_CLASS "::numify", XS_version_numify, NULL},
- {VXS_CLASS "::normal", XS_version_normal, NULL},
- {VXS_CLASS "::(cmp", XS_version_vcmp, NULL},
- {VXS_CLASS "::(<=>", XS_version_vcmp, NULL},
+ {VXS_CLASS "::()", VXSp(version_noop), NULL},
+ {VXS_CLASS "::new", VXSp(version_new), NULL},
+ {VXS_CLASS "::parse", VXSp(version_new), NULL},
+ {VXS_CLASS "::(\"\"", VXSp(version_stringify), NULL},
+ {VXS_CLASS "::stringify", VXSp(version_stringify), NULL},
+ {VXS_CLASS "::(0+", VXSp(version_numify), NULL},
+ {VXS_CLASS "::numify", VXSp(version_numify), NULL},
+ {VXS_CLASS "::normal", VXSp(version_normal), NULL},
+ {VXS_CLASS "::(cmp", VXSp(version_vcmp), NULL},
+ {VXS_CLASS "::(<=>", VXSp(version_vcmp), NULL},
# ifdef PERL_CORE
{VXS_CLASS "::vcmp", XS_version_vcmp, NULL},
# else
- {VXS_CLASS "::VCMP", XS_version_vcmp, NULL},
+ {VXS_CLASS "::VCMP", VXS_version_vcmp, NULL},
# endif
- {VXS_CLASS "::(bool", XS_version_boolean, NULL},
- {VXS_CLASS "::boolean", XS_version_boolean, NULL},
- {VXS_CLASS "::(+", XS_version_noop, NULL},
- {VXS_CLASS "::(-", XS_version_noop, NULL},
- {VXS_CLASS "::(*", XS_version_noop, NULL},
- {VXS_CLASS "::(/", XS_version_noop, NULL},
- {VXS_CLASS "::(+=", XS_version_noop, NULL},
- {VXS_CLASS "::(-=", XS_version_noop, NULL},
- {VXS_CLASS "::(*=", XS_version_noop, NULL},
- {VXS_CLASS "::(/=", XS_version_noop, NULL},
- {VXS_CLASS "::(abs", XS_version_noop, NULL},
- {VXS_CLASS "::(nomethod", XS_version_noop, NULL},
- {VXS_CLASS "::noop", XS_version_noop, NULL},
- {VXS_CLASS "::is_alpha", XS_version_is_alpha, NULL},
- {VXS_CLASS "::qv", XS_version_qv, NULL},
- {VXS_CLASS "::declare", XS_version_qv, NULL},
- {VXS_CLASS "::is_qv", XS_version_is_qv, NULL},
+ {VXS_CLASS "::(bool", VXSp(version_boolean), NULL},
+ {VXS_CLASS "::boolean", VXSp(version_boolean), NULL},
+ {VXS_CLASS "::(+", VXSp(version_noop), NULL},
+ {VXS_CLASS "::(-", VXSp(version_noop), NULL},
+ {VXS_CLASS "::(*", VXSp(version_noop), NULL},
+ {VXS_CLASS "::(/", VXSp(version_noop), NULL},
+ {VXS_CLASS "::(+=", VXSp(version_noop), NULL},
+ {VXS_CLASS "::(-=", VXSp(version_noop), NULL},
+ {VXS_CLASS "::(*=", VXSp(version_noop), NULL},
+ {VXS_CLASS "::(/=", VXSp(version_noop), NULL},
+ {VXS_CLASS "::(abs", VXSp(version_noop), NULL},
+ {VXS_CLASS "::(nomethod", VXSp(version_noop), NULL},
+ {VXS_CLASS "::noop", VXSp(version_noop), NULL},
+ {VXS_CLASS "::is_alpha", VXSp(version_is_alpha), NULL},
+ {VXS_CLASS "::qv", VXSp(version_qv), NULL},
+ {VXS_CLASS "::declare", VXSp(version_qv), NULL},
+ {VXS_CLASS "::is_qv", VXSp(version_is_qv), NULL},
#else
#ifndef dVAR
# define HEKf "s"
#endif
-XS(XS_UNIVERSAL_VERSION)
+VXS(UNIVERSAL_VERSION)
{
dVAR;
dXSARGS;
if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
sv = sv_mortalcopy(sv);
- if ( ! ISA_CLASS_OBJ(sv, "version::vxs"))
+ if ( ! ISA_CLASS_OBJ(sv, "version"))
UPG_VERSION(sv, FALSE);
undef = NULL;
}
XSRETURN(1);
}
-XS(XS_version_new)
+VXS(version_new)
{
dVAR;
dXSARGS;
- if (items > 3 || items < 1)
- croak_xs_usage(cv, "class, version");
+ PERL_UNUSED_VAR(cv);
+ SV *vs = items ? ST(1) : &PL_sv_undef;
+ SV *rv;
+ const char * classname = "";
+ STRLEN len;
+ U32 flags = 0;
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));
- }
- 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)));
- }
+ if (items > 3 || items == 0)
+ Perl_croak(aTHX_ "Usage: version::new(class, version)");
- rv = new_version(vs);
- if ( strnNE(classname,"version", len) ) /* inherited new() */
- sv_bless(rv, gv_stashpvn(classname, len, GV_ADD | flags));
+ /* Just in case this is something like a tied hash */
+ SvGETMAGIC(vs);
- mPUSHs(rv);
- PUTBACK;
- return;
+ if ( items == 1 || ! SvOK(vs) ) { /* no param or explicit undef */
+ /* create empty object */
+ vs = sv_newmortal();
+ sv_setpvs(vs,"undef");
+ }
+ else if (items == 3 ) {
+ vs = sv_newmortal();
+#if PERL_VERSION == 5
+ sv_setpvf(vs,"v%s",SvPV_nolen_const(ST(2)));
+#else
+ Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2)));
+#endif
+ }
+ if ( sv_isobject(ST(0)) ) {
+ /* get the class if called as an object method */
+ const HV * stash = SvSTASH(SvRV(ST(0)));
+ 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));
+ }
+
+ 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
+
+ mPUSHs(rv);
+ PUTBACK;
+ return;
}
-XS(XS_version_stringify)
+#define VTYPECHECK(var, val, varname) \
+ STMT_START { \
+ if (ISA_CLASS_OBJ(val, "version")) { \
+ (var) = SvRV(val); \
+ } \
+ else \
+ Perl_croak(aTHX_ varname " is not of type version"); \
+ } STMT_END
+
+VXS(version_stringify)
{
dVAR;
dXSARGS;
croak_xs_usage(cv, "lobj, ...");
SP -= items;
{
- SV * lobj = ST(0);
+ SV * lobj;
+ VTYPECHECK(lobj, ST(0), "lobj");
- if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
- lobj = SvRV(lobj);
- }
- else
- Perl_croak(aTHX_ "lobj is not of type version");
-
- mPUSHs(vstringify(lobj));
+ mPUSHs(VSTRINGIFY(lobj));
PUTBACK;
return;
}
}
-XS(XS_version_numify)
+VXS(version_numify)
{
dVAR;
dXSARGS;
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));
-
+ SV * lobj;
+ VTYPECHECK(lobj, ST(0), "lobj");
+ mPUSHs(VNUMIFY(lobj));
PUTBACK;
return;
}
}
-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));
+ mPUSHs(VNORMAL(ver));
PUTBACK;
return;
}
}
-XS(XS_version_vcmp)
+VXS(version_vcmp)
{
dVAR;
dXSARGS;
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");
{
SV *rs;
SV *rvs;
SV * robj = ST(1);
const IV swap = (IV)SvIV(ST(2));
- if ( !sv_isobject(robj) || !sv_derived_from(robj, "version") )
+ if ( !ISA_CLASS_OBJ(robj, "version") )
{
- robj = new_version(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
+ robj = NEW_VERSION(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
sv_2mortal(robj);
}
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);
}
}
-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"))
))
)
PUTBACK;
return;
}
- 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_CLASS_OBJ(ST(0), "version"))
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)
+VXS(version_is_alpha)
{
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 ) )
+ {
+ SV *lobj;
+ VTYPECHECK(lobj, ST(0), "lobj");
+ if ( hv_exists(MUTABLE_HV(lobj), "alpha", 5 ) )
XSRETURN_YES;
else
XSRETURN_NO;
PUTBACK;
return;
}
- else
- Perl_croak(aTHX_ "lobj is not of type version");
}
-XS(XS_version_qv)
+VXS(version_qv)
{
dVAR;
dXSARGS;
}
if ( sv_isobject(ST(0)) ) { /* class called as an object method */
const HV * stash = SvSTASH(SvRV(ST(0)));
- classname = HvNAME(stash);
- len = HvNAMELEN(stash);
+ 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));
}
- }
+ }
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() */
+#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);
}
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 ) )
+ {
+ SV *lobj;
+ VTYPECHECK(lobj, ST(0), "lobj");
+ if ( hv_exists(MUTABLE_HV(lobj), "qv", 2 ) )
XSRETURN_YES;
else
XSRETURN_NO;
PUTBACK;
return;
}
- else
- Perl_croak(aTHX_ "lobj is not of type version");
}
#endif