This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move grok_blsash_o and make static
[perl5.git] / dquote_static.c
CommitLineData
04e98a4d
AD
1/* dquote_static.c
2 *
3 * This file contains static inline functions that are related to
4 * parsing double-quotish expressions, but are used in more than
5 * one file.
6 *
7 * It is currently #included by regcomp.c and toke.c.
8*/
9
881ffab6
KW
10#define PERL_IN_DQUOTE_STATIC_C
11#include "proto.h"
12#include "embed.h"
13
04e98a4d
AD
14/*
15 - regcurly - a little FSA that accepts {\d+,?\d*}
16 Pulled from regcomp.c.
17 */
04e98a4d 18PERL_STATIC_INLINE I32
93df2d9c 19S_regcurly(pTHX_ register const char *s)
04e98a4d 20{
881ffab6 21 PERL_ARGS_ASSERT_REGCURLY;
04e98a4d
AD
22
23 if (*s++ != '{')
24 return FALSE;
25 if (!isDIGIT(*s))
26 return FALSE;
27 while (isDIGIT(*s))
28 s++;
2ec31dd9 29 if (*s == ',') {
04e98a4d 30 s++;
2ec31dd9
KW
31 while (isDIGIT(*s))
32 s++;
33 }
04e98a4d
AD
34 if (*s != '}')
35 return FALSE;
36 return TRUE;
37}
db30362b
KW
38
39STATIC bool
40S_grok_bslash_o(pTHX_ const char *s,
41 UV *uv,
42 STRLEN *len,
43 const char** error_msg,
44 const bool output_warning)
45{
46
47/* Documentation to be supplied when interface nailed down finally
48 * This returns FALSE if there is an error which the caller need not recover
49 * from; , otherwise TRUE. In either case the caller should look at *len
50 * On input:
51 * s points to a string that begins with 'o', and the previous character
52 * was a backslash.
53 * uv points to a UV that will hold the output value, valid only if the
54 * return from the function is TRUE
55 * len on success will point to the next character in the string past the
56 * end of this construct.
57 * on failure, it will point to the failure
58 * error_msg is a pointer that will be set to an internal buffer giving an
59 * error message upon failure (the return is FALSE). Untouched if
60 * function succeeds
61 * output_warning says whether to output any warning messages, or suppress
62 * them
63 */
64 const char* e;
65 STRLEN numbers_len;
66 I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
67 | PERL_SCAN_DISALLOW_PREFIX
68 /* XXX Until the message is improved in grok_oct, handle errors
69 * ourselves */
70 | PERL_SCAN_SILENT_ILLDIGIT;
71
72 PERL_ARGS_ASSERT_GROK_BSLASH_O;
73
74
75 assert(*s == 'o');
76 s++;
77
78 if (*s != '{') {
79 *len = 1; /* Move past the o */
80 *error_msg = "Missing braces on \\o{}";
81 return FALSE;
82 }
83
84 e = strchr(s, '}');
85 if (!e) {
86 *len = 2; /* Move past the o{ */
87 *error_msg = "Missing right brace on \\o{";
88 return FALSE;
89 }
90
91 /* Return past the '}' no matter what is inside the braces */
92 *len = e - s + 2; /* 2 = 1 for the o + 1 for the '}' */
93
94 s++; /* Point to first digit */
95
96 numbers_len = e - s;
97 if (numbers_len == 0) {
98 *error_msg = "Number with no digits";
99 return FALSE;
100 }
101
102 *uv = NATIVE_TO_UNI(grok_oct(s, &numbers_len, &flags, NULL));
103 /* Note that if has non-octal, will ignore everything starting with that up
104 * to the '}' */
105
106 if (output_warning && numbers_len != (STRLEN) (e - s)) {
107 Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT),
108 /* diag_listed_as: Non-octal character '%c'. Resolved as "%s" */
109 "Non-octal character '%c'. Resolved as \"\\o{%.*s}\"",
110 *(s + numbers_len),
111 (int) numbers_len,
112 s);
113 }
114
115 return TRUE;
116}
117
04e98a4d
AD
118/*
119 * Local variables:
120 * c-indentation-style: bsd
121 * c-basic-offset: 4
122 * indent-tabs-mode: t
123 * End:
124 *
125 * ex: set ts=8 sts=4 sw=4 noet:
126 */