X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=padop_on_crack.c.inc;h=523b4bad0ce3c606418ab1ba2a88f95ed99d0d39;hb=9cb05a12d2fbbf1cd1cd3bac7f8f694ea3eb15cf;hp=7faf7a4f777d4a2d94bd82805a0d20ea7fadf705;hpb=c3e72f350b01137d7ca90d10645e5b7290c8b1d2;p=p5sagit%2FFunction-Parameters.git

diff --git a/padop_on_crack.c.inc b/padop_on_crack.c.inc
index 7faf7a4..523b4ba 100644
--- a/padop_on_crack.c.inc
+++ b/padop_on_crack.c.inc
@@ -5,9 +5,9 @@
 /* vi: set ft=c inde=: */
 
 #define COP_SEQ_RANGE_LOW_set(SV, VAL) \
-	do { ((XPVNV*)SvANY(SV))->xnv_u.xpad_cop_seq.xlow = (VAL); } while (0)
+	STMT_START { ((XPVNV*)SvANY(SV))->xnv_u.xpad_cop_seq.xlow = (VAL); } STMT_END
 #define COP_SEQ_RANGE_HIGH_set(SV, VAL) \
-	do { ((XPVNV*)SvANY(SV))->xnv_u.xpad_cop_seq.xhigh = (VAL); } while (0)
+	STMT_START { ((XPVNV*)SvANY(SV))->xnv_u.xpad_cop_seq.xhigh = (VAL); } STMT_END
 
 static void S_pad_block_start(pTHX_ int full) {
 	dVAR;
@@ -689,11 +689,13 @@ static PADOFFSET S_pad_alloc(pTHX_ I32 optype, U32 tmptype) {
 #define pad_add_name_sv(NAMESV, FLAGS, TYPESTASH, OURSTASH) \
 	S_pad_add_name_sv(aTHX_ NAMESV, FLAGS, TYPESTASH, OURSTASH)
 
-static PADOFFSET S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash, HV *ourstash) {
+static PADOFFSET S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash) {
 	dVAR;
 	const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
 
-	ASSERT_CURPAD_ACTIVE("pad_add_name");
+	assert(flags == 0);
+
+	ASSERT_CURPAD_ACTIVE("pad_alloc_name");
 
 	if (typestash) {
 		assert(SvTYPE(namesv) == SVt_PVMG);
@@ -705,14 +707,53 @@ static PADOFFSET S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typest
 		SvOURSTASH_set(namesv, ourstash);
 		SvREFCNT_inc_simple_void_NN(ourstash);
 	}
-	#if 0
-	else if (flags & padadd_STATE) {
-		SvPAD_STATE_on(namesv);
-	}
-	#endif
 
 	av_store(PL_comppad_name, offset, namesv);
 	return offset;
 }
 
+PADOFFSET static S_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags, HV *typestash, HV *ourstash) {
+	dVAR;
+	PADOFFSET offset;
+	SV *namesv;
+
+	assert(flags == 0);
+
+	namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
+
+	sv_setpvn(namesv, namepv, namelen);
+
+	offset = S_pad_alloc_name(aTHX_ namesv, flags, typestash, ourstash);
+
+	/* not yet introduced */
+	COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
+	COP_SEQ_RANGE_HIGH_set(namesv, 0);
+
+	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 */
+	assert(SvTYPE(PL_curpad[offset]) == SVt_NULL);
+	assert(SvREFCNT(PL_curpad[offset]) == 1);
+	if (namelen != 0 && *namepv == '@')
+		sv_upgrade(PL_curpad[offset], SVt_PVAV);
+	else if (namelen != 0 && *namepv == '%')
+		sv_upgrade(PL_curpad[offset], SVt_PVHV);
+	assert(SvPADMY(PL_curpad[offset]));
+	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+						   "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
+						   (long)offset, SvPVX(namesv),
+						   PTR2UV(PL_curpad[offset])));
+
+	return offset;
+}
+
+static PADOFFSET S_pad_add_name_sv(pTHX_ SV *name, U32 flags, HV *typestash, HV *ourstash) {
+	char *namepv;
+	STRLEN namelen;
+	assert(flags == 0);
+	namepv = SvPV(name, namelen);
+	return S_pad_add_name_pvn(aTHX_ namepv, namelen, flags, typestash, ourstash);
+}
+
 #endif