This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Bump Data::Dumper version
[perl5.git] / dquote.c
index 4c688b6..a9fa29c 100644 (file)
--- a/dquote.c
+++ b/dquote.c
@@ -8,7 +8,6 @@
 #include "EXTERN.h"
 #define PERL_IN_DQUOTE_C
 #include "perl.h"
-#include "dquote_inline.h"
 
 /* XXX Add documentation after final interface and behavior is decided */
 
@@ -268,8 +267,10 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv,
  *          UV_MAX, which is normally illegal, reserved for internal use.
  *     UTF is true iff the string *s is encoded in UTF-8.
  */
-    char* e;
+    char * e;
+    char * rbrace;
     STRLEN numbers_len;
+    STRLEN trailing_blanks_len = 0;
     I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
               | PERL_SCAN_DISALLOW_PREFIX
               | PERL_SCAN_SILENT_NON_PORTABLE
@@ -291,18 +292,35 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv,
        return FALSE;
     }
 
-    e = (char *) memchr(*s, '}', send - *s);
-    if (!e) {
+    rbrace = (char *) memchr(*s, '}', send - *s);
+    if (!rbrace) {
         (*s)++;  /* Move past the '{' */
-        while (isOCTAL(**s)) { /* Position beyond the legal digits */
+
+        /* Position beyond the legal digits and blanks */
+        while (*s < send && isBLANK(**s)) {
             (*s)++;
         }
-        *message = "Missing right brace on \\o{";
+
+        while (*s < send && isOCTAL(**s)) {
+            (*s)++;
+        }
+
+        *message = "Missing right brace on \\o{}";
        return FALSE;
     }
 
-    (*s)++;    /* Point to expected first digit (could be first byte of utf8
-                  sequence if not a digit) */
+    /* Point to expected first digit (could be first byte of utf8 sequence if
+     * not a digit) */
+    (*s)++;
+    while (isBLANK(**s)) {
+        (*s)++;
+    }
+
+    e = rbrace;
+    while (*s < e && isBLANK(*(e - 1))) {
+        e--;
+    }
+
     numbers_len = e - *s;
     if (numbers_len == 0) {
         (*s)++;    /* Move past the '}' */
@@ -315,13 +333,18 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv,
                  || (! allow_UV_MAX && *uv == UV_MAX)))
     {
         *message = form_cp_too_large_msg(8, *s, numbers_len, 0);
-        *s = e + 1;
+        *s = rbrace + 1;
         return FALSE;
     }
 
+    while (isBLANK(**s)) {
+        trailing_blanks_len++;
+        (*s)++;
+    }
+
     /* Note that if has non-octal, will ignore everything starting with that up
      * to the '}' */
-    if (numbers_len != (STRLEN) (e - *s)) {
+    if (numbers_len + trailing_blanks_len != (STRLEN) (e - *s)) {
         *s += numbers_len;
         if (strict) {
             *s += (UTF) ? UTF8_SAFE_SKIP(*s, send) : 1;
@@ -343,7 +366,7 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv,
     }
 
     /* Return past the '}' */
-    *s = e + 1;
+    *s = rbrace + 1;
 
     return TRUE;
 }
@@ -392,7 +415,9 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv,
  *     UTF is true iff the string *s is encoded in UTF-8.
  */
     char* e;
+    char * rbrace;
     STRLEN numbers_len;
+    STRLEN trailing_blanks_len = 0;
     I32 flags = PERL_SCAN_DISALLOW_PREFIX
               | PERL_SCAN_SILENT_ILLDIGIT
               | PERL_SCAN_NOTIFY_ILLDIGIT
@@ -453,21 +478,34 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv,
        return TRUE;
     }
 
-    e = (char *) memchr(*s, '}', send - *s);
-    if (!e) {
+    rbrace = (char *) memchr(*s, '}', send - *s);
+    if (!rbrace) {
         (*s)++;  /* Move past the '{' */
-        while (*s < send && isXDIGIT(**s)) { /* Position beyond legal digits */
+
+        /* Position beyond legal blanks and digits */
+        while (*s < send && isBLANK(**s)) {
             (*s)++;
         }
-        /* XXX The corresponding message above for \o is just '\\o{'; other
-         * messages for other constructs include the '}', so are inconsistent.
-         */
+
+        while (*s < send && isXDIGIT(**s)) {
+            (*s)++;
+        }
+
        *message = "Missing right brace on \\x{}";
        return FALSE;
     }
 
     (*s)++;    /* Point to expected first digit (could be first byte of utf8
                   sequence if not a digit) */
+    while (isBLANK(**s)) {
+        (*s)++;
+    }
+
+    e = rbrace;
+    while (*s < e && isBLANK(*(e - 1))) {
+        e--;
+    }
+
     numbers_len = e - *s;
     if (numbers_len == 0) {
         if (strict) {
@@ -475,7 +513,7 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv,
             *message = "Empty \\x{}";
             return FALSE;
         }
-        *s = e + 1;
+        *s = rbrace + 1;
         *uv = 0;
         return TRUE;
     }
@@ -491,7 +529,12 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv,
         return FALSE;
     }
 
-    if (numbers_len != (STRLEN) (e - *s)) {
+    while (isBLANK(**s)) {
+        trailing_blanks_len++;
+        (*s)++;
+    }
+
+    if (numbers_len + trailing_blanks_len != (STRLEN) (e - *s)) {
         *s += numbers_len;
         if (strict) {
             *s += (UTF) ? UTF8_SAFE_SKIP(*s, send) : 1;
@@ -513,7 +556,7 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv,
     }
 
     /* Return past the '}' */
-    *s = e + 1;
+    *s = rbrace + 1;
 
     return TRUE;
 }