Add support for perl 5.22.0

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

diff --git a/src/5021004/dquote_static.c b/src/5022000/dquote_static.c
similarity index 88%
rename from src/5021004/dquote_static.c
rename to src/5022000/dquote_static.c
index dd47f14fdc592214b144aeaf1aecb2e9d46af9fa..95c2a56ca14662f845ffb90914ba80dccf972ec5 100644 (file)
--- a/src/5021004/dquote_static.c
+++ b/src/5022000/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 == '{') {
-  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);
@@ -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
- *  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
@@ -114,6 +120,11 @@ S_grok_bslash_o(pTHX_ char **s, UV *uv, const char** error_msg,
     * ourselves */
     | PERL_SCAN_SILENT_ILLDIGIT;
 
+#ifdef DEBUGGING
+ char *start = *s - 1;
+ assert(*start == '\\');
+#endif
+
  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;
 
+ /* guarantee replacing "\o{...}" with utf8 bytes fits within
+ * existing space */
+ assert(OFFUNISKIP(*uv) < *s - start);
+
  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
- *  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
@@ -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;
+#ifdef DEBUGGING
+ char *start = *s - 1;
+ assert(*start == '\\');
+#endif
 
  PERL_ARGS_ASSERT_GROK_BSLASH_X;
 
- PERL_UNUSED_ARG(output_warning);
-
  assert(**s == 'x');
  (*s)++;
 
- if (strict) {
+ if (strict || ! output_warning) {
   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 TRUE;
+  goto ok;
  }
 
  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;
   }
-  return TRUE;
+  *s = e + 1;
+  *uv = 0;
+  goto ok;
  }
 
  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;
 
+  ok:
+ /* guarantee replacing "\x{...}" with utf8 bytes fits within
+ * existing space */
+ assert(OFFUNISKIP(*uv) < *s - start);
  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:
  */