[perl5.git] / vxs.inc

/* This file is part of the "version" CPAN distribution.  Please avoid
   editing it in the perl core. */

#ifdef PERL_CORE
#  define VXS_CLASS "version"
#else
#  define VXS_CLASS "version::vxs"
#endif

#ifdef VXS_XSUB_DETAILS
#  ifdef PERL_CORE
    {"UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, NULL},
#  else
    {VXS_CLASS "::_VERSION", XS_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},
#  ifdef PERL_CORE
    {VXS_CLASS "::vcmp", XS_version_vcmp, NULL},
#  else
    {VXS_CLASS "::VCMP", XS_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},
#else

#ifndef dVAR
#  define dVAR
#endif

XS(XS_UNIVERSAL_VERSION)
{
    dVAR;
    dXSARGS;
    HV *pkg;
    GV **gvp;
    GV *gv;
    SV *sv;
    const char *undef;
    PERL_UNUSED_ARG(cv);

    if (items < 1)
       Perl_croak(aTHX_ "Usage: UNIVERSAL::VERSION(sv, ...)");

    if (SvROK(ST(0))) {
        sv = MUTABLE_SV(SvRV(ST(0)));
        if (!SvOBJECT(sv))
            Perl_croak(aTHX_ "Cannot find version of an unblessed reference");
        pkg = SvSTASH(sv);
    }
    else {
        pkg = gv_stashsv(ST(0), 0);
    }

    gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : 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);

        undef = NULL;
    }
    else {
        sv = &PL_sv_undef;
        undef = "(undef)";
    }

    if (items > 1) {
	SV *req = ST(1);

	if (undef) {
	    if (pkg) {
		const HEK * const name = HvNAME_HEK(pkg);
		Perl_croak(aTHX_
			   "%"HEKf" does not define $%"HEKf
			   "::VERSION--version check failed",
			   HEKfARG(name), HEKfARG(name));
	    } else {
		Perl_croak(aTHX_
			     "%"SVf" defines neither package nor VERSION--version check failed",
			     SVfARG(ST(0)) );
	    }
	}

	if ( !sv_isobject(req) || !sv_derived_from(req, "version")) {
	    /* req may very well be R/O, so create a new object */
	    req = sv_2mortal( new_version(req) );
	}

	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))));
	    }
	}
    }

    if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
	ST(0) = sv_2mortal(vstringify(sv));
    } else {
	ST(0) = sv;
    }

    XSRETURN(1);
}

XS(XS_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));
        }

	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)));
	}

	rv = new_version(vs);
	if ( strnNE(classname,"version", len) ) /* inherited new() */
	    sv_bless(rv, gv_stashpvn(classname, len, GV_ADD | flags));

	mPUSHs(rv);
	PUTBACK;
	return;
    }
}

XS(XS_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");

	  mPUSHs(vstringify(lobj));

	  PUTBACK;
	  return;
     }
}

XS(XS_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;
     }
}

XS(XS_version_normal)
{
     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(vnormal(lobj));

	  PUTBACK;
	  return;
     }
}

XS(XS_version_vcmp)
{
     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	*rs;
	       SV	*rvs;
	       SV * robj = ST(1);
	       const IV	 swap = (IV)SvIV(ST(2));

	       if ( !sv_isobject(robj) || !sv_derived_from(robj, "version") )
	       {
		    robj = new_version(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
		    sv_2mortal(robj);
	       }
	       rvs = SvRV(robj);

	       if ( swap )
	       {
		    rs = newSViv(vcmp(rvs,lobj));
	       }
	       else
	       {
		    rs = newSViv(vcmp(lobj,rvs));
	       }

	       mPUSHs(rs);
	  }

	  PUTBACK;
	  return;
     }
}

XS(XS_version_boolean)
{
    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 = SvRV(ST(0));
	SV * const rs =
	    newSViv( vcmp(lobj,
			  sv_2mortal(new_version(
					sv_2mortal(newSVpvs("0"))
				    ))
			 )
		   );
	mPUSHs(rs);
	PUTBACK;
	return;
    }
    else
	Perl_croak(aTHX_ "lobj is not of type version");
}

