From 6b4de9074f35c313f7b151542a4d1bbf6fd263a2 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 20 Sep 2007 10:21:30 +0000
Subject: [PATCH] Use Perl_hv_common() to test disabling the key conversion in
 hash lookups.

p4raw-id: //depot/perl@31923
---
 ext/XS/APItest/APItest.xs | 45 +++++++++++++++++++++++++++++++++++++++++++++
 ext/XS/APItest/t/hash.t   | 18 ++++++++++++++++++
 2 files changed, 63 insertions(+)

diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index 334c376..2b14e5d 100644
--- 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
--- 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 {
-- 
2.7.4