diff options
| author | Nicholas Clark <nick@ccl4.org> | 2007-09-20 10:21:30 +0000 |
|---|---|---|
| committer | Nicholas Clark <nick@ccl4.org> | 2007-09-20 10:21:30 +0000 |
| commit | 6b4de9074f35c313f7b151542a4d1bbf6fd263a2 (patch) | |
| tree | 8c84d4ab91b33f31b14fb26c6cc48886a4f9cdbf /ext | |
| parent | 8265e3d1a493335506aedfbdd58318bf524d0b39 (diff) | |
| download | perl-6b4de9074f35c313f7b151542a4d1bbf6fd263a2.tar.gz | |
Use Perl_hv_common() to test disabling the key conversion in hash
lookups.
p4raw-id: //depot/perl@31923
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/XS/APItest/APItest.xs | 45 | ||||
| -rw-r--r-- | ext/XS/APItest/t/hash.t | 18 |
2 files changed, 63 insertions, 0 deletions
diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs index 334c376e62..2b14e5d9e9 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 6faea3f6a9..13bbd9c3ec 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 { |