"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);
/* 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
* ourselves */
| PERL_SCAN_SILENT_ILLDIGIT;
+#ifdef DEBUGGING
+ char *start = *s - 1;
+ assert(*start == '\\');
+#endif
+
PERL_ARGS_ASSERT_GROK_BSLASH_O;
/* Return past the '}' */
*s = e + 1;
+ /* guarantee replacing "\o{...}" with utf8 bytes fits within
+ * existing space */
+ assert(OFFUNISKIP(*uv) < *s - start);
+
return TRUE;
}
/* 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
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;
}
}
return FALSE;
}
- return TRUE;
+ goto ok;
}
e = strchr(*s, '}');
*error_msg = "Number with no digits";
return FALSE;
}
- return TRUE;
+ *s = e + 1;
+ *uv = 0;
+ goto ok;
}
flags |= PERL_SCAN_ALLOW_UNDERSCORES;
/* Return past the '}' */
*s = e + 1;
+ ok:
+ /* guarantee replacing "\x{...}" with utf8 bytes fits within
+ * existing space */
+ assert(OFFUNISKIP(*uv) < *s - start);
return TRUE;
}
}
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
* ex: set ts=8 sts=4 sw=4 et:
*/