diff options
| author | Nicholas Clark <nick@ccl4.org> | 2021-05-13 09:11:43 +0000 |
|---|---|---|
| committer | Nicholas Clark <nick@ccl4.org> | 2021-05-22 08:22:26 +0000 |
| commit | 6514035f0b95a6a45e919660b27f0e89c2dfbe93 (patch) | |
| tree | fd175a28024aab37994c4a1c01f7ef5f569c6ff0 /dist/Data-Dumper | |
| parent | 756088ea0ed5891972ceb5882e0a5cd493e7213d (diff) | |
| download | perl-6514035f0b95a6a45e919660b27f0e89c2dfbe93.tar.gz | |
More tests for Unicode in qr//.
Adapted from Aaron's tests in GH #18771, with fixes for older Perl versions,
and also skipped for Dumpxs for now.
Diffstat (limited to 'dist/Data-Dumper')
| -rw-r--r-- | dist/Data-Dumper/t/dumper.t | 58 |
1 files changed, 53 insertions, 5 deletions
diff --git a/dist/Data-Dumper/t/dumper.t b/dist/Data-Dumper/t/dumper.t index 13f0b88884..af8c10308a 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 = 480; +$TMAX = 486; # 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 @@ -1709,6 +1709,7 @@ EOW ############# { # [github #18614 - handling of Unicode characters in regexes] + # [github #18764 - ... without breaking subsequent Latin-1] if ($] lt '5.010') { SKIP_TEST "Incomplete support for UTF-8 in old perls"; SKIP_TEST "Incomplete support for UTF-8 in old perls"; @@ -1718,17 +1719,27 @@ $WANT = <<"EOW"; #\$VAR1 = [ # "\\x{41f}", # qr/\x{8b80}/, -# qr/\x{41f}/ +# qr/\x{41f}/, +# qr/\x{e4}/, +# '\xE4' #]; EOW - $WANT =~ s{/(,?)$}{/u$1}mg if $] gt '5.014'; - TEST qq(Data::Dumper->Dump([ [qq/\x{41f}/, qr/\x{8b80}/, qr/\x{41f}/] ])), + if ($] lt '5.010001') { + $WANT =~ s!qr/!qr/(?-xism:!g; + $WANT =~ s!/,!)/,!g; + } + elsif ($] gt '5.014') { + $WANT =~ s{/(,?)$}{/u$1}mg; + } + TEST qq(Data::Dumper->Dump([ [qq/\x{41f}/, qr/\x{8b80}/, qr/\x{41f}/, qr/\x{e4}/, "\xE4"] ])), "string with Unicode + regexp with Unicode"; SKIP_TEST "skipped, pending fix for github #18764"; last; - TEST qq(Data::Dumper->Dumpxs([ [qq/\x{41f}/, qr/\x{8b80}/, qr/\x{41f}/] ])), + $WANT =~ s/'\xE4'/"\\x{e4}"/; + $WANT =~ s<([^\0-\177])> <sprintf '\\x{%x}', ord $1>ge; + TEST qq(Data::Dumper->Dumpxs([ [qq/\x{41f}/, qr/\x{8b80}/, qr/\x{41f}/, qr/\x{e4}/, "\xE4"] ])), "string with Unicode + regexp with Unicode, XS" if $XS; } @@ -1760,6 +1771,43 @@ EOW } ############# { + # [github #18614, github #18764, perl #58608 corner cases] + 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; + } + my $bs = "\\\\"; + $WANT = <<"EOW"; +#\$VAR1 = [ +# "\\x{2e18}", +# qr/ \x{203d}\\/ /, +# qr/ \\\x{203d}\\/ /, +# qr/ \\\x{203d}$bs:\\/ /, +# '\xA3' +#]; +EOW + if ($] lt '5.010001') { + $WANT =~ s!qr/!qr/(?-xism:!g; + $WANT =~ s!/,!)/,!g; + } + elsif ($] gt '5.014') { + $WANT =~ s{/(,?)$}{/u$1}mg; + } + TEST qq(Data::Dumper->Dump([ [ '\x{2e18}', qr! \x{203d}/ !, qr! \\\x{203d}/ !, qr! \\\x{203d}$bs:/ !, "\xa3"] ])), + "github #18614, github #18764, perl #58608 corner cases"; + + SKIP_TEST "skipped, pending fix for github #18764"; + last; + + $WANT =~ s/'\x{A3}'/"\\x{a3}"/; + $WANT =~ s/\x{203D}/\\x{203d}/g; + TEST qq(Data::Dumper->Dumpxs([ [ '\x{2e18}', qr! \x{203d}/ !, qr! \\\x{203d}/ !, qr! \\\x{203d}$bs:/ !, "\xa3"] ])), + "github #18614, github #18764, perl #58608 corner cases 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 |