XS(XS_version_noop)
{
    dVAR;
    dXSARGS;
    if (items < 1)
	croak_xs_usage(cv, "lobj, ...");
    if (sv_isobject(ST(0)) && sv_derived_from(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)
{
    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;
	else
	    XSRETURN_NO;
	PUTBACK;
	return;
    }
    else
	Perl_croak(aTHX_ "lobj is not of type version");
}

XS(XS_version_qv)
{
    dVAR;
    dXSARGS;
    PERL_UNUSED_ARG(cv);
    SP -= items;
    {
	SV * ver = ST(0);
	SV * rv;
        STRLEN len = 0;
        const char * classname = "";
        U32 flags = 0;
        if ( items == 2 ) {
	    SvGETMAGIC(ST(1));
	    if (SvOK(ST(1))) {
		ver = ST(1);
	    }
	    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);
                flags     = HvNAMEUTF8(stash) ? SVf_UTF8 : 0;
            }
            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);
	} else {
	    rv = sv_2mortal(new_version(ver));
	}
	if ( items == 2
                && strnNE(classname,"version", len) ) { /* inherited new() */
	    sv_bless(rv, gv_stashpvn(classname, len, GV_ADD | flags));
        }
	PUSHs(rv);
    }
    PUTBACK;
    return;
}

XS(XS_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");
}

#endif
Commit	Line	Data
abc6d738 FC	1	/* This file is part of the "version" CPAN distribution. Please avoid
	2	editing it in the perl core. */
	3
b42aaea1 FC	4	#ifdef PERL_CORE
	5	# define VXS_CLASS "version"
	6	#else
	7	# define VXS_CLASS "version::vxs"
	8	#endif
	9
