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;
99 PERL_ARGS_ASSERT_GROK_BSLASH_O;
101 assert(*(*s - 1) == '\\');
106 *error_msg = "Missing braces on \\o{}";
112 (*s)++; /* Move past the '{' */
113 while (isOCTAL(**s)) { /* Position beyond the legal digits */
116 *error_msg = "Missing right brace on \\o{";
120 (*s)++; /* Point to expected first digit (could be first byte of utf8
121 sequence if not a digit) */
122 numbers_len = e - *s;
123 if (numbers_len == 0) {
124 (*s)++; /* Move past the } */
125 *error_msg = "Number with no digits";
129 if (silence_non_portable) {
130 flags |= PERL_SCAN_SILENT_NON_PORTABLE;
133 *uv = grok_oct(*s, &numbers_len, &flags, NULL);
134 /* Note that if has non-octal, will ignore everything starting with that up
137 if (numbers_len != (STRLEN) (e - *s)) {
140 *s += (UTF) ? UTF8SKIP(*s) : (STRLEN) 1;
141 *error_msg = "Non-octal character";
144 else if (output_warning) {
145 Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
146 /* diag_listed_as: Non-octal character '%c'. Resolved as "%s" */
147 "Non-octal character '%c'. Resolved as \"\\o{%.*s}\"",
154 /* Return past the '}' */
161 Perl_grok_bslash_x(pTHX_ char **s, UV *uv, const char** error_msg,
162 const bool output_warning, const bool strict,
163 const bool silence_non_portable,
167 /* Documentation to be supplied when interface nailed down finally
168 * This returns FALSE if there is an error which the caller need not recover
169 * from; otherwise TRUE.
170 * It guarantees that the returned codepoint, *uv, when expressed as
171 * utf8 bytes, would fit within the skipped "\x{...}" bytes.
174 * s is the address of a pointer to a NULL terminated string that begins
175 * with 'x', and the previous character was a backslash. At exit, *s
176 * will be advanced to the byte just after those absorbed by this
177 * function. Hence the caller can continue parsing from there. In
178 * the case of an error, this routine has generally positioned *s to
179 * point just to the right of the first bad spot, so that a message
180 * that has a "<--" to mark the spot will be correctly positioned.
181 * uv points to a UV that will hold the output value, valid only if the
182 * return from the function is TRUE
183 * error_msg is a pointer that will be set to an internal buffer giving an
184 * error message upon failure (the return is FALSE). Untouched if
186 * output_warning says whether to output any warning messages, or suppress
188 * strict is true if anything out of the ordinary should cause this to
189 * fail instead of warn or be silent. For example, it requires
190 * exactly 2 digits following the \x (when there are no braces).
191 * 3 digits could be a mistake, so is forbidden in this mode.
192 * silence_non_portable is true if to suppress warnings about the code
193 * point returned being too large to fit on all platforms.
194 * UTF is true iff the string *s is encoded in UTF-8.
198 I32 flags = PERL_SCAN_DISALLOW_PREFIX;
201 PERL_ARGS_ASSERT_GROK_BSLASH_X;
203 assert(*(*s - 1) == '\\');
207 if (strict || ! output_warning) {
208 flags |= PERL_SCAN_SILENT_ILLDIGIT;
212 STRLEN len = (strict) ? 3 : 2;
214 *uv = grok_hex(*s, &len, &flags, NULL);
216 if (strict && len != 2) {
218 *s += (UTF) ? UTF8SKIP(*s) : 1;
219 *error_msg = "Non-hex character";
222 *error_msg = "Use \\x{...} for more than two hex characters";
231 (*s)++; /* Move past the '{' */
232 while (isXDIGIT(**s)) { /* Position beyond the legal digits */
235 /* XXX The corresponding message above for \o is just '\\o{'; other
236 * messages for other constructs include the '}', so are inconsistent.
238 *error_msg = "Missing right brace on \\x{}";
242 (*s)++; /* Point to expected first digit (could be first byte of utf8
243 sequence if not a digit) */
244 numbers_len = e - *s;
245 if (numbers_len == 0) {
247 (*s)++; /* Move past the } */
248 *error_msg = "Number with no digits";
256 flags |= PERL_SCAN_ALLOW_UNDERSCORES;
257 if (silence_non_portable) {
258 flags |= PERL_SCAN_SILENT_NON_PORTABLE;
261 *uv = grok_hex(*s, &numbers_len, &flags, NULL);
262 /* Note that if has non-hex, will ignore everything starting with that up
265 if (strict && numbers_len != (STRLEN) (e - *s)) {
267 *s += (UTF) ? UTF8SKIP(*s) : 1;
268 *error_msg = "Non-hex character";
272 /* Return past the '}' */
279 * ex: set ts=8 sts=4 sw=4 et: