From 0732b20031188d171b2920335edddf68bd917246 Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@cpan.org>
Date: Sun, 17 May 2020 21:10:19 +0200
Subject: [PATCH] WIP keep immortals in arrays asis

i.e. -e"print [!0]->[0]"
See GH #413

Unfortunately we cannot fix the main culprit sv_setsv_flags, as we cannot set the
pointer of dest, only the value. So we need to fix the callers.
The SV values for arrays and hashes.

Problem with this one:
cperl -Dt -e'$a=[undef,undef];$a->[0]=1'
(-e:0)	enter
(-e:0)	nextstate
(-e:1)	pushmark
(-e:1)	undef
(-e:1)	undef
(-e:1)	anonlist
(-e:1)	gvsv(main::a)
(-e:1)	sassign
(-e:1)	nextstate
(-e:1)	const(IV(1))
(-e:1)	multideref($a->[0])
(-e:1)	sassign
Modification of a read-only value attempted SV_UNDEF at sv.c:4283 at -e line 1.

Apparently array elements need to be writable, immortals are forbidden.
Which blows up memory for all arrays/sets of immortals (yes,no,undef).
So allow writing to immortals in arrays/hashes, set the SPECIAL flag to sassign,
as with const init: my $i:const = 1
The no modify warning is only to prevent undef=1 or yes=0, which is easier preventable.
---
 av.c     | 11 ++++++++---
 pp_hot.c | 18 +++++++++++++-----
 2 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/av.c b/av.c
index 0ba7b9aec43..2c78f2e08a5 100644
--- a/av.c
+++ b/av.c
@@ -477,9 +477,14 @@ Perl_av_make(pTHX_ SSize_t size, SV **strp)
 
 	    SvGETMAGIC(*strp); /* before newSV, in case it dies */
 	    AvFILLp(av)++;
-	    ary[i] = newSV(0);
-	    sv_setsv_flags(ary[i], *strp,
-			   SV_DO_COW_SVSETSV|SV_NOSTEAL);
+            /* keep most immortals asis. cperl only. */
+            if (SvIMMORTAL(*strp)) {
+                ary[i] = *strp;
+            } else {
+                ary[i] = newSV(0);
+                sv_setsv_flags(ary[i], *strp,
+                               SV_DO_COW_SVSETSV|SV_NOSTEAL);
+            }
 	    strp++;
 	}
         /* disarm av's leak guard */
diff --git a/pp_hot.c b/pp_hot.c
index 8a54bf0c25c..1ac73d9e662 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -264,11 +264,19 @@ PPt(pp_sassign, "(:Scalar,:Scalar):Scalar")
                     "Useless assignment to a temporary");
     }
     /* my $i :const = val; initialization must temp. lift constness */
-    if (UNLIKELY(OpSPECIAL(PL_op) && SvREADONLY(left))) {
-        SvREADONLY_off(left);
-        SvSetMagicSV(left, right);
-        SETs(left);
-        SvREADONLY_on(left);
+    else if (UNLIKELY(OpSPECIAL(PL_op) && SvREADONLY(left))) {
+        /* allow writing to array/hash elements */
+        if (SvIMMORTAL(left)) { /* $a=[undef];$a->[0]=1 */
+            /* left = newSV(0); */
+            left = right;
+            SvSETMAGIC(left);
+            SETs(left);
+        } else {
+            SvREADONLY_off(left);
+            SvSetMagicSV(left, right);
+            SETs(left);
+            SvREADONLY_on(left);
+        }
     } else {
         SvSetMagicSV(left, right);
         SETs(left);