From: Nicholas Clark Date: Sun, 8 Nov 2009 23:10:37 +0000 (+0000) Subject: Add length and flags arguments to Perl_pad_add_name(). X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cca43f7877df27a183ef8184587126e106940d27;p=p5sagit%2Fp5-mst-13.2.git Add length and flags arguments to Perl_pad_add_name(). Currently only pad_add_STATE and pad_add_FAKE are used. The length is cross- checked against strlen() on the pointer, but the intent is to re-work the entire pad API to be UTF-8 aware, from the current situation of char * pointers only. --- diff --git a/embed.fnc b/embed.fnc index ef8cc8e..ae69dc0 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1933,8 +1933,9 @@ pda |PADLIST*|pad_new |int flags : Only used in op.c pd |void |pad_undef |NN CV* cv : Only used in op.c -pd |PADOFFSET|pad_add_name |NN const char *name\ - |NULLOK HV* typestash|NULLOK HV* ourstash|bool clone|bool state +Mpd |PADOFFSET|pad_add_name |NN const char *name|const STRLEN len\ + |const U32 flags|NULLOK HV *typestash\ + |NULLOK HV *ourstash : Only used in op.c pd |PADOFFSET|pad_add_anon |NN SV* sv|OPCODE op_type : Only used in op.c diff --git a/op.c b/op.c index aa5994d..8293fab 100644 --- a/op.c +++ b/op.c @@ -412,15 +412,14 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags) /* allocate a spare slot and store the name in that slot */ - off = pad_add_name(name, + off = pad_add_name(name, len, + PL_parser->in_my == KEY_state ? pad_add_STATE : 0, PL_parser->in_my_stash, (is_our /* $_ is always in main::, even with our */ ? (PL_curstash && !strEQ(name,"$_") ? PL_curstash : PL_defstash) : NULL - ), - 0, /* not fake */ - PL_parser->in_my == KEY_state + ) ); /* anon sub prototypes contains state vars should always be cloned, * otherwise the state var would be shared between anon subs */ diff --git a/pad.c b/pad.c index e9c83fe..d80679a 100644 --- a/pad.c +++ b/pad.c @@ -355,17 +355,28 @@ If fake, it means we're cloning an existing entry */ PADOFFSET -Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake, bool state) +Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags, + HV *typestash, HV *ourstash) { dVAR; const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY); - SV* const namesv - = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV); + SV *namesv; PERL_ARGS_ASSERT_PAD_ADD_NAME; ASSERT_CURPAD_ACTIVE("pad_add_name"); + if (flags & ~(pad_add_STATE|pad_add_FAKE)) + Perl_croak(aTHX_ "panic: pad_add_name illegal flag bits 0x%" UVxf, + (UV)flags); + + namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV); + + /* Until we're using the length for real, cross check that we're being told + the truth. */ + PERL_UNUSED_ARG(len); + assert(strlen(name) == len); + sv_setpv(namesv, name); if (typestash) { @@ -378,12 +389,12 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake SvOURSTASH_set(namesv, ourstash); SvREFCNT_inc_simple_void_NN(ourstash); } - else if (state) { + else if (flags & pad_add_STATE) { SvPAD_STATE_on(namesv); } av_store(PL_comppad_name, offset, namesv); - if (fake) { + if (flags & pad_add_FAKE) { SvFAKE_on(namesv); DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name)); @@ -902,11 +913,12 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, new_offset = pad_add_name( SvPVX_const(*out_name_sv), + SvCUR(*out_name_sv), + /* state variable ? */ + pad_add_FAKE | (SvPAD_STATE(*out_name_sv) ? pad_add_STATE : 0), SvPAD_TYPED(*out_name_sv) ? SvSTASH(*out_name_sv) : NULL, - SvOURSTASH(*out_name_sv), - 1, /* fake */ - SvPAD_STATE(*out_name_sv) ? 1 : 0 /* state variable ? */ + SvOURSTASH(*out_name_sv) ); new_namesv = AvARRAY(PL_comppad_name)[new_offset]; diff --git a/proto.h b/proto.h index 50f72a1..3aa6ca3 100644 --- a/proto.h +++ b/proto.h @@ -6101,7 +6101,7 @@ PERL_CALLCONV void Perl_pad_undef(pTHX_ CV* cv) #define PERL_ARGS_ASSERT_PAD_UNDEF \ assert(cv) -PERL_CALLCONV PADOFFSET Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool clone, bool state) +PERL_CALLCONV PADOFFSET Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags, HV *typestash, HV *ourstash) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_PAD_ADD_NAME \ assert(name)