3 * This file contains functions that are related to
4 * parsing double-quotish expressions.
9 #define PERL_IN_DQUOTE_C
11 #include "dquote_inline.h"
13 /* XXX Add documentation after final interface and behavior is decided */
14 /* May want to show context for error, so would pass S_grok_bslash_c(pTHX_ const char* current, const char* start, const bool output_warning)
19 Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning)
24 if (! isPRINT_A(source)) {
25 Perl_croak(aTHX_ "%s",
26 "Character following \"\\c\" must be printable ASCII");
28 else if (source == '{') {
29 const char control = toCTRL('{');
30 if (isPRINT_A(control)) {
31 /* diag_listed_as: Use "%s" instead of "%s" */
32 Perl_croak(aTHX_ "Use \"%c\" instead of \"\\c{\"", control);
35 Perl_croak(aTHX_ "Sequence \"\\c{\" invalid");
39 result = toCTRL(source);
40 if (output_warning && isPRINT_A(result)) {
43 if (! isWORDCHAR(result)) {
46 clearer[i++] = result;
49 Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
50 "\"\\c%c\" is more clearly written simply as \"%s\"",
59 Perl_grok_bslash_o(pTHX_ char **s, UV *uv, const char** error_msg,
60 const bool output_warning, const bool strict,
61 const bool silence_non_portable,
65 /* Documentation to be supplied when interface nailed down finally
66 * This returns FALSE if there is an error which the caller need not recover
67 * from; otherwise TRUE. In either case the caller should look at *len [???].
68 * It guarantees that the returned codepoint, *uv, when expressed as
69 * utf8 bytes, would fit within the skipped "\o{...}" bytes.
71 * s is the address of a pointer to a NULL terminated string that begins
72 * with 'o', and the previous character was a backslash. At exit, *s
73 * will be advanced to the byte just after those absorbed by this
74 * function. Hence the caller can continue parsing from there. In
75 * the case of an error, this routine has generally positioned *s to
76 * point just to the right of the first bad spot, so that a message
77 * that has a "<--" to mark the spot will be correctly positioned.
78 * uv points to a UV that will hold the output value, valid only if the
79 * return from the function is TRUE
80 * error_msg is a pointer that will be set to an internal buffer giving an
81 * error message upon failure (the return is FALSE). Untouched if
83 * output_warning says whether to output any warning messages, or suppress
85 * strict is true if this should fail instead of warn if there are
86 * non-octal digits within the braces
87 * silence_non_portable is true if to suppress warnings about the code
88 * point returned being too large to fit on all platforms.
89 * UTF is true iff the string *s is encoded in UTF-8.
93 I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
94 | PERL_SCAN_DISALLOW_PREFIX
95 /* XXX Until the message is improved in grok_oct, handle errors
97 | PERL_SCAN_SILENT_ILLDIGIT;
100 char *start = *s - 1;
101 assert(*start == '\\');
104 PERL_ARGS_ASSERT_GROK_BSLASH_O;
111 *error_msg = "Missing braces on \\o{}";
117 (*s)++; /* Move past the '{' */
118 while (isOCTAL(**s)) { /* Position beyond the legal digits */
121 *error_msg = "Missing right brace on \\o{";
125 (*s)++; /* Point to expected first digit (could be first byte of utf8
126 sequence if not a digit) */
127 numbers_len = e - *s;
128 if (numbers_len == 0) {
129 (*s)++; /* Move past the } */
130 *error_msg = "Number with no digits";
134 if (silence_non_portable) {
135 flags |= PERL_SCAN_SILENT_NON_PORTABLE;
138 *uv = grok_oct(*s, &numbers_len, &flags, NULL);
139 /* Note that if has non-octal, will ignore everything starting with that up
142 if (numbers_len != (STRLEN) (e - *s)) {
145 *s += (UTF) ? UTF8SKIP(*s) : (STRLEN) 1;
146 *error_msg = "Non-octal character";
149 else if (output_warning) {
150 Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
151 /* diag_listed_as: Non-octal character '%c'. Resolved as "%s" */
152 "Non-octal character '%c'. Resolved as \"\\o{%.*s}\"",
159 /* Return past the '}' */
166 Perl_grok_bslash_x(pTHX_ char **s, UV *uv, const char** error_msg,
167 const bool output_warning, const bool strict,
168 const bool silence_non_portable,
172 /* Documentation to be supplied when interface nailed down finally
173 * This returns FALSE if there is an error which the caller need not recover
174 * from; otherwise TRUE.
175 * It guarantees that the returned codepoint, *uv, when expressed as
176 * utf8 bytes, would fit within the skipped "\x{...}" bytes.
179 * s is the address of a pointer to a NULL terminated string that begins
180 * with 'x', and the previous character was a backslash. At exit, *s
181 * will be advanced to the byte just after those absorbed by this
182 * function. Hence the caller can continue parsing from there. In
183 * the case of an error, this routine has generally positioned *s to
184 * point just to the right of the first bad spot, so that a message
185 * that has a "<--" to mark the spot will be correctly positioned.
186 * uv points to a UV that will hold the output value, valid only if the
187 * return from the function is TRUE
188 * error_msg is a pointer that will be set to an internal buffer giving an
189 * error message upon failure (the return is FALSE). Untouched if
191 * output_warning says whether to output any warning messages, or suppress
193 * strict is true if anything out of the ordinary should cause this to
194 * fail instead of warn or be silent. For example, it requires
195 * exactly 2 digits following the \x (when there are no braces).
196 * 3 digits could be a mistake, so is forbidden in this mode.
197 * silence_non_portable is true if to suppress warnings about the code
198 * point returned being too large to fit on all platforms.
199 * UTF is true iff the string *s is encoded in UTF-8.
203 I32 flags = PERL_SCAN_DISALLOW_PREFIX;
205 char *start = *s - 1;
206 assert(*start == '\\');
209 PERL_ARGS_ASSERT_GROK_BSLASH_X;
214 if (strict || ! output_warning) {
215 flags |= PERL_SCAN_SILENT_ILLDIGIT;
219 STRLEN len = (strict) ? 3 : 2;
221 *uv = grok_hex(*s, &len, &flags, NULL);
223 if (strict && len != 2) {
225 *s += (UTF) ? UTF8SKIP(*s) : 1;
226 *error_msg = "Non-hex character";
229 *error_msg = "Use \\x{...} for more than two hex characters";
238 (*s)++; /* Move past the '{' */
239 while (isXDIGIT(**s)) { /* Position beyond the legal digits */
242 /* XXX The corresponding message above for \o is just '\\o{'; other
243 * messages for other constructs include the '}', so are inconsistent.
245 *error_msg = "Missing right brace on \\x{}";
249 (*s)++; /* Point to expected first digit (could be first byte of utf8
250 sequence if not a digit) */
251 numbers_len = e - *s;
252 if (numbers_len == 0) {
254 (*s)++; /* Move past the } */
255 *error_msg = "Number with no digits";
263 flags |= PERL_SCAN_ALLOW_UNDERSCORES;
264 if (silence_non_portable) {
265 flags |= PERL_SCAN_SILENT_NON_PORTABLE;
268 *uv = grok_hex(*s, &numbers_len, &flags, NULL);
269 /* Note that if has non-hex, will ignore everything starting with that up
272 if (strict && numbers_len != (STRLEN) (e - *s)) {
274 *s += (UTF) ? UTF8SKIP(*s) : 1;
275 *error_msg = "Non-hex character";
279 /* Return past the '}' */
286 * ex: set ts=8 sts=4 sw=4 et: