Call the key transformation function for hv_delete().

Honour the HV_DISABLE_UVAR_XKEY for hv_delete().
Test this.
[Pass in 3 more parameters to S_hv_magic_uvar_xkey()]

p4raw-id: //depot/perl@31905

diff --git a/embed.fnc b/embed.fnc
index 3f012d2..779cecb 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1141,7 +1141,10 @@ sanR     |HEK*   |save_hek_flags |NN const char *str|I32 len|U32 hash|int flags
 sn     |void   |hv_magic_check |NN HV *hv|NN bool *needs_copy|NN bool *needs_store
 s      |void   |unshare_hek_or_pvn|NULLOK const HEK* hek|NULLOK const char* str|I32 len|U32 hash
 sR     |HEK*   |share_hek_flags|NN const char* sv|I32 len|U32 hash|int flags
-sR     |SV*    |hv_magic_uvar_xkey|NN HV* hv|NN SV* keysv|int action
+sR     |SV*    |hv_magic_uvar_xkey|NN HV* hv|NULLOK SV* keysv \
+                               |NULLOK const char *const key \
+                               |const STRLEN klen |const int k_flags \
+                               |int action
 rs     |void   |hv_notallowed  |int flags|NN const char *key|I32 klen|NN const char *msg
 sn     |struct xpvhv_aux*|hv_auxinit|NN HV *hv
 sM     |SV*    |hv_delete_common|NULLOK HV* tb|NULLOK SV* keysv|NULLOK const char* key \

diff --git a/embed.h b/embed.h
index 18ab10b..9c79026 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -3423,7 +3423,7 @@
 #define hv_magic_check         S_hv_magic_check
 #define unshare_hek_or_pvn(a,b,c,d)    S_unshare_hek_or_pvn(aTHX_ a,b,c,d)
 #define share_hek_flags(a,b,c,d)       S_share_hek_flags(aTHX_ a,b,c,d)
-#define hv_magic_uvar_xkey(a,b,c)      S_hv_magic_uvar_xkey(aTHX_ a,b,c)
+#define hv_magic_uvar_xkey(a,b,c,d,e,f)        S_hv_magic_uvar_xkey(aTHX_ a,b,c,d,e,f)
 #define hv_notallowed(a,b,c,d) S_hv_notallowed(aTHX_ a,b,c,d)
 #define hv_auxinit             S_hv_auxinit
 #define hv_delete_common(a,b,c,d,e,f,g)        S_hv_delete_common(aTHX_ a,b,c,d,e,f,g)

diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index da865e6..96efd9b 100644 (file)
--- a/ext/XS/APItest/APItest.xs
+++ b/ext/XS/APItest/APItest.xs
@@ -195,8 +195,12 @@ rot13_key(pTHX_ IV action, SV *field) {
     return 0;
 }
 
+#include "const-c.inc"
+
 MODULE = XS::APItest:Hash              PACKAGE = XS::APItest::Hash
 
+INCLUDE: const-xs.inc
+
 void
 rot13_hash(hash)
        HV *hash
@@ -227,17 +231,31 @@ exists(hash, key_sv)
         RETVAL
 
 SV *
-delete(hash, key_sv)
+delete(hash, key_sv, flags = 0)
        PREINIT:
        STRLEN len;
        const char *key;
        INPUT:
        HV *hash
        SV *key_sv
+       I32 flags;
        CODE:
        key = SvPV(key_sv, len);
        /* It's already mortal, so need to increase reference count.  */
-       RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
+       RETVAL
+           = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), flags));
+        OUTPUT:
+        RETVAL
+
+SV *
+delete_ent(hash, key_sv, flags = 0)
+       INPUT:
+       HV *hash
+       SV *key_sv
+       I32 flags;
+       CODE:
+       /* It's already mortal, so need to increase reference count.  */
+       RETVAL = SvREFCNT_inc(hv_delete_ent(hash, key_sv, flags, 0));
         OUTPUT:
         RETVAL
 

diff --git a/ext/XS/APItest/Makefile.PL b/ext/XS/APItest/Makefile.PL
index 76aa60a..05bcfb0 100644 (file)
--- a/ext/XS/APItest/Makefile.PL
+++ b/ext/XS/APItest/Makefile.PL
@@ -1,5 +1,6 @@
 use 5.008;
 use ExtUtils::MakeMaker;
