diff options
Diffstat (limited to 'dist')
| -rw-r--r-- | dist/Data-Dumper/Dumper.pm | 2 | ||||
| -rw-r--r-- | dist/Data-Dumper/Dumper.xs | 23 | ||||
| -rw-r--r-- | dist/Data-Dumper/t/dumper.t | 19 |
3 files changed, 39 insertions, 5 deletions
diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm index e479b4ff07..06ca52dc46 100644 --- a/dist/Data-Dumper/Dumper.pm +++ b/dist/Data-Dumper/Dumper.pm @@ -18,6 +18,7 @@ BEGIN { use 5.006_001; require Exporter; +use constant IS_PRE_516_PERL => $] < 5.016; use constant IS_PRE_520_PERL => $] < 5.020; use Carp (); @@ -541,6 +542,7 @@ sub _dump { $sname = $name; } else { + local $s->{useqq} = IS_PRE_516_PERL && ($s->{useqq} || $name =~ /[^\x00-\x7f]/) ? 1 : $s->{useqq}; $sname = $s->_dump( $name eq 'main::' || $] < 5.007 && $name eq "main::\0" ? '' diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs index 1709451a9a..95571913ea 100644 --- a/dist/Data-Dumper/Dumper.xs +++ b/dist/Data-Dumper/Dumper.xs @@ -89,6 +89,7 @@ static STRLEN num_q (const char *s, STRLEN slen); static STRLEN esc_q (char *dest, const char *src, STRLEN slen); static STRLEN esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq); static bool globname_needs_quote(const char *s, STRLEN len); +static bool globname_supra_ascii(const char *s, STRLEN len); static bool key_needs_quote(const char *s, STRLEN len); static bool safe_decimal_number(const char *p, STRLEN len); static SV *sv_x (pTHX_ SV *sv, const char *str, STRLEN len, I32 n); @@ -182,6 +183,22 @@ TOP: return FALSE; } +#ifndef GvNAMEUTF8 +/* does a glob name contain supra-ASCII characters? */ +static bool +globname_supra_ascii(const char *ss, STRLEN len) +{ + const U8 *s = (const U8 *) ss; + const U8 *send = s+len; + while (s < send) { + if (!isASCII(*s)) + return TRUE; + s++; + } + return FALSE; +} +#endif + /* does a hash key need to be quoted (to the left of => ). Previously this used (globname_)needs_quote() which accepted strings like '::foo', but these aren't safe as unquoted keys under strict. @@ -1322,11 +1339,11 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, SvCUR_set(retval, SvCUR(retval)+2); i = 3 + esc_q_utf8(aTHX_ retval, c, i, #ifdef GvNAMEUTF8 - !!GvNAMEUTF8(val) + !!GvNAMEUTF8(val), style->useqq #else - 0 + 0, style->useqq || globname_supra_ascii(c, i) #endif - , style->useqq); + ); sv_grow(retval, SvCUR(retval)+2); r = SvPVX(retval)+SvCUR(retval); r[0] = '}'; r[1] = '\0'; diff --git a/dist/Data-Dumper/t/dumper.t b/dist/Data-Dumper/t/dumper.t index 3f893328d5..6a5d1479a1 100644 --- a/dist/Data-Dumper/t/dumper.t +++ b/dist/Data-Dumper/t/dumper.t @@ -23,6 +23,21 @@ my $XS; my $TNUM = 0; my $WANT = ''; +# Perl 5.16 was the first version that correctly handled Unicode in typeglob +# names. Tests for how globs are dumped must revise their expectations +# downwards when run on earlier Perls. +sub change_glob_expectation { + my ($input) = @_; + if ($] < 5.016) { + $input =~ s<\\x\{([0-9a-f]+)\}>{ + my $s = chr hex $1; + utf8::encode($s); + join '', map sprintf('\\%o', ord), split //, $s; + }ge; + } + return $input; +} + sub convert_to_native($) { my $input = shift; @@ -1743,7 +1758,7 @@ EOT ############# our @globs = map { $_, \$_ } map { *$_ } map { $_, "s::$_" } "foo", "\1bar", "L\x{e9}on", "m\x{100}cron", "snow\x{2603}"; -$WANT = <<'EOT'; +$WANT = change_glob_expectation(<<'EOT'); #$globs = [ # *::foo, # \*::foo, @@ -1774,7 +1789,7 @@ EOT if $XS; } ############# -$WANT = <<'EOT'; +$WANT = change_glob_expectation(<<'EOT'); #$v = { # a => \*::ppp, # b => \*{'::a/b'}, |