X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=universal.c;h=22be54f128f0266789d454ad3c3730094064cc48;hb=ca9279baf07d6843f58a31f1ce3ff7dc875faf1a;hp=3f70ac62a855a5e6c10e2d6a0468770069caa00b;hpb=4bb101f2758f169969171dfe6b70f68a406dcc1e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/universal.c b/universal.c index 3f70ac6..22be54f 100644 --- a/universal.c +++ b/universal.c @@ -171,6 +171,7 @@ XS(XS_version_numify); XS(XS_version_vcmp); XS(XS_version_boolean); XS(XS_version_noop); +XS(XS_utf8_is_utf8); XS(XS_utf8_valid); XS(XS_utf8_encode); XS(XS_utf8_decode); @@ -182,6 +183,7 @@ XS(XS_Internals_SvREADONLY); XS(XS_Internals_SvREFCNT); XS(XS_Internals_hv_clear_placehold); XS(XS_PerlIO_get_layers); +XS(XS_Regexp_DESTROY); void Perl_boot_core_UNIVERSAL(pTHX) @@ -209,6 +211,7 @@ Perl_boot_core_UNIVERSAL(pTHX) newXS("version::(nomethod", XS_version_noop, file); newXS("version::noop", XS_version_noop, file); } + newXS("utf8::is_utf8", XS_utf8_is_utf8, file); newXS("utf8::valid", XS_utf8_valid, file); newXS("utf8::encode", XS_utf8_encode, file); newXS("utf8::decode", XS_utf8_decode, file); @@ -222,6 +225,7 @@ Perl_boot_core_UNIVERSAL(pTHX) XS_Internals_hv_clear_placehold, file, "\\%"); newXSproto("PerlIO::get_layers", XS_PerlIO_get_layers, file, "*;@"); + newXS("Regexp::DESTROY", XS_Regexp_DESTROY, file); } @@ -381,166 +385,183 @@ XS(XS_version_new) 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 - Perl_croak(aTHX_ "lobj is not of type version"); - -{ - PUSHs(vstringify(lobj)); -} - - PUTBACK; - return; - } + 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 + Perl_croak(aTHX_ "lobj is not of type version"); + + { + PUSHs(vstringify(lobj)); + } + + 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 - Perl_croak(aTHX_ "lobj is not of type version"); - -{ - PUSHs(vnumify(lobj)); -} - - PUTBACK; - return; - } + 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 + Perl_croak(aTHX_ "lobj is not of type version"); + + { + PUSHs(vnumify(lobj)); + } + + 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 - Perl_croak(aTHX_ "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(vcmp(rvs,lobj)); - } - else - { - rs = newSViv(vcmp(lobj,rvs)); - } - - PUSHs(rs); -} - - PUTBACK; - return; - } + 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 + Perl_croak(aTHX_ "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(vcmp(rvs,lobj)); + } + else + { + rs = newSViv(vcmp(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 - Perl_croak(aTHX_ "lobj is not of type version"); - -{ - SV *rs; - rs = newSViv( vcmp(lobj,new_version(newSVpvn("0",1))) ); - PUSHs(rs); -} - - PUTBACK; - return; - } + 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 + Perl_croak(aTHX_ "lobj is not of type version"); + + { + SV *rs; + rs = newSViv( vcmp(lobj,new_version(newSVpvn("0",1))) ); + 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 - Perl_croak(aTHX_ "lobj is not of type version"); - -{ - Perl_croak(aTHX_ "operation not supported with version object"); + 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 + Perl_croak(aTHX_ "lobj is not of type version"); + + { + Perl_croak(aTHX_ "operation not supported with version object"); + } + + } + XSRETURN_EMPTY; } - } - XSRETURN_EMPTY; +XS(XS_utf8_is_utf8) +{ + dXSARGS; + if (items != 1) + Perl_croak(aTHX_ "Usage: utf8::is_utf8(sv)"); + { + SV * sv = ST(0); + { + if (SvUTF8(sv)) + XSRETURN_YES; + else + XSRETURN_NO; + } + } + XSRETURN_EMPTY; } XS(XS_utf8_valid) { - dXSARGS; - if (items != 1) - Perl_croak(aTHX_ "Usage: utf8::valid(sv)"); - { - SV * sv = ST(0); - { - STRLEN len; - char *s = SvPV(sv,len); - if (!SvUTF8(sv) || is_utf8_string((U8*)s,len)) - XSRETURN_YES; - else - XSRETURN_NO; - } - } - XSRETURN_EMPTY; + dXSARGS; + if (items != 1) + Perl_croak(aTHX_ "Usage: utf8::valid(sv)"); + { + SV * sv = ST(0); + { + STRLEN len; + char *s = SvPV(sv,len); + if (!SvUTF8(sv) || is_utf8_string((U8*)s,len)) + XSRETURN_YES; + else + XSRETURN_NO; + } + } + XSRETURN_EMPTY; } XS(XS_utf8_encode) @@ -723,6 +744,11 @@ XS(XS_Internals_hv_clear_placehold) XSRETURN(0); } +XS(XS_Regexp_DESTROY) +{ + +} + XS(XS_PerlIO_get_layers) { dXSARGS; @@ -737,7 +763,6 @@ XS(XS_PerlIO_get_layers) bool details = FALSE; if (items > 1) { - SV **popuntil = MARK + 1; SV **svp; for (svp = MARK + 2; svp <= SP; svp += 2) {