+use ExtUtils::Constant 0.11 'WriteConstants';
 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
 # the contents of the Makefile that is written.
 WriteMakefile(
@@ -17,6 +18,14 @@ WriteMakefile(
        # Un-comment this if you add C files to link with later:
     # 'OBJECT'         => '$(O_FILES)', # link all the C files too
     MAN3PODS           => {},  # Pods will be built by installman.
+    realclean => {FILES        => 'const-c.inc const-xs.inc'},
+);
+
+WriteConstants(
+    PROXYSUBS => 1,
+    NAME => 'XS::APItest',
+    NAMES => [qw(HV_DELETE HV_DISABLE_UVAR_XKEY G_DISCARD HV_FETCH_ISSTORE
+                HV_FETCH_ISEXISTS HV_FETCH_LVALUE HV_FETCH_JUST_SV)],
 );
 
 sub MY::install { "install ::\n"  };

diff --git a/ext/XS/APItest/t/hash.t b/ext/XS/APItest/t/hash.t
index 4af7f88..949f175 100644 (file)
--- a/ext/XS/APItest/t/hash.t
+++ b/ext/XS/APItest/t/hash.t
@@ -18,7 +18,7 @@ use utf8;
 use Tie::Hash;
 use Test::More 'no_plan';
 
-use_ok('XS::APItest');
+BEGIN {use_ok('XS::APItest')};
 
 sub preform_test;
 sub test_present;
@@ -95,7 +95,7 @@ foreach my $in ("", "N", "a\0b") {
     is ($got, $in, "test_share_unshare_pvn");
 }
 
-{
+if ($] > 5.009) {
     my %hash;
     XS::APItest::Hash::rot13_hash(\%hash);
     $hash{a}++; @hash{qw(p i e)} = (2, 4, 8);
@@ -105,6 +105,34 @@ foreach my $in ("", "N", "a\0b") {
        "uvar magic called exactly once on store");
 
     is($hash{i}, 4);
+
+    is(delete $hash{a}, 1);
+
+    is(keys %hash, 3);
+    @keys = sort keys %hash;
+    is("@keys", join(' ', sort(rot13(qw(p i e)))));
+
+    is (XS::APItest::Hash::delete_ent (\%hash, 'p',
+                                      XS::APItest::HV_DISABLE_UVAR_XKEY),
+       undef, "Deleting a known key with conversion disabled fails (ent)");
+    is(keys %hash, 3);
+
+    is (XS::APItest::Hash::delete_ent (\%hash, 'p', 0),
+       2, "Deleting a known key with conversion enabled works (ent)");
+    is(keys %hash, 2);
+    @keys = sort keys %hash;
+    is("@keys", join(' ', sort(rot13(qw(i e)))));
+
+    is (XS::APItest::Hash::delete (\%hash, 'i',
+                                  XS::APItest::HV_DISABLE_UVAR_XKEY),
+       undef, "Deleting a known key with conversion disabled fails");
+    is(keys %hash, 2);
+
+    is (XS::APItest::Hash::delete (\%hash, 'i', 0),
+       4, "Deleting a known key with conversion enabled works");
+    is(keys %hash, 1);
+    @keys = sort keys %hash;
+    is("@keys", join(' ', sort(rot13(qw(e)))));
 }
 
 exit;

diff --git a/hv.c b/hv.c
index 634d0e6..8394a0e 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -426,7 +426,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     if (keysv) {
        if (SvSMAGICAL(hv) && SvGMAGICAL(hv)
            && !(action & HV_DISABLE_UVAR_XKEY)) {
-           keysv = hv_magic_uvar_xkey(hv, keysv, action);
+           keysv = hv_magic_uvar_xkey(hv, keysv, 0, 0, 0, action);
            /* If a fetch-as-store fails on the fetch, then the action is to
               recurse once into "hv_store". If we didn't do this, then that
               recursive call would call the key conversion routine again.
@@ -966,10 +966,10 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     if (!hv)
        return NULL;
 
+    if (SvSMAGICAL(hv) && SvGMAGICAL(hv)
+       && !(d_flags & HV_DISABLE_UVAR_XKEY))
+       keysv = hv_magic_uvar_xkey(hv, keysv, key, klen, k_flags, HV_DELETE);
     if (keysv) {
-       if (SvSMAGICAL(hv) && SvGMAGICAL(hv)
-           && !(d_flags & HV_DISABLE_UVAR_XKEY))
-           keysv = hv_magic_uvar_xkey(hv, keysv, HV_DELETE);
        if (k_flags & HVhek_FREEKEY)
            Safefree(key);
        key = SvPV_const(keysv, klen);
@@ -2533,13 +2533,21 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
 }
 
 STATIC SV *
-S_hv_magic_uvar_xkey(pTHX_ HV* hv, SV* keysv, int action)
+S_hv_magic_uvar_xkey(pTHX_ HV* hv, SV* keysv, const char *const key,
+                    const STRLEN klen, const int k_flags, int action)
 {
     MAGIC* mg;
     if ((mg = mg_find((SV*)hv, PERL_MAGIC_uvar))) {
        struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
        if (uf->uf_set == NULL) {
            SV* obj = mg->mg_obj;
+
+           if (!keysv) {
+               keysv = sv_2mortal(newSVpvn(key, klen));
+               if (k_flags & HVhek_UTF8)
+                   SvUTF8_on(keysv);
+           }
+               
            mg->mg_obj = keysv;         /* pass key */
            uf->uf_index = action;      /* pass action */
            magic_getuvar((SV*)hv, mg);

diff --git a/proto.h b/proto.h
index 4c1e6a1..cc9e27d 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3044,10 +3044,9 @@ STATIC HEK*      S_share_hek_flags(pTHX_ const char* sv, I32 len, U32 hash, int flags
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
 
-STATIC SV*     S_hv_magic_uvar_xkey(pTHX_ HV* hv, SV* keysv, int action)
+STATIC SV*     S_hv_magic_uvar_xkey(pTHX_ HV* hv, SV* keysv, const char *const key, const STRLEN klen, const int k_flags, int action)
                        __attribute__warn_unused_result__
-                       __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_2);
+                       __attribute__nonnull__(pTHX_1);
 
 STATIC void    S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, const char *msg)
                        __attribute__noreturn__