[perl5.git] / vxs.inc

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

#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},
#else

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

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