X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xsutils.c;h=622a49be30a2381cd834147753aed536ca729dbd;hb=40837afcb0b195c90e4d9b17d791c9d4dd4f223b;hp=1d7a01a717aa08945f15bff47bad0720fd8ddd4b;hpb=eb1102fcca2230364ceadea29bd8e87ee51b15fa;p=p5sagit%2Fp5-mst-13.2.git diff --git a/xsutils.c b/xsutils.c index 1d7a01a..622a49b 100644 --- a/xsutils.c +++ b/xsutils.c @@ -1,12 +1,18 @@ /* xsutils.c * - * Copyright (c) 1999-2002, Larry Wall + * Copyright (C) 1999, 2000, 2001, 2002, 2003, by Larry Wall and others * * 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" @@ -66,6 +72,15 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) switch ((int)len) { case 6: switch (*name) { + case 'a': + if (strEQ(name, "assertion")) { + if (negated) + CvFLAGS((CV*)sv) &= ~CVf_ASSERTION; + else + CvFLAGS((CV*)sv) |= CVf_ASSERTION; + continue; + } + break; case 'l': #ifdef CVf_LVALUE if (strEQ(name, "lvalue")) { @@ -110,6 +125,14 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) switch ((int)len) { case 6: switch (*name) { + 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) { @@ -206,6 +229,8 @@ usage: XPUSHs(sv_2mortal(newSVpvn("method", 6))); if (GvUNIQUE(CvGV((CV*)sv))) XPUSHs(sv_2mortal(newSVpvn("unique", 6))); + if (cvflags & CVf_ASSERTION) + XPUSHs(sv_2mortal(newSVpvn("assertion", 9))); break; case SVt_PVGV: if (GvUNIQUE(sv))