Data::Dumper: handle incomplete support for Unicode glob names
authorAaron Crane <arc@cpan.org>
Sat, 21 Apr 2018 14:59:46 +0000 (16:59 +0200)
committerAaron Crane <arc@cpan.org>
Sun, 22 Jul 2018 12:39:12 +0000 (13:39 +0100)
Before version 5.16, Perl didn't have full support for Unicode in glob
names. This change allows Data::Dumper's tests to pass in Perl 5.8 through
5.14.

dist/Data-Dumper/Dumper.pm
dist/Data-Dumper/Dumper.xs
dist/Data-Dumper/t/dumper.t

index e479b4f..06ca52d 100644 (file)
@@ -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"
             ? ''
index 1709451..9557191 100644 (file)
@@ -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';
index 3f89332..6a5d147 100644 (file)
@@ -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'},