This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make sv_dump (and therefore Devel::Peek) report the value of the
authorNicholas Clark <nick@ccl4.org>
Mon, 19 Dec 2005 18:28:03 +0000 (18:28 +0000)
committerNicholas Clark <nick@ccl4.org>
Mon, 19 Dec 2005 18:28:03 +0000 (18:28 +0000)
constant in inlineable constant subroutines.

p4raw-id: //depot/perl@26404

dump.c
ext/Devel/Peek/t/Peek.t

diff --git a/dump.c b/dump.c
index 16c7281..f07e95f 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1477,7 +1477,21 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
         if (CvROOT(sv) && dumpops)
            do_op_dump(level+1, file, CvROOT(sv));
        Perl_dump_indent(aTHX_ level, file, "  XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
-       Perl_dump_indent(aTHX_ level, file, "  XSUBANY = %"IVdf"\n", (IV)CvXSUBANY(sv).any_i32);
+       {
+           SV *constant = cv_const_sv((CV *)sv);
+
+
+           if (constant) {
+               Perl_dump_indent(aTHX_ level, file, "  XSUBANY = 0x%"UVxf
+                                " (CONST SV)\n",
+                                PTR2UV(CvXSUBANY(sv).any_ptr));
+               do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
+                          pvlim);
+           } else {
+               Perl_dump_indent(aTHX_ level, file, "  XSUBANY = %"IVdf"\n",
+                                (IV)CvXSUBANY(sv).any_i32);
+           }
+       }
        do_gvgv_dump(level, file, "  GVGV::GV", CvGV(sv));
        Perl_dump_indent(aTHX_ level, file, "  FILE = \"%s\"\n", CvFILE(sv));
        Perl_dump_indent(aTHX_ level, file, "  DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
index 0415a1d..8ea456c 100644 (file)
@@ -12,7 +12,7 @@ BEGIN {
 
 use Devel::Peek;
 
-print "1..22\n";
+print "1..23\n";
 
 our $DEBUG = 0;
 open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
@@ -465,3 +465,41 @@ do_test(22,
     CUR = 0
     LEN = 0
     STASH = $ADDR\s+"Foobar"');
+
+# Constant subroutines
+
+sub const () {
+    "Perl rules";
+}
+
+do_test(23,
+       \&const,
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVCV\\($ADDR\\) at $ADDR
+    REFCNT = (2)
+    FLAGS = \\(POK,pPOK,CONST\\)
+    IV = 0
+    NV = 0
+    PROTOTYPE = ""
+    COMP_STASH = 0x0
+    ROOT = 0x0
+    XSUB = $ADDR
+    XSUBANY = $ADDR \\(CONST SV\\)
+    SV = PV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(.*POK,READONLY,pPOK\\)
+      PV = $ADDR "Perl rules"\\\0
+      CUR = 10
+      LEN = \\d+
+    GVGV::GV = $ADDR\\t"main" :: "const"
+    FILE = ".*\\b(?i:peek\\.t)"
+    DEPTH = 0
+(?:    MUTEXP = $ADDR
+    OWNER = $ADDR
+)?    FLAGS = 0x200
+    OUTSIDE_SEQ = 0
+    PADLIST = 0x0
+    OUTSIDE = 0x0 \\(null\\)');