new perldelta

[perl5.git] / dquote.c

diff --git a/dquote.c b/dquote.c
index 4c688b6..e2c03f6 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 */
 
@@ -47,7 +46,7 @@ Perl_grok_bslash_c(pTHX_ const char   source,
         const char control = toCTRL('{');
         if (isPRINT_A(control)) {
             /* diag_listed_as: Use "%s" instead of "%s" */
-            *message = Perl_form(aTHX_ "Use \"%c\" instead of \"\\c{\"", control);
+            *message = Perl_form(aTHX_ PERL_DIAG_DIE_SYNTAX("Use \"%c\" instead of \"\\c{\""), control);
         }
         else {
             *message = "Sequence \"\\c{\" invalid";
@@ -59,7 +58,7 @@ Perl_grok_bslash_c(pTHX_ const char   source,
     if (isPRINT_A(*result) && ckWARN(WARN_SYNTAX)) {
         U8 clearer[3];
         U8 i = 0;
-        char format[] = "\"\\c%c\" is more clearly written simply as \"%s\"";
+        char format[] = PERL_DIAG_WARN_SYNTAX("\"\\c%c\" is more clearly written simply as \"%s\"");
 
         if (! isWORDCHAR(*result)) {
             clearer[i++] = '\\';
@@ -118,7 +117,7 @@ Perl_form_alien_digit_msg(pTHX_
 
         /* It also isn't a UTF-8 invariant character, so no display shortcuts
          * are available.  Use \\x{...} */
-       Perl_sv_setpvf(aTHX_ display_char, "\\x{%02x}", *first_bad);
+        Perl_sv_setpvf(aTHX_ display_char, "\\x{%02x}", *first_bad);
     }
 
     /* Ready to start building the message */
@@ -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
@@ -287,27 +288,44 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv,
     (*s)++;
 
     if (send <= *s || **s != '{') {
-       *message = "Missing braces on \\o{}";
-       return FALSE;
+        *message = "Missing braces on \\o{}";
+        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{";
-       return FALSE;
+
+        while (*s < send && isOCTAL(**s)) {
+            (*s)++;
+        }
+
+        *message = "Missing right brace on \\o{}";
+        return FALSE;
+    }
+
+    /* 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--;
     }
 
-    (*s)++;    /* Point to expected first digit (could be first byte of utf8
-                  sequence if not a digit) */
     numbers_len = e - *s;
     if (numbers_len == 0) {
         (*s)++;    /* Move past the '}' */
-       *message = "Empty \\o{}";
-       return FALSE;
+        *message = "Empty \\o{}";
+        return FALSE;
     }
 
     *uv = grok_oct(*s, &numbers_len, &flags, NULL);
@@ -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
@@ -424,8 +449,8 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv,
     if (**s != '{') {
         numbers_len = (strict) ? 3 : 2;
 
-       *uv = grok_hex(*s, &numbers_len, &flags, NULL);
-       *s += numbers_len;
+        *uv = grok_hex(*s, &numbers_len, &flags, NULL);
+        *s += numbers_len;
 
         if (numbers_len != 2 && (strict || (flags & PERL_SCAN_NOTIFY_ILLDIGIT))) {
             if (numbers_len == 3) { /* numbers_len 3 only happens with strict */
@@ -450,24 +475,37 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv,
                 }
             }
         }
-       return TRUE;
+        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.
-         */
-       *message = "Missing right brace on \\x{}";
-       return FALSE;
+
+        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;
 }