Add save_adelete()/SAVEADELETE() to save on the stack an array element delete

6 files changed, 30 insertions, 0 deletions

diff --git a/embed.fnc b/embed.fnc
index c76ca9d205..1a0e5d3c2a 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -889,6 +889,7 @@ Ap	|AV*	|save_ary	|NN GV* gv
 Ap	|void	|save_bool	|NN bool* boolp
 Ap	|void	|save_clearsv	|NN SV** svp
 Ap	|void	|save_delete	|NN HV *hv|NN char *key|I32 klen
+Ap	|void	|save_adelete	|NN AV *av|I32 key
 Ap	|void	|save_destructor|DESTRUCTORFUNC_NOCONTEXT_t f|NN void* p
 Ap	|void	|save_destructor_x|DESTRUCTORFUNC_t f|NULLOK void* p
 Apmb	|void	|save_freesv	|NULLOK SV* sv
diff --git a/embed.h b/embed.h
index 6fa667a117..b1f9741ce8 100644
--- a/embed.h
+++ b/embed.h
@@ -780,6 +780,7 @@
 #define save_bool		Perl_save_bool
 #define save_clearsv		Perl_save_clearsv
 #define save_delete		Perl_save_delete
+#define save_adelete		Perl_save_adelete
 #define save_destructor		Perl_save_destructor
 #define save_destructor_x	Perl_save_destructor_x
 #define save_generic_svref	Perl_save_generic_svref
@@ -3123,6 +3124,7 @@
 #define save_bool(a)		Perl_save_bool(aTHX_ a)
 #define save_clearsv(a)		Perl_save_clearsv(aTHX_ a)
 #define save_delete(a,b,c)	Perl_save_delete(aTHX_ a,b,c)
+#define save_adelete(a,b)	Perl_save_adelete(aTHX_ a,b)
 #define save_destructor(a,b)	Perl_save_destructor(aTHX_ a,b)
 #define save_destructor_x(a,b)	Perl_save_destructor_x(aTHX_ a,b)
 #ifdef PERL_CORE
diff --git a/global.sym b/global.sym
index 5ec7ba3c4f..0b21dcdc95 100644
--- a/global.sym
+++ b/global.sym
@@ -440,6 +440,7 @@ Perl_save_ary
 Perl_save_bool
 Perl_save_clearsv
 Perl_save_delete
+Perl_save_adelete
 Perl_save_destructor
 Perl_save_destructor_x
 Perl_save_freesv
diff --git a/proto.h b/proto.h
index 1313b31665..ffbc9fb522 100644
--- a/proto.h
+++ b/proto.h
@@ -2781,6 +2781,11 @@ PERL_CALLCONV void	Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
 #define PERL_ARGS_ASSERT_SAVE_DELETE	\
 	assert(hv); assert(key)
 
+PERL_CALLCONV void	Perl_save_adelete(pTHX_ AV *av, I32 key)
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_SAVE_ADELETE	\
+	assert(av)
+
 PERL_CALLCONV void	Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
 			__attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_SAVE_DESTRUCTOR	\
diff --git a/scope.c b/scope.c
index cad14dec7b..20e027ff8e 100644
--- a/scope.c
+++ b/scope.c
@@ -509,6 +509,17 @@ Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
 }
 
 void
+Perl_save_adelete(pTHX_ AV *av, I32 key)
+{
+    dVAR;
+
+    PERL_ARGS_ASSERT_SAVE_ADELETE;
+
+    SvREFCNT_inc_void(av);
+    save_pushi32ptr(key, av, SAVEt_ADELETE);
+}
+
+void
 Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
 {
     dVAR;
@@ -864,6 +875,13 @@ Perl_leave_scope(pTHX_ I32 base)
 	    SvREFCNT_dec(hv);
 	    Safefree(ptr);
 	    break;
+	case SAVEt_ADELETE:
+	    ptr = SSPOPPTR;
+	    av = MUTABLE_AV(ptr);
+	    i = SSPOPINT;
+	    (void)av_delete(av, i, G_DISCARD);
+	    SvREFCNT_dec(av);
+	    break;
 	case SAVEt_DESTRUCTOR_X:
 	    ptr = SSPOPPTR;
 	    (*SSPOPDXPTR)(aTHX_ ptr);
diff --git a/scope.h b/scope.h
index 70b7165a86..97e0d7aa3f 100644
--- a/scope.h
+++ b/scope.h
@@ -54,6 +54,7 @@
 #define SAVEt_COMPILE_WARNINGS	43
 #define SAVEt_STACK_CXPOS	44
 #define SAVEt_PARSER		45
+#define SAVEt_ADELETE		46
 
 #define SAVEf_SETMAGIC		1
 
@@ -142,6 +143,8 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 #define SAVESETSVFLAGS(sv,mask,val)	save_set_svflags(sv,mask,val)
 #define SAVEDELETE(h,k,l) \
 	  save_delete(MUTABLE_HV(h), (char*)(k), (I32)(l))
+#define SAVEADELETE(a,k) \
+	  save_adelete(MUTABLE_AV(a), (I32)(k))
 #define SAVEDESTRUCTOR(f,p) \
 	  save_destructor((DESTRUCTORFUNC_NOCONTEXT_t)(f), (void*)(p))