[perl #117793] remove dangerous functions and improve SvREFCNT()

This allows Devel::Peek::SvREFCNT() to work on any variable, not just
scalars, but has a chance of breaking backward compatibility.

Also changes the type of SvREFCNT() to U32 to match the type returned by
the underlying macro

diff --git a/ext/Devel-Peek/Peek.pm b/ext/Devel-Peek/Peek.pm
index 2dacb54..60a18dd 100644 (file)
--- a/ext/Devel-Peek/Peek.pm
+++ b/ext/Devel-Peek/Peek.pm
@@ -3,7 +3,7 @@
 
 package Devel::Peek;
 
-$VERSION = '1.12';
+$VERSION = '1.13';
 $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -13,7 +13,7 @@ require XSLoader;
 @ISA = qw(Exporter);
 @EXPORT = qw(Dump mstat DeadCode DumpArray DumpWithOP DumpProg
             fill_mstats mstats_fillhash mstats2hash runops_debug debug_flags);
-@EXPORT_OK = qw(SvREFCNT SvREFCNT_inc SvREFCNT_dec CvGV);
+@EXPORT_OK = qw(SvREFCNT CvGV);
 %EXPORT_TAGS = ('ALL' => [@EXPORT, @EXPORT_OK]);
 
 XSLoader::load();
@@ -98,8 +98,7 @@ Devel::Peek supplies a C<Dump()> function which can dump a raw Perl
 datatype, and C<mstat("marker")> function to report on memory usage
 (if perl is compiled with corresponding option).  The function
 DeadCode() provides statistics on the data "frozen" into inactive
-C<CV>.  Devel::Peek also supplies C<SvREFCNT()>, C<SvREFCNT_inc()>, and
-C<SvREFCNT_dec()> which can query, increment, and decrement reference
+C<CV>.  Devel::Peek also supplies C<SvREFCNT()> which can query reference
 counts on SVs.  This document will take a passive, and safe, approach
 to data debugging and for that it will describe only the C<Dump()>
 function.

diff --git a/ext/Devel-Peek/Peek.xs b/ext/Devel-Peek/Peek.xs
index e97c979..a8d79f3 100644 (file)
--- a/ext/Devel-Peek/Peek.xs
+++ b/ext/Devel-Peek/Peek.xs
@@ -386,31 +386,14 @@ PPCODE:
        op_dump(PL_main_root);
 }
 
-I32
+U32
 SvREFCNT(sv)
 SV *   sv
-
-# PPCODE needed since otherwise sv_2mortal is inserted that will kill the value.
-
-SV *
-SvREFCNT_inc(sv)
-SV *   sv
-PPCODE:
-{
-    RETVAL = SvREFCNT_inc(sv);
-    PUSHs(RETVAL);
-}
-
-# PPCODE needed since by default it is void
-
-void
-SvREFCNT_dec(sv)
-SV *   sv
-PPCODE:
-{
-    SvREFCNT_dec(sv);
-    PUSHs(sv);
-}
+PROTOTYPE: \[$@%&*]
+CODE:
+    RETVAL = SvREFCNT(SvRV(sv)) - 1; /* -1 because our ref doesn't count */
+OUTPUT:
+    RETVAL
 
 SV *
 DeadCode()

diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t
index 3941c84..76a5c7a 100644 (file)
--- a/ext/Devel-Peek/t/Peek.t
+++ b/ext/Devel-Peek/t/Peek.t
@@ -1083,4 +1083,11 @@ do_test('UTF-8 in a regular expression',
     SAVED_COPY = 0x0)?
 ');
 
+{ # perl #117793: Extend SvREFCNT* to work on any perl variable type
+  my %hash;
+  my $base_count = Devel::Peek::SvREFCNT(%hash);
+  my $ref = \%hash;
+  is(Devel::Peek::SvREFCNT(%hash), $base_count + 1, "SvREFCNT on non-scalar");
+}
+
 done_testing();