Note that formats are treated as anon subs, and are cloned each time
write is called (if necessary).
-The flag SVf_PADSTALE is cleared on lexicals each time the my() is executed,
+The flag SVs_PADSTALE is cleared on lexicals each time the my() is executed,
and set on scope exit. This allows the 'Variable $x is not available' warning
to be generated in evals, such as
{ my $x = 1; sub f { eval '$x'} } f();
-For state vars, SVf_PADSTALE is overloaded to mean 'not yet initialised'
+For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
=cut
*/
+static PADOFFSET
+S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash,
+ HV *ourstash)
+{
+ dVAR;
+ const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
+
+ PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
+
+ ASSERT_CURPAD_ACTIVE("pad_add_name");
+
+ if (typestash) {
+ assert(SvTYPE(namesv) == SVt_PVMG);
+ SvPAD_TYPED_on(namesv);
+ SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
+ }
+ if (ourstash) {
+ SvPAD_OUR_on(namesv);
+ SvOURSTASH_set(namesv, ourstash);
+ SvREFCNT_inc_simple_void_NN(ourstash);
+ }
+ else if (flags & padadd_STATE) {
+ SvPAD_STATE_on(namesv);
+ }
+
+ av_store(PL_comppad_name, offset, namesv);
+ return offset;
+}
+
/*
=for apidoc pad_add_name
*/
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);
+ PADOFFSET offset;
+ SV *namesv;
PERL_ARGS_ASSERT_PAD_ADD_NAME;
- ASSERT_CURPAD_ACTIVE("pad_add_name");
+ if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK))
+ 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) {
- assert(SvTYPE(namesv) == SVt_PVMG);
- SvPAD_TYPED_on(namesv);
- SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
- }
- if (ourstash) {
- SvPAD_OUR_on(namesv);
- SvOURSTASH_set(namesv, ourstash);
- SvREFCNT_inc_simple_void_NN(ourstash);
- }
- else if (state) {
- SvPAD_STATE_on(namesv);
+ if ((flags & padadd_NO_DUP_CHECK) == 0) {
+ /* check for duplicate declaration */
+ pad_check_dup(namesv, flags & padadd_OUR, ourstash);
}
- av_store(PL_comppad_name, offset, namesv);
- if (fake) {
- SvFAKE_on(namesv);
- DEBUG_Xv(PerlIO_printf(Perl_debug_log,
- "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
- }
- else {
- /* not yet introduced */
- COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX); /* min */
- COP_SEQ_RANGE_HIGH_set(namesv, 0); /* max */
-
- if (!PL_min_intro_pending)
- PL_min_intro_pending = offset;
- PL_max_intro_pending = offset;
- /* if it's not a simple scalar, replace with an AV or HV */
- /* XXX DAPM since slot has been allocated, replace
- * av_store with PL_curpad[offset] ? */
- if (*name == '@')
- av_store(PL_comppad, offset, MUTABLE_SV(newAV()));
- else if (*name == '%')
- av_store(PL_comppad, offset, MUTABLE_SV(newHV()));
- SvPADMY_on(PL_curpad[offset]);
- DEBUG_Xv(PerlIO_printf(Perl_debug_log,
- "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
- (long)offset, name, PTR2UV(PL_curpad[offset])));
- }
+ offset = pad_add_name_sv(namesv, flags, typestash, ourstash);
+
+ /* not yet introduced */
+ COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX); /* min */
+ COP_SEQ_RANGE_HIGH_set(namesv, 0); /* max */
+
+ if (!PL_min_intro_pending)
+ PL_min_intro_pending = offset;
+ PL_max_intro_pending = offset;
+ /* if it's not a simple scalar, replace with an AV or HV */
+ /* XXX DAPM since slot has been allocated, replace
+ * av_store with PL_curpad[offset] ? */
+ if (*name == '@')
+ av_store(PL_comppad, offset, MUTABLE_SV(newAV()));
+ else if (*name == '%')
+ av_store(PL_comppad, offset, MUTABLE_SV(newHV()));
+ SvPADMY_on(PL_curpad[offset]);
+ DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+ "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
+ (long)offset, name, PTR2UV(PL_curpad[offset])));
return offset;
}
=cut
*/
-/* XXX DAPM integrate this into pad_add_name ??? */
-
-void
-Perl_pad_check_dup(pTHX_ const char *name, const STRLEN len, const U32 flags,
- const HV *ourstash)
+STATIC void
+S_pad_check_dup(pTHX_ SV *name, const U32 flags, const HV *ourstash)
{
dVAR;
SV **svp;
PADOFFSET top, off;
- const U32 is_our = flags & pad_add_OUR;
+ const U32 is_our = flags & padadd_OUR;
PERL_ARGS_ASSERT_PAD_CHECK_DUP;
ASSERT_CURPAD_ACTIVE("pad_check_dup");
- if (flags & ~pad_add_OUR)
- Perl_croak(aTHX_ "panic: pad_check_dup illegal flag bits 0x%" UVxf,
- (UV)flags);
-
- /* 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);
+ assert((flags & ~padadd_OUR) == 0);
if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
return; /* nothing to check */
&& sv != &PL_sv_undef
&& !SvFAKE(sv)
&& (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
- && strEQ(name, SvPVX_const(sv)))
+ && sv_eq(name, sv))
{
if (is_our && (SvPAD_OUR(sv)))
break; /* "our" masking "our" */
&& !SvFAKE(sv)
&& (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
&& SvOURSTASH(sv) == ourstash
- && strEQ(name, SvPVX_const(sv)))
+ && sv_eq(name, sv))
{
Perl_warner(aTHX_ packWARN(WARN_MISC),
"\"our\" variable %"SVf" redeclared", sv);
return 0; /* this dummy (and invalid) value isnt used by the caller */
{
- SV *new_namesv;
+ /* This relies on sv_setsv_flags() upgrading the destination to the same
+ type as the source, independant of the flags set, and on it being
+ "good" and only copying flag bits and pointers that it understands.
+ */
+ SV *new_namesv = newSVsv(*out_name_sv);
AV * const ocomppad_name = PL_comppad_name;
PAD * const ocomppad = PL_comppad;
PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
PL_curpad = AvARRAY(PL_comppad);
- new_offset = pad_add_name(
- SvPVX_const(*out_name_sv),
- 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 ? */
- );
+ new_offset
+ = pad_add_name_sv(new_namesv,
+ (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
+ SvPAD_TYPED(*out_name_sv)
+ ? SvSTASH(*out_name_sv) : NULL,
+ SvOURSTASH(*out_name_sv)
+ );
- new_namesv = AvARRAY(PL_comppad_name)[new_offset];
+ SvFAKE_on(new_namesv);
+ DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+ "Pad addname: %ld \"%.*s\" FAKE\n",
+ (long)new_offset,
+ (int) SvCUR(new_namesv), SvPVX(new_namesv)));
PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
PARENT_PAD_INDEX_set(new_namesv, 0);
projects / p5sagit/p5-mst-13.2.git / blobdiff