X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xsutils.c;h=b924c481c398b4d2850b30340cd32999bfd252ee;hb=9ba1b7d248e0db6e26fa52ba8d5b3768aa0b633f;hp=1a95191d04bb0087063288ff692c99fd206d1f1f;hpb=592f596992fbcfa7e7c135f9212d2ec2def553a6;p=p5sagit%2Fp5-mst-13.2.git diff --git a/xsutils.c b/xsutils.c index 1a95191..b924c48 100644 --- a/xsutils.c +++ b/xsutils.c @@ -1,3 +1,18 @@ +/* xsutils.c + * + * Copyright (c) 1999-2002, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +/* + * "Perilous to us all are the devices of an art deeper than we possess + * ourselves." --Gandalf + */ + + #include "EXTERN.h" #define PERL_IN_XSUTILS_C #include "perl.h" @@ -7,12 +22,12 @@ */ /* package attributes; */ -void XS_attributes__warn_reserved(pTHXo_ CV *cv); -void XS_attributes_reftype(pTHXo_ CV *cv); -void XS_attributes__modify_attrs(pTHXo_ CV *cv); -void XS_attributes__guess_stash(pTHXo_ CV *cv); -void XS_attributes__fetch_attrs(pTHXo_ CV *cv); -void XS_attributes_bootstrap(pTHXo_ CV *cv); +void XS_attributes__warn_reserved(pTHX_ CV *cv); +void XS_attributes_reftype(pTHX_ CV *cv); +void XS_attributes__modify_attrs(pTHX_ CV *cv); +void XS_attributes__guess_stash(pTHX_ CV *cv); +void XS_attributes__fetch_attrs(pTHX_ CV *cv); +void XS_attributes_bootstrap(pTHX_ CV *cv); /* @@ -38,7 +53,7 @@ Perl_boot_core_xsutils(pTHX) #include "XSUB.h" static int -modify_SV_attributes(pTHXo_ SV *sv, SV **retlist, SV **attrlist, int numattrs) +modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) { SV *attr; char *name; @@ -84,12 +99,12 @@ modify_SV_attributes(pTHXo_ SV *sv, SV **retlist, SV **attrlist, int numattrs) continue; } break; - case 's': - if (strEQ(name, "shared")) { + case 'u': + if (strEQ(name, "unique")) { if (negated) - GvSHARED_off(CvGV((CV*)sv)); + GvUNIQUE_off(CvGV((CV*)sv)); else - GvSHARED_on(CvGV((CV*)sv)); + GvUNIQUE_on(CvGV((CV*)sv)); continue; } break; @@ -99,11 +114,25 @@ modify_SV_attributes(pTHXo_ SV *sv, SV **retlist, SV **attrlist, int numattrs) break; default: switch ((int)len) { - case 6: + case 6: switch (*name) { - case 's': + case 's': if (strEQ(name, "shared")) { - /* toke.c has already marked as GvSHARED */ + if (negated) + Perl_croak(aTHX_ "A variable may not be unshared"); + SvSHARE(sv); + continue; + } + break; + case 'u': + if (strEQ(name, "unique")) { + if (SvTYPE(sv) == SVt_PVGV) { + if (negated) + GvUNIQUE_off(sv); + else + GvUNIQUE_on(sv); + } + /* Hope this came from toke.c if not a GV. */ continue; } } @@ -155,7 +184,7 @@ usage: goto usage; sv = SvRV(rv); if (items > 1) - XSRETURN(modify_SV_attributes(aTHXo_ sv, &ST(0), &ST(1), items-1)); + XSRETURN(modify_SV_attributes(aTHX_ sv, &ST(0), &ST(1), items-1)); XSRETURN(0); } @@ -189,8 +218,12 @@ usage: #endif if (cvflags & CVf_METHOD) XPUSHs(sv_2mortal(newSVpvn("method", 6))); - if (GvSHARED(CvGV((CV*)sv))) - XPUSHs(sv_2mortal(newSVpvn("shared", 6))); + if (GvUNIQUE(CvGV((CV*)sv))) + XPUSHs(sv_2mortal(newSVpvn("unique", 6))); + break; + case SVt_PVGV: + if (GvUNIQUE(sv)) + XPUSHs(sv_2mortal(newSVpvn("unique", 6))); break; default: break; @@ -231,10 +264,9 @@ usage: HV *stash = Nullhv; switch (SvTYPE(sv)) { case SVt_PVCV: - if (CvGV(sv) && isGV(CvGV(sv)) && GvSTASH(CvGV(sv)) && - HvNAME(GvSTASH(CvGV(sv)))) + if (CvGV(sv) && isGV(CvGV(sv)) && GvSTASH(CvGV(sv))) stash = GvSTASH(CvGV(sv)); - else if (/* !CvANON(sv) && */ CvSTASH(sv) && HvNAME(CvSTASH(sv))) + else if (/* !CvANON(sv) && */ CvSTASH(sv)) stash = CvSTASH(sv); break; case SVt_PVMG: @@ -242,7 +274,7 @@ usage: break; /*FALLTHROUGH*/ case SVt_PVGV: - if (GvGP(sv) && GvESTASH((GV*)sv) && HvNAME(GvESTASH((GV*)sv))) + if (GvGP(sv) && GvESTASH((GV*)sv)) stash = GvESTASH((GV*)sv); break; default: