Pulled from regcomp.c.
*/
PERL_STATIC_INLINE I32
-S_regcurly(pTHX_ const char *s)
+S_regcurly(pTHX_ const char *s,
+ const bool rbrace_must_be_escaped /* Should the terminating '} be
+ preceded by a backslash? This
+ is an abnormal case */
+ )
{
PERL_ARGS_ASSERT_REGCURLY;
while (isDIGIT(*s))
s++;
}
- if (*s != '}')
- return FALSE;
- return TRUE;
+
+ return (rbrace_must_be_escaped)
+ ? *s == '\\' && *(s+1) == '}'
+ : *s == '}';
}
/* XXX Add documentation after final interface and behavior is decided */
return TRUE;
}
+STATIC char*
+S_form_short_octal_warning(pTHX_
+ const char * const s, /* Points to first non-octal */
+ const STRLEN len /* Length of octals string, so
+ (s-len) points to first
+ octal */
+) {
+ /* Return a character string consisting of a warning message for when a
+ * string constant in octal is weird, like "\078". */
+
+ const char * sans_leading_zeros = s - len;
+
+ PERL_ARGS_ASSERT_FORM_SHORT_OCTAL_WARNING;
+
+ assert(*s == '8' || *s == '9');
+
+ /* Remove the leading zeros, retaining one zero so won't be zero length */
+ while (*sans_leading_zeros == '0') sans_leading_zeros++;
+ if (sans_leading_zeros == s) {
+ sans_leading_zeros--;
+ }
+
+ return Perl_form(aTHX_
+ "'%.*s' resolved to '\\o{%.*s}%c'",
+ (int) (len + 2), s - len - 1,
+ (int) (s - sans_leading_zeros), sans_leading_zeros,
+ *s);
+}
+
/*
* Local variables:
* c-indentation-style: bsd