if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv))
&& (hv = GvHV(gv)))
{
- if (SvIV(subgen) == PL_sub_generation) {
+ if (SvIV(subgen) == (IV)PL_sub_generation) {
SV* sv;
SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
void XS_UNIVERSAL_isa(pTHX_ CV *cv);
void XS_UNIVERSAL_can(pTHX_ CV *cv);
void XS_UNIVERSAL_VERSION(pTHX_ CV *cv);
+XS(XS_version_new);
+XS(XS_version_stringify);
+XS(XS_version_numify);
+XS(XS_version_vcmp);
+XS(XS_version_boolean);
+XS(XS_version_noop);
XS(XS_utf8_valid);
XS(XS_utf8_encode);
XS(XS_utf8_decode);
XS(XS_utf8_native_to_unicode);
XS(XS_Internals_SvREADONLY);
XS(XS_Internals_SvREFCNT);
-XS(XS_Internals_hv_clear_placeholders);
+XS(XS_Internals_hv_clear_placehold);
void
Perl_boot_core_UNIVERSAL(pTHX)
newXS("UNIVERSAL::isa", XS_UNIVERSAL_isa, file);
newXS("UNIVERSAL::can", XS_UNIVERSAL_can, file);
newXS("UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, file);
+ {
+ /* create the package stash for version objects */
+ HV *hv = get_hv("version::OVERLOAD",TRUE);
+ SV *sv = *hv_fetch(hv,"register",8,1);
+ sv_inc(sv);
+ SvSETMAGIC(sv);
+ /* Make it findable via fetchmethod */
+ newXS("version::()", NULL, file);
+ newXS("version::new", XS_version_new, file);
+ newXS("version::(\"\"", XS_version_stringify, file);
+ newXS("version::stringify", XS_version_stringify, file);
+ newXS("version::(0+", XS_version_numify, file);
+ newXS("version::numify", XS_version_numify, file);
+ newXS("version::(cmp", XS_version_vcmp, file);
+ newXS("version::(<=>", XS_version_vcmp, file);
+ newXS("version::vcmp", XS_version_vcmp, file);
+ newXS("version::(bool", XS_version_boolean, file);
+ newXS("version::boolean", XS_version_boolean, file);
+ newXS("version::(nomethod", XS_version_noop, file);
+ newXS("version::noop", XS_version_noop, file);
+ }
newXS("utf8::valid", XS_utf8_valid, file);
newXS("utf8::encode", XS_utf8_encode, file);
newXS("utf8::decode", XS_utf8_decode, file);
newXSproto("Internals::SvREADONLY",XS_Internals_SvREADONLY, file, "\\[$%@];$");
newXSproto("Internals::SvREFCNT",XS_Internals_SvREFCNT, file, "\\[$%@];$");
newXSproto("Internals::hv_clear_placeholders",
- XS_Internals_hv_clear_placeholders, file, "\\%");
+ XS_Internals_hv_clear_placehold, file, "\\%");
}
XSRETURN(1);
}
+XS(XS_version_new)
+{
+ dXSARGS;
+ if (items != 2)
+ Perl_croak(aTHX_ "Usage: version::new(class, version)");
+ SP -= items;
+ {
+/* char * class = (char *)SvPV_nolen(ST(0)); */
+ SV * version = ST(1);
+
+{
+ PUSHs(new_version(version));
+}
+
+ PUTBACK;
+ return;
+ }
+}
+
+XS(XS_version_stringify)
+{
+ dXSARGS;
+ if (items < 1)
+ Perl_croak(aTHX_ "Usage: version::stringify(lobj, ...)");
+ SP -= items;
+ {
+ SV * lobj;
+
+ if (sv_derived_from(ST(0), "version")) {
+ SV *tmp = SvRV(ST(0));
+ lobj = tmp;
+ }
+ else
+ croak("lobj is not of type version");
+
+{
+ SV *vs = NEWSV(92,5);
+ if ( lobj == SvRV(PL_patchlevel) )
+ sv_catsv(vs,lobj);
+ else
+ vstringify(vs,lobj);
+ PUSHs(vs);
+}
+
+ PUTBACK;
+ return;
+ }
+}
+
+XS(XS_version_numify)
+{
+ dXSARGS;
+ if (items < 1)
+ Perl_croak(aTHX_ "Usage: version::numify(lobj, ...)");
+ SP -= items;
+ {
+ SV * lobj;
+
+ if (sv_derived_from(ST(0), "version")) {
+ SV *tmp = SvRV(ST(0));
+ lobj = tmp;
+ }
+ else
+ croak("lobj is not of type version");
+
+{
+ SV *vs = NEWSV(92,5);
+ vnumify(vs,lobj);
+ PUSHs(vs);
+}
+
+ PUTBACK;
+ return;
+ }
+}
+
+XS(XS_version_vcmp)
+{
+ dXSARGS;
+ if (items < 1)
+ Perl_croak(aTHX_ "Usage: version::vcmp(lobj, ...)");
+ SP -= items;
+ {
+ SV * lobj;
+
+ if (sv_derived_from(ST(0), "version")) {
+ SV *tmp = SvRV(ST(0));
+ lobj = tmp;
+ }
+ else
+ croak("lobj is not of type version");
+
+{
+ SV *rs;
+ SV *rvs;
+ SV * robj = ST(1);
+ IV swap = (IV)SvIV(ST(2));
+
+ if ( ! sv_derived_from(robj, "version") )
+ {
+ robj = new_version(robj);
+ }
+ rvs = SvRV(robj);
+
+ if ( swap )
+ {
+ rs = newSViv(sv_cmp(rvs,lobj));
+ }
+ else
+ {
+ rs = newSViv(sv_cmp(lobj,rvs));
+ }
+
+ PUSHs(rs);
+}
+
+ PUTBACK;
+ return;
+ }
+}
+
+XS(XS_version_boolean)
+{
+ dXSARGS;
+ if (items < 1)
+ Perl_croak(aTHX_ "Usage: version::boolean(lobj, ...)");
+ SP -= items;
+ {
+ SV * lobj;
+
+ if (sv_derived_from(ST(0), "version")) {
+ SV *tmp = SvRV(ST(0));
+ lobj = tmp;
+ }
+ else
+ croak("lobj is not of type version");
+
+{
+ SV *rs;
+ rs = newSViv(sv_cmp(lobj,Nullsv));
+ PUSHs(rs);
+}
+
+ PUTBACK;
+ return;
+ }
+}
+
+XS(XS_version_noop)
+{
+ dXSARGS;
+ if (items < 1)
+ Perl_croak(aTHX_ "Usage: version::noop(lobj, ...)");
+ {
+ SV * lobj;
+
+ if (sv_derived_from(ST(0), "version")) {
+ SV *tmp = SvRV(ST(0));
+ lobj = tmp;
+ }
+ else
+ croak("lobj is not of type version");
+
+{
+ croak("operation not supported with version object");
+}
+
+ }
+ XSRETURN_EMPTY;
+}
+
XS(XS_utf8_valid)
{
dXSARGS;
/* Maybe this should return the number of placeholders found in scalar context,
and a list of them in list context. */
-XS(XS_Internals_hv_clear_placeholders)
+XS(XS_Internals_hv_clear_placehold)
{
dXSARGS;
HV *hv = (HV *) SvRV(ST(0));
/* I don't care how many parameters were passed in, but I want to avoid
the unused variable warning. */
- items = HvPLACEHOLDERS(hv);
+ items = (I32)HvPLACEHOLDERS(hv);
if (items) {
HE *entry;
I32 riter = HvRITER(hv);
HE *eiter = HvEITER(hv);
hv_iterinit(hv);
- while (items
- && (entry
- = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) {
+ /* This may look suboptimal with the items *after* the iternext, but
+ it's quite deliberate. We only get here with items==0 if we've
+ just deleted the last placeholder in the hash. If we've just done
+ that then it means that the hash is in lazy delete mode, and the
+ HE is now only referenced in our iterator. If we just quit the loop
+ and discarded our iterator then the HE leaks. So we do the && the
+ other way to ensure iternext is called just one more time, which
+ has the side effect of triggering the lazy delete. */
+ while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
+ && items) {
SV *val = hv_iterval(hv, entry);
if (val == &PL_sv_undef) {
projects / p5sagit/p5-mst-13.2.git / blobdiff