add new API function sv_get_backrefs()

This encapsulates the logic to extract the backrefs from a weak-referent.

Since sv_get_backrefs() can be used for a similar purposes as hv_backreferences_p()
we no longer need to export the later, and therefore this patch also reverts
ad2f46a793b4ade67d45ac0086ae62f6756c2752.

See perl #123473 for related discussion, and https://github.com/Sereal/Sereal/issues/73
for a practical example of why this API is required.

2 files changed, 71 insertions, 0 deletions

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index dee9f2f4a7..791063536d 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -5024,3 +5024,22 @@ test_Gconvert(SV * number, SV * num_digits)
         RETVAL = newSVpv(buffer, 0);
     OUTPUT:
         RETVAL
+
+MODULE = XS::APItest		PACKAGE = XS::APItest::Backrefs
+
+void
+weaken(SV *sv)
+    PROTOTYPE: $
+    CODE:
+        sv_rvweaken(sv);
+
+SV *
+has_backrefs(SV *sv)
+    CODE:
+        if (SvROK(sv) && sv_get_backrefs(SvRV(sv)))
+            RETVAL = &PL_sv_yes;
+        else
+            RETVAL = &PL_sv_no;
+    OUTPUT:
+        RETVAL
+
diff --git a/ext/XS-APItest/t/weaken.t b/ext/XS-APItest/t/weaken.t
new file mode 100644
index 0000000000..5396e529de
--- /dev/null
+++ b/ext/XS-APItest/t/weaken.t
@@ -0,0 +1,52 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+use_ok('XS::APItest');
+
+# test sv_rvweaken() and sv_get_backrefs()
+#
+# weaken() maps to sv_rvweaken() and is the same as the one
+# from Scalar::Utils - we recreate it in XS::APItest so
+# we can test it even if we build without Scalar::Utils
+#
+# has_backrefs() maps to sv_get_backrefs(), which would not
+# normally be useful to Perl code. (Er, maybe :-)
+
+# has_backrefs is really an internal routine
+# which would not normally have to worry about refs
+# and things like that, but to use it from perl we cant
+# have an AV/HV without having an RV wrapping it, so we
+# mandate the ref always.
+
+my $foo= "foo";
+my $bar= "bar";
+
+my $scalar_ref= \$foo;
+my $array_ref= [ qw(this is an array) ];
+my $hash_ref= { this => is => a => 'hash' };
+
+my $nrml_scalar_ref= \$bar;
+my $nrml_array_ref= [ qw( this is an array ) ];
+my $nrml_hash_ref= { this => is => a => 'hash' };
+
+# we could probably do other tests here, such as
+# verify the refcount of the referents, but maybe
+# another day.
+weaken(my $weak_scalar_ref= $scalar_ref);
+weaken(my $weak_array_ref= $array_ref);
+weaken(my $weak_hash_ref= $hash_ref);
+
+ok(has_backrefs($scalar_ref), "scalar with backrefs");
+ok(has_backrefs($array_ref), "array with backrefs");
+ok(has_backrefs($hash_ref), "hash with backrefs");
+
+ok(!has_backrefs($nrml_scalar_ref), "scalar without backrefs");
+ok(!has_backrefs($nrml_array_ref), "array without backrefs");
+ok(!has_backrefs($nrml_hash_ref), "hash without backrefs");
+
+1;
+