In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/8cdde9f826664af3e1c4c5f5f1bd9642d7aee812?hp=a7cf66212a59d18b09d49ce8817a76d25b145de0>
- Log ----------------------------------------------------------------- commit 8cdde9f826664af3e1c4c5f5f1bd9642d7aee812 Author: Nicholas Clark <[email protected]> Date: Wed Jan 16 11:48:04 2013 +0100 Perl_sv_uni_display() needs to be aware of RX_WRAPPED() 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. ----------------------------------------------------------------------- Summary of changes: ext/Devel-Peek/t/Peek.t | 34 ++++++++++++++++++++++++++++++++++ utf8.c | 5 ++++- 2 files changed, 38 insertions(+), 1 deletions(-) diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index 9a0e37c..116c204 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -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 --- 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); } -- Perl5 Master Repository
