From af097752b446f87855473ee776be3a2d7b735986 Mon Sep 17 00:00:00 2001 From: Vincent Pit Date: Sat, 25 Jul 2009 18:19:51 +0200 Subject: [PATCH] Introduce save_hdelete() and SAVEHDELETE() save_hdelete() is just like save_delete() except that it takes an SV instead of char buffer. --- embed.fnc | 1 + embed.h | 2 ++ global.sym | 1 + proto.h | 6 ++++++ scope.c | 15 +++++++++++++++ scope.h | 2 ++ 6 files changed, 27 insertions(+) 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 and L. #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) \ -- 2.7.4