Add support for perl 5.22.0

[perl/modules/re-engine-Hooks.git] / src / 5022000 / orig / dquote_static.c

diff --git a/src/5021003/orig/dquote_static.c b/src/5022000/orig/dquote_static.c
similarity index 89%
rename from src/5021003/orig/dquote_static.c
rename to src/5022000/orig/dquote_static.c
index 802d83bda831716072d85561adff5bd050d27bbc..885ba06ffb630405b467c0be280195564bf8ef68 100644 (file)
--- a/src/5021003/orig/dquote_static.c
+++ b/src/5022000/orig/dquote_static.c
@@ -50,10 +50,14 @@ S_grok_bslash_c(pTHX_ const char source, const bool output_warning)
                         "Character following \"\\c\" must be printable ASCII");
     }
     else if (source == '{') {
                         "Character following \"\\c\" must be printable ASCII");
     }
     else if (source == '{') {

-        assert(isPRINT_A(toCTRL('{')));
-
-        /* diag_listed_as: Use "%s" instead of "%s" */
-        Perl_croak(aTHX_ "Use \"%c\" instead of \"\\c{\"", toCTRL('{'));
+        const char control = toCTRL('{');
+        if (isPRINT_A(control)) {
+            /* diag_listed_as: Use "%s" instead of "%s" */
+            Perl_croak(aTHX_ "Use \"%c\" instead of \"\\c{\"", control);
+        }
+        else {
+            Perl_croak(aTHX_ "Sequence \"\\c{\" invalid");
+        }

     }
 
     result = toCTRL(source);
     }
 
     result = toCTRL(source);


@@ -84,7 +88,9 @@ S_grok_bslash_o(pTHX_ char **s, UV *uv, const char** error_msg,
 
 /*  Documentation to be supplied when interface nailed down finally
  *  This returns FALSE if there is an error which the caller need not recover
 
 /*  Documentation to be supplied when interface nailed down finally
  *  This returns FALSE if there is an error which the caller need not recover

- *  from; , otherwise TRUE.  In either case the caller should look at *len
+ *  from; otherwise TRUE.  In either case the caller should look at *len [???].
+ *  It guarantees that the returned codepoint, *uv, when expressed as
+ *  utf8 bytes, would fit within the skipped "\o{...}" bytes.

  *  On input:
  *     s   is the address of a pointer to a NULL terminated string that begins
  *         with 'o', and the previous character was a backslash.  At exit, *s
  *  On input:
  *     s   is the address of a pointer to a NULL terminated string that begins
  *         with 'o', and the previous character was a backslash.  At exit, *s


@@ -114,6 +120,11 @@ S_grok_bslash_o(pTHX_ char **s, UV *uv, const char** error_msg,
                 * ourselves */
                | PERL_SCAN_SILENT_ILLDIGIT;
 
                 * ourselves */
                | PERL_SCAN_SILENT_ILLDIGIT;
 

+#ifdef DEBUGGING
+    char *start = *s - 1;
+    assert(*start == '\\');
+#endif
+

     PERL_ARGS_ASSERT_GROK_BSLASH_O;
 
 
     PERL_ARGS_ASSERT_GROK_BSLASH_O;
 
 


@@ -172,6 +183,10 @@ S_grok_bslash_o(pTHX_ char **s, UV *uv, const char** error_msg,
     /* Return past the '}' */
     *s = e + 1;
 
     /* Return past the '}' */
     *s = e + 1;
 

+    /* guarantee replacing "\o{...}" with utf8 bytes fits within
+     * existing space */
+    assert(OFFUNISKIP(*uv) < *s - start);
+

     return TRUE;
 }
 
     return TRUE;
 }
 


@@ -184,7 +199,10 @@ S_grok_bslash_x(pTHX_ char **s, UV *uv, const char** error_msg,
 
 /*  Documentation to be supplied when interface nailed down finally
  *  This returns FALSE if there is an error which the caller need not recover
 
 /*  Documentation to be supplied when interface nailed down finally
  *  This returns FALSE if there is an error which the caller need not recover

- *  from; , otherwise TRUE.  In either case the caller should look at *len
+ *  from; otherwise TRUE.
+ *  It guarantees that the returned codepoint, *uv, when expressed as
+ *  utf8 bytes, would fit within the skipped "\x{...}" bytes.
+ *

  *  On input:
  *     s   is the address of a pointer to a NULL terminated string that begins
  *         with 'x', and the previous character was a backslash.  At exit, *s
  *  On input:
  *     s   is the address of a pointer to a NULL terminated string that begins
  *         with 'x', and the previous character was a backslash.  At exit, *s


@@ -211,15 +229,17 @@ S_grok_bslash_x(pTHX_ char **s, UV *uv, const char** error_msg,
     char* e;
     STRLEN numbers_len;
     I32 flags = PERL_SCAN_DISALLOW_PREFIX;
     char* e;
     STRLEN numbers_len;
     I32 flags = PERL_SCAN_DISALLOW_PREFIX;

+#ifdef DEBUGGING
+    char *start = *s - 1;
+    assert(*start == '\\');
+#endif

 
     PERL_ARGS_ASSERT_GROK_BSLASH_X;
 
 
     PERL_ARGS_ASSERT_GROK_BSLASH_X;
 

-    PERL_UNUSED_ARG(output_warning);
-

     assert(**s == 'x');
     (*s)++;
 
     assert(**s == 'x');
     (*s)++;
 

-    if (strict) {
+    if (strict || ! output_warning) {

         flags |= PERL_SCAN_SILENT_ILLDIGIT;
     }
 
         flags |= PERL_SCAN_SILENT_ILLDIGIT;
     }
 


@@ -238,7 +258,7 @@ S_grok_bslash_x(pTHX_ char **s, UV *uv, const char** error_msg,
             }
             return FALSE;
         }
             }
             return FALSE;
         }

-       return TRUE;
+       goto ok;

     }
 
     e = strchr(*s, '}');
     }
 
     e = strchr(*s, '}');


@@ -263,7 +283,9 @@ S_grok_bslash_x(pTHX_ char **s, UV *uv, const char** error_msg,
             *error_msg = "Number with no digits";
             return FALSE;
         }
             *error_msg = "Number with no digits";
             return FALSE;
         }

-        return TRUE;
+        *s = e + 1;
+        *uv = 0;
+        goto ok;

     }
 
     flags |= PERL_SCAN_ALLOW_UNDERSCORES;
     }
 
     flags |= PERL_SCAN_ALLOW_UNDERSCORES;


@@ -285,6 +307,10 @@ S_grok_bslash_x(pTHX_ char **s, UV *uv, const char** error_msg,
     /* Return past the '}' */
     *s = e + 1;
 
     /* Return past the '}' */
     *s = e + 1;
 

+  ok:
+    /* guarantee replacing "\x{...}" with utf8 bytes fits within
+     * existing space */
+    assert(OFFUNISKIP(*uv) < *s - start);

     return TRUE;
 }
 
     return TRUE;
 }
 


@@ -318,11 +344,5 @@ S_form_short_octal_warning(pTHX_
 }
 
 /*
 }
 
 /*

- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *

  * ex: set ts=8 sts=4 sw=4 et:
  */
  * ex: set ts=8 sts=4 sw=4 et:
  */