X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xsutils.c;h=b924c481c398b4d2850b30340cd32999bfd252ee;hb=caf25f3be4a66b8fbb51db2cfdfa658f6b9704e7;hp=81bb2fc1c454353f4e821be2bf6e89ebd33f2d70;hpb=acfe0abcedaf592fb4b9cb69ce3468308ae99d91;p=p5sagit%2Fp5-mst-13.2.git diff --git a/xsutils.c b/xsutils.c index 81bb2fc..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" @@ -84,8 +99,8 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) continue; } break; - case 's': - if (strEQ(name, "unique")) { + case 'u': + if (strEQ(name, "unique")) { if (negated) GvUNIQUE_off(CvGV((CV*)sv)); else @@ -99,11 +114,25 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) break; default: switch ((int)len) { - case 6: + case 6: switch (*name) { - case 's': - if (strEQ(name, "unique")) { - /* toke.c has already marked as GVf_UNIQUE */ + case 's': + if (strEQ(name, "shared")) { + 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; } } @@ -190,7 +219,11 @@ usage: if (cvflags & CVf_METHOD) XPUSHs(sv_2mortal(newSVpvn("method", 6))); if (GvUNIQUE(CvGV((CV*)sv))) - XPUSHs(sv_2mortal(newSVpvn("unique", 6))); + XPUSHs(sv_2mortal(newSVpvn("unique", 6))); + break; + case SVt_PVGV: + if (GvUNIQUE(sv)) + XPUSHs(sv_2mortal(newSVpvn("unique", 6))); break; default: break;