Perl_sv_uni_display() needs to be aware of RX_WRAPPED()
authorNicholas Clark <nick@ccl4.org>
Wed, 16 Jan 2013 10:48:04 +0000 (11:48 +0100)
committerNicholas Clark <nick@ccl4.org>
Tue, 19 Mar 2013 10:38:42 +0000 (11:38 +0100)
Commit 8d919b0a35f2b57a changed the storage location of the string in
SVt_REGEXP. It updated most code to deal with this, but missed the use of
SvPVX_const() in Perl_sv_uni_display(). This breaks dumping regular
expressions which have the UTF-8 flag set.

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

index 9a0e37c..116c204 100644 (file)
@@ -938,4 +938,38 @@ unless ($Config{useithreads}) {
     close OUT;
 }
 
+do_test('UTF-8 in a regular expression',
+        qr/\x{100}/,
+'SV = IV\($ADDR\) at $ADDR
+  REFCNT = 1
+  FLAGS = \(ROK\)
+  RV = $ADDR
+  SV = REGEXP\($ADDR\) at $ADDR
+    REFCNT = 1
+    FLAGS = \(OBJECT,FAKE,UTF8\)
+    PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
+    CUR = 13
+    STASH = $ADDR      "Regexp"
+    EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
+    INTFLAGS = 0x0
+    NPARENS = 0
+    LASTPAREN = 0
+    LASTCLOSEPAREN = 0
+    MINLEN = 1
+    MINLENRET = 1
+    GOFS = 0
+    PRE_PREFIX = 5
+    SUBLEN = 0
+    SUBOFFSET = 0
+    SUBCOFFSET = 0
+    SUBBEG = 0x0
+    ENGINE = $ADDR
+    MOTHER_RE = $ADDR
+    PAREN_NAMES = 0x0
+    SUBSTRS = $ADDR
+    PPRIVATE = $ADDR
+    OFFS = $ADDR
+    QR_ANONCV = 0x0
+');
+
 done_testing();
diff --git a/utf8.c b/utf8.c
index ba1304e..511e845 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -4428,9 +4428,12 @@ The pointer to the PV of the C<dsv> is returned.
 char *
 Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags)
 {
+    const char * const ptr =
+        isREGEXP(ssv) ? RX_WRAPPED((REGEXP*)ssv) : SvPVX_const(ssv);
+
     PERL_ARGS_ASSERT_SV_UNI_DISPLAY;
 
-     return Perl_pv_uni_display(aTHX_ dsv, (const U8*)SvPVX_const(ssv),
+    return Perl_pv_uni_display(aTHX_ dsv, (const U8*)ptr,
                                SvCUR(ssv), pvlim, flags);
 }