This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
handle xs Useqq dumping of strings with an escape followed by a digit
authorTony Cook <tony@develop-help.com>
Wed, 10 Jul 2013 04:54:20 +0000 (14:54 +1000)
committerTony Cook <tony@develop-help.com>
Wed, 17 Jul 2013 00:58:35 +0000 (10:58 +1000)
The original patch didn't handle a string like "\x001" correctly, encoding
it as "\01" rather than "\0001".

Added tests for this case and some possible corner cases

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

index e11323a..fca6ab1 100644 (file)
@@ -10,7 +10,7 @@
 package Data::Dumper;
 
 BEGIN {
-    $VERSION = '2.146'; # Don't forget to set version and release
+    $VERSION = '2.147'; # Don't forget to set version and release
 }               # date in POD below!
 
 #$| = 1;
index 60fe404..0194a2c 100644 (file)
@@ -175,6 +175,7 @@ esc_q_utf8(pTHX_ SV* sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq)
     STRLEN qq_escapables = 0;  /* " $ @ will need a \ in "" strings.  */
     STRLEN normal = 0;
     int increment;
+    UV next;
 
     /* this will need EBCDICification */
     for (s = src; s < send; do_utf8 ? s += increment : s++) {
@@ -183,6 +184,12 @@ esc_q_utf8(pTHX_ SV* sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq)
         /* check for invalid utf8 */
         increment = (k == 0 && *s != '\0') ? 1 : UTF8SKIP(s);
 
+       /* this is only used to check if the next character is an
+        * ASCII digit, which are invariant, so if the following collects
+        * a UTF-8 start byte it does no harm
+        */
+       next = (s + increment >= send ) ? 0 : *(U8*)(s+increment);
+
 #ifdef EBCDIC
        if (!isprint(k) || k > 256) {
 #else
@@ -197,11 +204,14 @@ esc_q_utf8(pTHX_ SV* sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq)
 #endif
                 );
 #ifndef EBCDIC
-       } else if (useqq && (k <= 10 || k == 12 || k == 13 || k == 27)) {
+       } else if (useqq &&
+           /* we can't use the short form like '\0' if followed by a digit */
+                   ((k >= 7 && k <= 10 || k == 12 || k == 13 || k == 27)
+                 || (k < 8 && (next < '0' || next > '9')))) {
            grow += 2;
-       } else if (useqq && k <= 31) {
+       } else if (useqq && k <= 31 && (next < '0' || next > '9')) {
            grow += 3;
-       } else if (useqq && k >= 127) {
+       } else if (useqq && (k <= 31 || k >= 127)) {
            grow += 4;
 #endif
         } else if (k == '\\') {
@@ -225,7 +235,6 @@ esc_q_utf8(pTHX_ SV* sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq)
         for (s = src; s < send; do_utf8 ? s += UTF8SKIP(s) : s++) {
             const UV k = do_utf8 ? utf8_to_uvchr_buf((U8*)s, (U8*) send, NULL) : *(U8*)s;
 
-
             if (k == '"' || k == '\\' || k == '$' || k == '@') {
                 *r++ = '\\';
                 *r++ = (char)k;
@@ -235,6 +244,8 @@ esc_q_utf8(pTHX_ SV* sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq)
              if (isprint(k) && k < 256)
 #else
              if (useqq && (k <= 31 || k == 127 || (!do_utf8 && k > 127))) {
+               bool next_is_digit;
+
                *r++ = '\\';
                switch (k) {
                case 7:  *r++ = 'a'; break;
@@ -245,12 +256,21 @@ esc_q_utf8(pTHX_ SV* sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq)
                case 13: *r++ = 'r'; break;
                case 27: *r++ = 'e'; break;
                default:
+                   increment = (k == 0 && *s != '\0') ? 1 : UTF8SKIP(s);
+
+                   /* only ASCII digits matter here, which are invariant,
+                    * since we only encode characters \377 and under, or
+                    * \x177 and under for a unicode string
+                    */
+                   next = (s+increment < send) ? *(U8*)(s+increment) : 0;
+                   next_is_digit = next >= '0' && next <= '9';
+
                    /* faster than
                     * r = r + my_sprintf(r, "%o", k);
                     */
-                   if (k <= 7) {
+                   if (k <= 7 && !next_is_digit) {
                        *r++ = (char)k + '0';
-                   } else if (k <= 63) {
+                   } else if (k <= 63 && !next_is_digit) {
                        *r++ = (char)(k>>3) + '0';
                        *r++ = (char)(k&7) + '0';
                    } else {
index 5ae287e..0a3c28c 100644 (file)
@@ -83,11 +83,11 @@ sub SKIP_TEST {
 $Data::Dumper::Useperl = 1;
 if (defined &Data::Dumper::Dumpxs) {
   print "### XS extension loaded, will run XS tests\n";
-  $TMAX = 402; $XS = 1;
+  $TMAX = 420; $XS = 1;
 }
 else {
   print "### XS extensions not loaded, will NOT run XS tests\n";
-  $TMAX = 201; $XS = 0;
+  $TMAX = 210; $XS = 0;
 }
 
 print "1..$TMAX\n";
@@ -1526,3 +1526,33 @@ EOW
   TEST q(Data::Dumper->Dumpxs([\*finkle])), 'blessed overloaded globs (xs)'
     if $XS;
 }
+############# 390
+{
+  # [perl #74798] uncovered behaviour
+  $WANT = <<'EOW';
+#$VAR1 = "\0000";
+EOW
+  local $Data::Dumper::Useqq = 1;
+  TEST q(Data::Dumper->Dump(["\x000"])),
+    "\\ octal followed by digit";
+  TEST q(Data::Dumper->Dumpxs(["\x000"])), '\\ octal followed by digit (xs)'
+    if $XS;
+
+  $WANT = <<'EOW';
+#$VAR1 = "\x{100}\0000";
+EOW
+  local $Data::Dumper::Useqq = 1;
+  TEST q(Data::Dumper->Dump(["\x{100}\x000"])),
+    "\\ octal followed by digit unicode";
+  TEST q(Data::Dumper->Dumpxs(["\x{100}\x000"])), '\\ octal followed by digit unicode (xs)'
+    if $XS;
+
+
+  $WANT = <<'EOW';
+#$VAR1 = "\0\x{660}";
+EOW
+  TEST q(Data::Dumper->Dump(["\\x00\\x{0660}"])),
+    "\\ octal followed by unicode digit";
+  TEST q(Data::Dumper->Dumpxs(["\\x00\\x{0660}"])), '\\ octal followed by unicode digit (xs)'
+    if $XS;
+}