diff options
author | Aaron Crane <arc@cpan.org> | 2021-03-03 18:11:45 +0000 |
---|---|---|
committer | Aaron Crane <arc@users.noreply.github.com> | 2021-03-03 23:17:30 +0000 |
commit | c71f1f234aad8a3c58b04d38738d60a4a8677acb (patch) | |
tree | d8a0af7ef258ccbf87b4f0ce5c472d0d29cc6fee /dist/Data-Dumper | |
parent | 5ef909c14356003471084f73f248694aff209833 (diff) | |
download | perl-c71f1f234aad8a3c58b04d38738d60a4a8677acb.tar.gz |
Make Data::Dumper mark regex output as UTF-8 if needed
Diffstat (limited to 'dist/Data-Dumper')
-rw-r--r-- | dist/Data-Dumper/Dumper.xs | 4 | ||||
-rw-r--r-- | dist/Data-Dumper/t/dumper.t | 25 |
2 files changed, 28 insertions, 1 deletions
diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs index 6aca9182b6..e19997440a 100644 --- a/dist/Data-Dumper/Dumper.xs +++ b/dist/Data-Dumper/Dumper.xs @@ -651,6 +651,10 @@ dump_regexp(pTHX_ SV *retval, SV *val) assert(sv_pattern); + if (SvUTF8(sv_pattern)) { + sv_utf8_upgrade(retval); + } + rval = SvPV(sv_pattern, rlen); rend = rval+rlen; slash = rval; diff --git a/dist/Data-Dumper/t/dumper.t b/dist/Data-Dumper/t/dumper.t index a079ab6273..fd5e7eb315 100644 --- a/dist/Data-Dumper/t/dumper.t +++ b/dist/Data-Dumper/t/dumper.t @@ -139,7 +139,7 @@ sub SKIP_TEST { ++$TNUM; print "ok $TNUM # skip $reason\n"; } -$TMAX = 468; +$TMAX = 474; # Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling # it direct. Out here it lets us knobble the next if to test that the perl @@ -1708,6 +1708,29 @@ EOW } ############# { + # [github #18614 - handling of Unicode characters in regexes] + if ($] lt '5.010') { + SKIP_TEST "Incomplete support for UTF-8 in old perls"; + SKIP_TEST "Incomplete support for UTF-8 in old perls"; + last; + } +$WANT = <<"EOW"; +#\$VAR1 = [ +# "\\x{41f}", +# qr/\x{8b80}/, +# qr/\x{41f}/ +#]; +EOW + $WANT =~ s{/(,?)$}{/u$1}mg if $] gt '5.014'; + TEST qq(Data::Dumper->Dump([ [qq/\x{41f}/, qr/\x{8b80}/, qr/\x{41f}/] ])), + "string with Unicode + regexp with Unicode"; + + TEST qq(Data::Dumper->Dumpxs([ [qq/\x{41f}/, qr/\x{8b80}/, qr/\x{41f}/] ])), + "string with Unicode + regexp with Unicode, XS" + if $XS; +} +############# +{ # [perl #82948] # re::regexp_pattern was moved to universal.c in v5.10.0-252-g192c1e2 # and apparently backported to maint-5.10 |