summaryrefslogtreecommitdiff
path: root/dist/Data-Dumper
diff options
context:
space:
mode:
authorAaron Crane <arc@cpan.org>2021-03-03 18:11:45 +0000
committerAaron Crane <arc@users.noreply.github.com>2021-03-03 23:17:30 +0000
commitc71f1f234aad8a3c58b04d38738d60a4a8677acb (patch)
treed8a0af7ef258ccbf87b4f0ce5c472d0d29cc6fee /dist/Data-Dumper
parent5ef909c14356003471084f73f248694aff209833 (diff)
downloadperl-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.xs4
-rw-r--r--dist/Data-Dumper/t/dumper.t25
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