This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl_do_sv_dump() shouldn't show "IV" for a FBM, as it's not valid.
authorNicholas Clark <nick@ccl4.org>
Mon, 23 May 2011 20:01:37 +0000 (21:01 +0100)
committerNicholas Clark <nick@ccl4.org>
Sat, 11 Jun 2011 07:12:37 +0000 (09:12 +0200)
The memory is used for part of the FBM state.

Tidy the order of conditions in the if() determining whether the IV/UV should
be shown.

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

diff --git a/dump.c b/dump.c
index 9624970..d8907c9 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1708,8 +1708,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     /* Dump general SV fields */
 
     if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
-        && type != SVt_PVCV && !isGV_with_GP(sv) && type != SVt_PVFM
-        && type != SVt_PVIO && type != SVt_REGEXP)
+        && type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
+        && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
        || (type == SVt_IV && !SvROK(sv))) {
        if (SvIsUV(sv)
 #ifdef PERL_OLD_COPY_ON_WRITE
index 8eedf53..4fee5e7 100644 (file)
@@ -778,4 +778,42 @@ SKIP: {
      or diag $@;
 }
 
+use constant perl => 'rules';
+
+unless ($Config{useithreads}) {
+    # These end up as copies in pads under ithreads, which rather defeats the
+    # the point of what we're trying to test here.
+
+    do_test('regular string constant', perl,
+'SV = PV\\($ADDR\\) at $ADDR
+  REFCNT = 3
+  FLAGS = \\(PADMY,POK,READONLY,pPOK\\)
+  PV = $ADDR "rules"\\\0
+  CUR = 5
+  LEN = \d+
+');
+
+    eval 'index "", perl';
+
+    # FIXME - really this shouldn't say EVALED. It's a false posistive on
+    # 0x40000000 being used for several things, not a flag for "I'm in a string
+    # eval"
+
+    do_test('string constant now an FBM', perl,
+'SV = PVGV\\($ADDR\\) at $ADDR
+  REFCNT = 3
+  FLAGS = \\(PADMY,SMG,POK,READONLY,pPOK,VALID,EVALED\\)
+  PV = $ADDR "rules"\\\0
+  CUR = 5
+  LEN = \d+
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_bm
+    MG_TYPE = PERL_MAGIC_bm\\(B\\)
+  FLAGS = 0
+  RARE = \d+
+  PREVIOUS = 1
+  USEFUL = 100
+');
+}
+
 done_testing();