X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xsutils.c;h=186405092f6598b2d5cece78fc7405f0abc90c5c;hb=642eb38136f2ca16919538298be0521b16a2091e;hp=4ea4de2871a2ccf201da6b51108d88fa02e4f0a3;hpb=58c0efa57789d77088d564834046e633a5c42edc;p=p5sagit%2Fp5-mst-13.2.git diff --git a/xsutils.c b/xsutils.c index 4ea4de2..1864050 100644 --- a/xsutils.c +++ b/xsutils.c @@ -1,6 +1,6 @@ /* xsutils.c * - * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, + * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, * by Larry Wall and others * * You may distribute under the terms of either the GNU General Public @@ -71,17 +71,6 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) switch (SvTYPE(sv)) { case SVt_PVCV: switch ((int)len) { -#ifdef CVf_ASSERTION - case 9: - if (memEQ(name, "assertion", 9)) { - if (negated) - CvFLAGS((CV*)sv) &= ~CVf_ASSERTION; - else - CvFLAGS((CV*)sv) |= CVf_ASSERTION; - continue; - } - break; -#endif case 6: switch (name[3]) { #ifdef CVf_LVALUE @@ -131,7 +120,7 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) break; case 'e': if (memEQ(name, "uniqu", 5)) { - if (SvTYPE(sv) == SVt_PVGV) { + if (isGV_with_GP(sv)) { if (negated) { GvUNIQUE_off(sv); } else { @@ -161,10 +150,9 @@ XS(XS_attributes_bootstrap) { dVAR; dXSARGS; - PERL_UNUSED_ARG(cv); if( items > 1 ) - Perl_croak(aTHX_ "Usage: attributes::bootstrap $module"); + croak_xs_usage(cv, "$module"); newXS("attributes::_modify_attrs", XS_attributes__modify_attrs, file); newXSproto("attributes::_guess_stash", XS_attributes__guess_stash, file, "$"); @@ -179,12 +167,10 @@ XS(XS_attributes__modify_attrs) dVAR; dXSARGS; SV *rv, *sv; - PERL_UNUSED_ARG(cv); if (items < 1) { usage: - Perl_croak(aTHX_ - "Usage: attributes::_modify_attrs $reference, @attributes"); + croak_xs_usage(cv, "@attributes"); } rv = ST(0); @@ -203,12 +189,10 @@ XS(XS_attributes__fetch_attrs) dXSARGS; SV *rv, *sv; cv_flags_t cvflags; - PERL_UNUSED_ARG(cv); if (items != 1) { usage: - Perl_croak(aTHX_ - "Usage: attributes::_fetch_attrs $reference"); + croak_xs_usage(cv, "$reference"); } rv = ST(0); @@ -221,21 +205,19 @@ usage: case SVt_PVCV: cvflags = CvFLAGS((CV*)sv); if (cvflags & CVf_LOCKED) - XPUSHs(sv_2mortal(newSVpvs("locked"))); + XPUSHs(newSVpvs_flags("locked", SVs_TEMP)); #ifdef CVf_LVALUE if (cvflags & CVf_LVALUE) - XPUSHs(sv_2mortal(newSVpvs("lvalue"))); + XPUSHs(newSVpvs_flags("lvalue", SVs_TEMP)); #endif if (cvflags & CVf_METHOD) - XPUSHs(sv_2mortal(newSVpvs("method"))); + XPUSHs(newSVpvs_flags("method", SVs_TEMP)); if (GvUNIQUE(CvGV((CV*)sv))) - XPUSHs(sv_2mortal(newSVpvs("unique"))); - if (cvflags & CVf_ASSERTION) - XPUSHs(sv_2mortal(newSVpvs("assertion"))); + XPUSHs(newSVpvs_flags("unique", SVs_TEMP)); break; case SVt_PVGV: - if (GvUNIQUE(sv)) - XPUSHs(sv_2mortal(newSVpvs("unique"))); + if (isGV_with_GP(sv) && GvUNIQUE(sv)) + XPUSHs(newSVpvs_flags("unique", SVs_TEMP)); break; default: break; @@ -250,12 +232,10 @@ XS(XS_attributes__guess_stash) dXSARGS; SV *rv, *sv; dXSTARG; - PERL_UNUSED_ARG(cv); if (items != 1) { usage: - Perl_croak(aTHX_ - "Usage: attributes::_guess_stash $reference"); + croak_xs_usage(cv, "$reference"); } rv = ST(0); @@ -280,7 +260,7 @@ usage: stash = CvSTASH(sv); break; case SVt_PVGV: - if (GvGP(sv) && GvESTASH((GV*)sv)) + if (isGV_with_GP(sv) && GvGP(sv) && GvESTASH((GV*)sv)) stash = GvESTASH((GV*)sv); break; default: @@ -300,12 +280,10 @@ XS(XS_attributes_reftype) dXSARGS; SV *rv, *sv; dXSTARG; - PERL_UNUSED_ARG(cv); if (items != 1) { usage: - Perl_croak(aTHX_ - "Usage: attributes::reftype $reference"); + croak_xs_usage(cv, "$reference"); } rv = ST(0);