abc6d738	10	#ifdef VXS_XSUB_DETAILS
b42aaea1	11	# ifdef PERL_CORE
abc6d738	12	{"UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, NULL},
b42aaea1 FC	13	# else
	14	{VXS_CLASS "::_VERSION", XS_UNIVERSAL_VERSION, NULL},
	15	# endif
	16	{VXS_CLASS "::()", XS_version_noop, NULL},
	17	{VXS_CLASS "::new", XS_version_new, NULL},
	18	{VXS_CLASS "::parse", XS_version_new, NULL},
	19	{VXS_CLASS "::(\"\"", XS_version_stringify, NULL},
	20	{VXS_CLASS "::stringify", XS_version_stringify, NULL},
	21	{VXS_CLASS "::(0+", XS_version_numify, NULL},
	22	{VXS_CLASS "::numify", XS_version_numify, NULL},
	23	{VXS_CLASS "::normal", XS_version_normal, NULL},
	24	{VXS_CLASS "::(cmp", XS_version_vcmp, NULL},
	25	{VXS_CLASS "::(<=>", XS_version_vcmp, NULL},
	26	# ifdef PERL_CORE
	27	{VXS_CLASS "::vcmp", XS_version_vcmp, NULL},
	28	# else
	29	{VXS_CLASS "::VCMP", XS_version_vcmp, NULL},
	30	# endif
	31	{VXS_CLASS "::(bool", XS_version_boolean, NULL},
	32	{VXS_CLASS "::boolean", XS_version_boolean, NULL},
	33	{VXS_CLASS "::(+", XS_version_noop, NULL},
	34	{VXS_CLASS "::(-", XS_version_noop, NULL},
	35	{VXS_CLASS "::(*", XS_version_noop, NULL},
	36	{VXS_CLASS "::(/", XS_version_noop, NULL},
	37	{VXS_CLASS "::(+=", XS_version_noop, NULL},
	38	{VXS_CLASS "::(-=", XS_version_noop, NULL},
	39	{VXS_CLASS "::(*=", XS_version_noop, NULL},
	40	{VXS_CLASS "::(/=", XS_version_noop, NULL},
	41	{VXS_CLASS "::(abs", XS_version_noop, NULL},
	42	{VXS_CLASS "::(nomethod", XS_version_noop, NULL},
	43	{VXS_CLASS "::noop", XS_version_noop, NULL},
	44	{VXS_CLASS "::is_alpha", XS_version_is_alpha, NULL},
	45	{VXS_CLASS "::qv", XS_version_qv, NULL},
	46	{VXS_CLASS "::declare", XS_version_qv, NULL},
	47	{VXS_CLASS "::is_qv", XS_version_is_qv, NULL},
abc6d738 FC	48	#else
abc6d738 FC	49
04df8d4d FC	50	#ifndef dVAR
	51	# define dVAR
	52	#endif
	53
abc6d738 FC	54	XS(XS_UNIVERSAL_VERSION)
	55	{
	56	dVAR;
	57	dXSARGS;
	58	HV *pkg;
	59	GV **gvp;
	60	GV *gv;
	61	SV *sv;
	62	const char *undef;
	63	PERL_UNUSED_ARG(cv);
	64
8372457d FC	65	if (items < 1)
	66	Perl_croak(aTHX_ "Usage: UNIVERSAL::VERSION(sv, ...)");
	67
abc6d738 FC	68	if (SvROK(ST(0))) {
	69	sv = MUTABLE_SV(SvRV(ST(0)));
	70	if (!SvOBJECT(sv))
	71	Perl_croak(aTHX_ "Cannot find version of an unblessed reference");
	72	pkg = SvSTASH(sv);
	73	}
	74	else {
	75	pkg = gv_stashsv(ST(0), 0);
	76	}
	77
	78	gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
	79
	80	if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
	81	SV * const nsv = sv_newmortal();
	82	sv_setsv(nsv, sv);
	83	sv = nsv;
	84	if ( !sv_isobject(sv) \|\| !sv_derived_from(sv, "version"))
	85	upg_version(sv, FALSE);
	86
	87	undef = NULL;
	88	}
	89	else {
	90	sv = &PL_sv_undef;
	91	undef = "(undef)";
	92	}
	93
	94	if (items > 1) {
	95	SV *req = ST(1);
	96
	97	if (undef) {
	98	if (pkg) {
	99	const HEK * const name = HvNAME_HEK(pkg);
	100	Perl_croak(aTHX_
	101	"%"HEKf" does not define $%"HEKf
	102	"::VERSION--version check failed",
	103	HEKfARG(name), HEKfARG(name));
	104	} else {
	105	Perl_croak(aTHX_
	106	"%"SVf" defines neither package nor VERSION--version check failed",
	107	SVfARG(ST(0)) );
	108	}
	109	}
	110
	111	if ( !sv_isobject(req) \|\| !sv_derived_from(req, "version")) {
	112	/* req may very well be R/O, so create a new object */
	113	req = sv_2mortal( new_version(req) );
	114	}
	115
	116	if ( vcmp( req, sv ) > 0 ) {
	117	if ( hv_exists(MUTABLE_HV(SvRV(req)), "qv", 2 ) ) {
	118	Perl_croak(aTHX_ "%"HEKf" version %"SVf" required--"
	119	"this is only version %"SVf"",
	120	HEKfARG(HvNAME_HEK(pkg)),
	121	SVfARG(sv_2mortal(vnormal(req))),
	122	SVfARG(sv_2mortal(vnormal(sv))));
	123	} else {
	124	Perl_croak(aTHX_ "%"HEKf" version %"SVf" required--"
	125	"this is only version %"SVf,
	126	HEKfARG(HvNAME_HEK(pkg)),
	127	SVfARG(sv_2mortal(vstringify(req))),
	128	SVfARG(sv_2mortal(vstringify(sv))));
	129	}
	130	}
	131	}
132
133	if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
134	ST(0) = sv_2mortal(vstringify(sv));
135	} else {
136	ST(0) = sv;
137	}
138
139	XSRETURN(1);
140	}
141
142	XS(XS_version_new)
143	{
144	dVAR;
145	dXSARGS;
146	if (items > 3 \|\| items < 1)
147	croak_xs_usage(cv, "class, version");
148	SP -= items;
149	{
150	SV *vs = ST(1);
151	SV *rv;
152	STRLEN len;
153	const char *classname;
154	U32 flags;
155
156	/* Just in case this is something like a tied hash */
157	SvGETMAGIC(vs);
158
159	if ( sv_isobject(ST(0)) ) { /* get the class if called as an object method */
160	const HV * stash = SvSTASH(SvRV(ST(0)));
161	classname = HvNAME(stash);
162	len = HvNAMELEN(stash);
163	flags = HvNAMEUTF8(stash) ? SVf_UTF8 : 0;
164	}
165	else {
166	classname = SvPV(ST(0), len);
167	flags = SvUTF8(ST(0));
168	}
169
170	if ( items == 1 \|\| ! SvOK(vs) ) { /* no param or explicit undef */
171	/* create empty object */
172	vs = sv_newmortal();
173	sv_setpvs(vs, "0");
174	}
175	else if ( items == 3 ) {
176	vs = sv_newmortal();
177	Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2)));
178	}
179
180	rv = new_version(vs);
181	if ( strnNE(classname,"version", len) ) /* inherited new() */
182	sv_bless(rv, gv_stashpvn(classname, len, GV_ADD \| flags));
183
184	mPUSHs(rv);
185	PUTBACK;
186	return;
187	}
188	}
189
190	XS(XS_version_stringify)
191	{
192	dVAR;
193	dXSARGS;
194	if (items < 1)
195	croak_xs_usage(cv, "lobj, ...");
196	SP -= items;
197	{
198	SV * lobj = ST(0);
199
200	if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
201	lobj = SvRV(lobj);
202	}
203	else
204	Perl_croak(aTHX_ "lobj is not of type version");
205
206	mPUSHs(vstringify(lobj));
207
208	PUTBACK;
209	return;
210	}
211	}
212
213	XS(XS_version_numify)
214	{
215	dVAR;
216	dXSARGS;
217	if (items < 1)
218	croak_xs_usage(cv, "lobj, ...");
219	SP -= items;
220	{
221	SV * lobj = ST(0);
222
223	if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
224	lobj = SvRV(lobj);
225	}
226	else
227	Perl_croak(aTHX_ "lobj is not of type version");
228
229	mPUSHs(vnumify(lobj));
230
231	PUTBACK;
232	return;
233	}
234	}
235
236	XS(XS_version_normal)
237	{
238	dVAR;
239	dXSARGS;
240	if (items < 1)
241	croak_xs_usage(cv, "lobj, ...");
242	SP -= items;
243	{
244	SV * lobj = ST(0);
245
246	if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
247	lobj = SvRV(lobj);
248	}
249	else
250	Perl_croak(aTHX_ "lobj is not of type version");
251
252	mPUSHs(vnormal(lobj));
253
254	PUTBACK;
255	return;
256	}
257	}
258
259	XS(XS_version_vcmp)
260	{
261	dVAR;
262	dXSARGS;
263	if (items < 1)
264	croak_xs_usage(cv, "lobj, ...");
265	SP -= items;
266	{
267	SV * lobj = ST(0);
268
269	if (sv_isobject(lobj) && sv_derived_from(lobj, "version")) {
270	lobj = SvRV(lobj);
271	}
272	else
273	Perl_croak(aTHX_ "lobj is not of type version");
274
275	{
276	SV *rs;
277	SV *rvs;
278	SV * robj = ST(1);
279	const IV swap = (IV)SvIV(ST(2));
280
281	if ( !sv_isobject(robj) \|\| !sv_derived_from(robj, "version") )
282	{
283	robj = new_version(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
284	sv_2mortal(robj);
285	}
286	rvs = SvRV(robj);
287
288	if ( swap )
289	{
290	rs = newSViv(vcmp(rvs,lobj));
291	}
292	else
293	{
294	rs = newSViv(vcmp(lobj,rvs));
295	}
296
297	mPUSHs(rs);
298	}
299
300	PUTBACK;
301	return;
302	}
303	}
304
305	XS(XS_version_boolean)
306	{
307	dVAR;
308	dXSARGS;
309	if (items < 1)
310	croak_xs_usage(cv, "lobj, ...");
311	SP -= items;
312	if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "version")) {
313	SV * const lobj = SvRV(ST(0));
314	SV * const rs =
315	newSViv( vcmp(lobj,
316	sv_2mortal(new_version(
317	sv_2mortal(newSVpvs("0"))
318	))
319	)
320	);
321	mPUSHs(rs);
322	PUTBACK;
323	return;
324	}
325	else
326	Perl_croak(aTHX_ "lobj is not of type version");
327	}
328
329	XS(XS_version_noop)
330	{
331	dVAR;
332	dXSARGS;
333	if (items < 1)
334	croak_xs_usage(cv, "lobj, ...");
335	if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "version"))
336	Perl_croak(aTHX_ "operation not supported with version object");
337	else
338	Perl_croak(aTHX_ "lobj is not of type version");
339	#ifndef HASATTRIBUTE_NORETURN
340	XSRETURN_EMPTY;
341	#endif
342	}
343
344	XS(XS_version_is_alpha)
345	{
346	dVAR;
347	dXSARGS;
348	if (items != 1)
349	croak_xs_usage(cv, "lobj");
350	SP -= items;
351	if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "version")) {
352	SV * const lobj = ST(0);
353	if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "alpha", 5 ) )
354	XSRETURN_YES;
355	else
356	XSRETURN_NO;
357	PUTBACK;
358	return;
359	}
360	else
361	Perl_croak(aTHX_ "lobj is not of type version");
362	}
363
364	XS(XS_version_qv)
365	{
366	dVAR;
367	dXSARGS;
368	PERL_UNUSED_ARG(cv);
369	SP -= items;
370	{
371	SV * ver = ST(0);
372	SV * rv;
373	STRLEN len = 0;
374	const char * classname = "";
375	U32 flags = 0;
376	if ( items == 2 ) {
377	SvGETMAGIC(ST(1));
378	if (SvOK(ST(1))) {
379	ver = ST(1);
380	}
381	else {
382	Perl_croak(aTHX_ "Invalid version format (version required)");
383	}
384	if ( sv_isobject(ST(0)) ) { /* class called as an object method */
385	const HV * stash = SvSTASH(SvRV(ST(0)));
386	classname = HvNAME(stash);
387	len = HvNAMELEN(stash);
388	flags = HvNAMEUTF8(stash) ? SVf_UTF8 : 0;
389	}
390	else {
391	classname = SvPV(ST(0), len);
392	flags = SvUTF8(ST(0));
393	}
394	}
395	if ( !SvVOK(ver) ) { /* not already a v-string */
396	rv = sv_newmortal();
397	sv_setsv(rv,ver); /* make a duplicate */
398	upg_version(rv, TRUE);
399	} else {
400	rv = sv_2mortal(new_version(ver));
401	}
402	if ( items == 2
403	&& strnNE(classname,"version", len) ) { /* inherited new() */
404	sv_bless(rv, gv_stashpvn(classname, len, GV_ADD \| flags));
405	}
406	PUSHs(rv);
407	}
408	PUTBACK;
409	return;
410	}
411
412	XS(XS_version_is_qv)
413	{
414	dVAR;
415	dXSARGS;
416	if (items != 1)
417	croak_xs_usage(cv, "lobj");
418	SP -= items;
419	if (sv_isobject(ST(0)) && sv_derived_from(ST(0), "version")) {
420	SV * const lobj = ST(0);
421	if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "qv", 2 ) )
422	XSRETURN_YES;
423	else
424	XSRETURN_NO;
425	PUTBACK;
426	return;
427	}
428	else
429	Perl_croak(aTHX_ "lobj is not of type version");
430	}
431
432	#endif