Use Perl_hv_common() to test disabling the key conversion in hash

lookups.

p4raw-id: //depot/perl@31923

diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index 334c376..2b14e5d 100644 (file)
--- a/ext/XS/APItest/APItest.xs
+++ b/ext/XS/APItest/APItest.xs
@@ -404,6 +404,51 @@ fetch(hash, key_sv)
         OUTPUT:
         RETVAL
 
+SV *
+common(params)
+       INPUT:
+       HV *params
+       PREINIT:
+       HE *result;
+       HV *hv = NULL;
+       SV *keysv = NULL;
+       const char *key = NULL;
+       STRLEN klen = 0;
+       int flags = 0;
+       int action = 0;
+       SV *val = NULL;
+       U32 hash = 0;
+       SV **svp;
+       CODE:
+       if ((svp = hv_fetchs(params, "hv", 0))) {
+           SV *const rv = *svp;
+           if (!SvROK(rv))
+               croak("common passed a non-reference for parameter hv");
+           hv = (HV *)SvRV(rv);
+       }
+       if ((svp = hv_fetchs(params, "keysv", 0)))
+           keysv = *svp;
+       if ((svp = hv_fetchs(params, "keypv", 0))) {
+           key = SvPV_const(*svp, klen);
+           if (SvUTF8(*svp))
+               flags = HVhek_UTF8;
+       }
+       if ((svp = hv_fetchs(params, "action", 0)))
+           action = SvIV(*svp);
+       if ((svp = hv_fetchs(params, "val", 0)))
+           val = *svp;
+       if ((svp = hv_fetchs(params, "hash", 0)))
+           action = SvUV(*svp);
+
+       result = hv_common(hv, keysv, key, klen, flags, action, val, hash);
+       if (!result) {
+           XSRETURN_EMPTY;
+       }
+       /* Force mg_get  */
+       RETVAL = newSVsv(HeVAL(result));
+        OUTPUT:
+        RETVAL
+
 void
 test_hv_free_ent()
        PPCODE:

diff --git a/ext/XS/APItest/t/hash.t b/ext/XS/APItest/t/hash.t
index 6faea3f..13bbd9c 100644 (file)
--- a/ext/XS/APItest/t/hash.t
+++ b/ext/XS/APItest/t/hash.t
@@ -235,9 +235,27 @@ sub test_U_hash {
        "exists_ent (missing)");
 
     $victim = shift @hitlist;
+    die "Need a victim" unless defined $victim;
     ok (XS::APItest::Hash::exists($hash, $victim), "exists");
     ok (!XS::APItest::Hash::exists($hash, $mapping->($victim)),
        "exists (missing)");
+
+    is (XS::APItest::Hash::common({hv => $hash, keysv => $victim}),
+       $placebo->{$victim}, "common (fetch)");
+    is (XS::APItest::Hash::common({hv => $hash, keypv => $victim}),
+       $placebo->{$victim}, "common (fetch pv)");
+    is (XS::APItest::Hash::common({hv => $hash, keysv => $victim,
+                                  action => XS::APItest::HV_DISABLE_UVAR_XKEY}),
+       undef, "common (fetch) missing");
+    is (XS::APItest::Hash::common({hv => $hash, keypv => $victim,
+                                  action => XS::APItest::HV_DISABLE_UVAR_XKEY}),
+       undef, "common (fetch pv) missing");
+    is (XS::APItest::Hash::common({hv => $hash, keysv => $mapping->($victim),
+                                  action => XS::APItest::HV_DISABLE_UVAR_XKEY}),
+       $placebo->{$victim}, "common (fetch) missing mapped");
+    is (XS::APItest::Hash::common({hv => $hash, keypv => $mapping->($victim),
+                                  action => XS::APItest::HV_DISABLE_UVAR_XKEY}),
+       $placebo->{$victim}, "common (fetch pv) missing mapped");
 }
 
 sub main_tests {