summaryrefslogtreecommitdiff
path: root/pp.c
diff options
context:
space:
mode:
authorVincent Pit <perl@profvince.com>2008-12-28 15:08:05 +0100
committerVincent Pit <perl@profvince.com>2008-12-28 15:46:41 +0100
commit4ad10a0b60fb728d1be0a9eeb1970166a3846d38 (patch)
tree1d837e46785bb215c2744c7becf85e3c71bcc8e3 /pp.c
parentc68ec7a9f950f968bb39608a47e0228e03511a18 (diff)
downloadperl-4ad10a0b60fb728d1be0a9eeb1970166a3846d38.tar.gz
On scope end, delete localized array elements that should not exist anymore, so that the array recovers its previous length. Honour EXISTS and DELETE for tied arrays.
Diffstat (limited to 'pp.c')
-rw-r--r--pp.c30
1 files changed, 27 insertions, 3 deletions
diff --git a/pp.c b/pp.c
index bdbe010f3e..aacb789456 100644
--- a/pp.c
+++ b/pp.c
@@ -3912,7 +3912,17 @@ PP(pp_aslice)
if (SvTYPE(av) == SVt_PVAV) {
const I32 arybase = CopARYBASE_get(PL_curcop);
- if (lval && PL_op->op_private & OPpLVAL_INTRO) {
+ const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+ bool can_preserve = FALSE;
+
+ if (localizing) {
+ MAGIC *mg;
+ HV *stash;
+
+ can_preserve = SvCANEXISTDELETE(av);
+ }
+
+ if (lval && localizing) {
register SV **svp;
I32 max = -1;
for (svp = MARK + 1; svp <= SP; svp++) {
@@ -3923,18 +3933,32 @@ PP(pp_aslice)
if (max > AvMAX(av))
av_extend(av, max);
}
+
while (++MARK <= SP) {
register SV **svp;
I32 elem = SvIV(*MARK);
+ bool preeminent = TRUE;
if (elem > 0)
elem -= arybase;
+ if (localizing && can_preserve) {
+ /* If we can determine whether the element exist,
+ * Try to preserve the existenceness of a tied array
+ * element by using EXISTS and DELETE if possible.
+ * Fallback to FETCH and STORE otherwise. */
+ preeminent = av_exists(av, elem);
+ }
+
svp = av_fetch(av, elem, lval);
if (lval) {
if (!svp || *svp == &PL_sv_undef)
DIE(aTHX_ PL_no_aelem, elem);
- if (PL_op->op_private & OPpLVAL_INTRO)
- save_aelem(av, elem, svp);
+ if (localizing) {
+ if (preeminent)
+ save_aelem(av, elem, svp);
+ else
+ SAVEADELETE(av, elem);
+ }
}
*MARK = svp ? *svp : &PL_sv_undef;
}