From: Vincent Pit <perl@profvince.com>
Date: Sat, 25 Jul 2009 16:19:51 +0000 (+0200)
Subject: Introduce save_hdelete() and SAVEHDELETE()
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=af097752b446f87855473ee776be3a2d7b735986;p=p5sagit%2Fp5-mst-13.2.git

Introduce save_hdelete() and SAVEHDELETE()

save_hdelete() is just like save_delete() except that it takes an SV instead of  char buffer.
---

diff --git a/embed.fnc b/embed.fnc
index bfc9425..f1db823 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -890,6 +890,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_hdelete	|NN HV *hv|NN SV *keysv
 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
diff --git a/embed.h b/embed.h
index b602464..dd7f269 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_hdelete		Perl_save_hdelete
 #define save_adelete		Perl_save_adelete
 #define save_destructor		Perl_save_destructor
 #define save_destructor_x	Perl_save_destructor_x
@@ -3118,6 +3119,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_hdelete(a,b)	Perl_save_hdelete(aTHX_ a,b)
 #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)
diff --git a/global.sym b/global.sym
index 73bf5be..de14a7b 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_hdelete
 Perl_save_adelete
 Perl_save_destructor
 Perl_save_destructor_x
diff --git a/proto.h b/proto.h
index 77464c5..61805f6 100644
--- a/proto.h
+++ b/proto.h
@@ -2783,6 +2783,12 @@ 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_hdelete(pTHX_ HV *hv, SV *keysv)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_SAVE_HDELETE	\
+	assert(hv); assert(keysv)
+
 PERL_CALLCONV void	Perl_save_adelete(pTHX_ AV *av, I32 key)
 			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_SAVE_ADELETE	\
diff --git a/scope.c b/scope.c
index 5aaf5de..50798e4 100644
--- a/scope.c
+++ b/scope.c
@@ -514,6 +514,21 @@ Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
 }
 
 void
+Perl_save_hdelete(pTHX_ HV *hv, SV *keysv)
+{
+    STRLEN len;
+    I32 klen;
+    const char *key;
+
+    PERL_ARGS_ASSERT_SAVE_HDELETE;
+
+    key  = SvPV_const(keysv, len);
+    klen = SvUTF8(keysv) ? -(I32)len : (I32)len;
+    SvREFCNT_inc_simple_void_NN(hv);
+    save_pushptri32ptr(savepvn(key, len), klen, hv, SAVEt_DELETE);
+}
+
+void
 Perl_save_adelete(pTHX_ AV *av, I32 key)
 {
     dVAR;
diff --git a/scope.h b/scope.h
index 77a389d..7517798 100644
--- a/scope.h
+++ b/scope.h
@@ -145,6 +145,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 SAVEHDELETE(h,s) \
+	  save_hdelete(MUTABLE_HV(h), (s))
 #define SAVEADELETE(a,k) \
 	  save_adelete(MUTABLE_AV(a), (I32)(k))
 #define SAVEDESTRUCTOR(f,p) \