Integrate:

[ 19263]
Unused variables.

[ 19264]
UTF8 regexp patch from Inaba Hiroto.

[ 19266]
Subject: [PATCH] Re: any takers for this Storable bug?
From: Enache Adrian <enache@rdslink.ro>
Date: Wed, 16 Apr 2003 21:11:11 +0300
Message-ID: <20030416181111.GA6687@ratsnest.hole>

ams had already fixed the bug by #19227, but take the
test case.

[ 19268]
Subject: [PATCH] allow recursive FETCHes
From: Dave Mitchell <davem@fdgroup.com>
Date: Mon, 7 Apr 2003 10:00:41 +0100
Message-ID: <20030407100041.A1617@fdgroup.com>

[ 19275]
Restore the two variables retired by the change #19268
(for binary backward compatibility)
p4raw-link: @19275 on //depot/perl: 195c09c3629c17448fb78757b0012553fb092895
p4raw-link: @19268 on //depot/perl: dd28f7bb7eebdb0b562c940b3c4f89457e829ea6
p4raw-link: @19266 on //depot/perl: f4193312177189f6e5e8caee032cd298198ec91f
p4raw-link: @19264 on //depot/perl: 14ebb1a2c3090470663d3e2baaf3787edad7c9a7
p4raw-link: @19263 on //depot/perl: d60ecbe5204b1d5c06464db2b54d51236d8a45d0

p4raw-id: //depot/maint-5.8/perl@19292
p4raw-integrated: from //depot/perl@19291 'copy in'
	ext/Storable/t/st-dump.pl (@16953..) t/op/tie.t (@18889..)
	t/op/pat.t (@19210..) 'edit in' embedvar.h perlapi.h thrdvar.h
	(@19268..) 'merge in' embed.fnc (@19214..) av.c dump.c embed.h
	hv.c perl.c proto.h regcomp.c sv.h (@19242..)
p4raw-integrated: from //depot/perl@19268 'merge in' sv.c (@19265..)
p4raw-integrated: from //depot/perl@19266 'copy in'
	ext/Storable/t/tied.t (@16953..)
p4raw-integrated: from //depot/perl@19263 'copy in' perlio.c (@19203..)
	'merge in' universal.c (@19242..)

1 files changed, 41 insertions, 10 deletions

diff --git a/hv.c b/hv.c
index 634e6809ef..e22d7cefcf 100644
--- a/hv.c
+++ b/hv.c
@@ -89,6 +89,22 @@ S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
     return hek;
 }
 
+/* free the pool of temporary HE/HEK pairs retunrned by hv_fetch_ent
+ * for tied hashes */
+
+void
+Perl_free_tied_hv_pool(pTHX)
+{
+    HE *ohe;
+    HE *he = PL_hv_fetch_ent_mh;
+    while (he) {
+	Safefree(HeKEY_hek(he));
+	ohe = he;
+	he = HeNEXT(he);
+	del_HE(ohe);
+    }
+}
+
 #if defined(USE_ITHREADS)
 HE *
 Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
@@ -107,8 +123,12 @@ Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
     ptr_table_store(PL_ptr_table, e, ret);
 
     HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
-    if (HeKLEN(e) == HEf_SVKEY)
+    if (HeKLEN(e) == HEf_SVKEY) {
+	char *k;
+	New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+	HeKEY_hek(ret) = (HEK*)k;
 	HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
+    }
     else if (shared)
 	HeKEY_hek(ret) = share_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e),
                                          HeKFLAGS(e));
@@ -208,11 +228,13 @@ S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags)
         */
 	if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
 	    sv = sv_newmortal();
+	    sv_upgrade(sv, SVt_PVLV);
 	    mg_copy((SV*)hv, sv, key, klen);
             if (flags & HVhek_FREEKEY)
                 Safefree(key);
-	    PL_hv_fetch_sv = sv;
-	    return &PL_hv_fetch_sv;
+	    LvTYPE(sv) = 't';
+	    LvTARG(sv) = sv; /* fake (SV**) */
+	    return &(LvTARG(sv));
 	}
 #ifdef ENV_IS_CASELESS
 	else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
@@ -356,17 +378,26 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
     if (SvRMAGICAL(hv)) {
 	if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
 	    sv = sv_newmortal();
-	    keysv = sv_2mortal(newSVsv(keysv));
+	    keysv = newSVsv(keysv);
 	    mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
-	    if (!HeKEY_hek(&PL_hv_fetch_ent_mh)) {
+	    /* grab a fake HE/HEK pair from the pool or make a new one */
+	    entry = PL_hv_fetch_ent_mh;
+	    if (entry)
+		PL_hv_fetch_ent_mh = HeNEXT(entry);
+	    else {
 		char *k;
+		entry = new_HE();
 		New(54, k, HEK_BASESIZE + sizeof(SV*), char);
-		HeKEY_hek(&PL_hv_fetch_ent_mh) = (HEK*)k;
+		HeKEY_hek(entry) = (HEK*)k;
 	    }
-	    HeSVKEY_set(&PL_hv_fetch_ent_mh, keysv);
-	    HeVAL(&PL_hv_fetch_ent_mh) = sv;
-	    return &PL_hv_fetch_ent_mh;
-	}
+	    HeNEXT(entry) = Nullhe;
+	    HeSVKEY_set(entry, keysv);
+	    HeVAL(entry) = sv;
+	    sv_upgrade(sv, SVt_PVLV);
+	    LvTYPE(sv) = 'T';
+	    LvTARG(sv) = (SV*)entry; /* so we can free entry when freeing sv */
+	    return entry;
+ 	}
 #ifdef ENV_IS_CASELESS
 	else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 	    U32 i;