diff options
| -rw-r--r-- | dquote_static.c | 80 | ||||
| -rw-r--r-- | embed.fnc | 4 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | global.sym | 2 | ||||
| -rw-r--r-- | proto.h | 18 | ||||
| -rw-r--r-- | util.c | 79 |
6 files changed, 94 insertions, 91 deletions
diff --git a/dquote_static.c b/dquote_static.c index 4cc276fd4d..dd58c6bb60 100644 --- a/dquote_static.c +++ b/dquote_static.c @@ -35,6 +35,86 @@ S_regcurly(pTHX_ register const char *s) return FALSE; return TRUE; } + +STATIC bool +S_grok_bslash_o(pTHX_ const char *s, + UV *uv, + STRLEN *len, + const char** error_msg, + const bool output_warning) +{ + +/* 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 + * On input: + * s points to a string that begins with 'o', and the previous character + * was a backslash. + * uv points to a UV that will hold the output value, valid only if the + * return from the function is TRUE + * len on success will point to the next character in the string past the + * end of this construct. + * on failure, it will point to the failure + * error_msg is a pointer that will be set to an internal buffer giving an + * error message upon failure (the return is FALSE). Untouched if + * function succeeds + * output_warning says whether to output any warning messages, or suppress + * them + */ + const char* e; + STRLEN numbers_len; + I32 flags = PERL_SCAN_ALLOW_UNDERSCORES + | PERL_SCAN_DISALLOW_PREFIX + /* XXX Until the message is improved in grok_oct, handle errors + * ourselves */ + | PERL_SCAN_SILENT_ILLDIGIT; + + PERL_ARGS_ASSERT_GROK_BSLASH_O; + + + assert(*s == 'o'); + s++; + + if (*s != '{') { + *len = 1; /* Move past the o */ + *error_msg = "Missing braces on \\o{}"; + return FALSE; + } + + e = strchr(s, '}'); + if (!e) { + *len = 2; /* Move past the o{ */ + *error_msg = "Missing right brace on \\o{"; + return FALSE; + } + + /* Return past the '}' no matter what is inside the braces */ + *len = e - s + 2; /* 2 = 1 for the o + 1 for the '}' */ + + s++; /* Point to first digit */ + + numbers_len = e - s; + if (numbers_len == 0) { + *error_msg = "Number with no digits"; + return FALSE; + } + + *uv = NATIVE_TO_UNI(grok_oct(s, &numbers_len, &flags, NULL)); + /* Note that if has non-octal, will ignore everything starting with that up + * to the '}' */ + + if (output_warning && numbers_len != (STRLEN) (e - s)) { + Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT), + /* diag_listed_as: Non-octal character '%c'. Resolved as "%s" */ + "Non-octal character '%c'. Resolved as \"\\o{%.*s}\"", + *(s + numbers_len), + (int) numbers_len, + s); + } + + return TRUE; +} + /* * Local variables: * c-indentation-style: bsd @@ -657,7 +657,9 @@ p |OP* |localize |NN OP *o|I32 lex ApdR |I32 |looks_like_number|NN SV *const sv Apd |UV |grok_bin |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result EXMpR |char |grok_bslash_c |const char source|const bool output_warning -EXMpR |bool |grok_bslash_o |NN const char* s|NN UV* uv|NN STRLEN* len|NN const char** error_msg|const bool output_warning +#ifdef PERL_IN_DQUOTE_STATIC_C +EXMsR |bool |grok_bslash_o |NN const char* s|NN UV* uv|NN STRLEN* len|NN const char** error_msg|const bool output_warning +#endif Apd |UV |grok_hex |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result Apd |int |grok_number |NN const char *pv|STRLEN len|NULLOK UV *valuep ApdR |bool |grok_numeric_radix|NN const char **sp|NN const char *send @@ -820,7 +820,6 @@ #define _swash_to_invlist(a) Perl__swash_to_invlist(aTHX_ a) #define av_reify(a) Perl_av_reify(aTHX_ a) #define grok_bslash_c(a,b) Perl_grok_bslash_c(aTHX_ a,b) -#define grok_bslash_o(a,b,c,d,e) Perl_grok_bslash_o(aTHX_ a,b,c,d,e) #define is_utf8_X_L(a) Perl_is_utf8_X_L(aTHX_ a) #define is_utf8_X_LV(a) Perl_is_utf8_X_LV(aTHX_ a) #define is_utf8_X_LVT(a) Perl_is_utf8_X_LVT(aTHX_ a) @@ -861,6 +860,7 @@ # endif # endif # if defined(PERL_IN_DQUOTE_STATIC_C) +#define grok_bslash_o(a,b,c,d,e) S_grok_bslash_o(aTHX_ a,b,c,d,e) #define regcurly(a) S_regcurly(aTHX_ a) # endif # if defined(PERL_IN_REGCOMP_C) diff --git a/global.sym b/global.sym index 4a61e55e05..736087d888 100644 --- a/global.sym +++ b/global.sym @@ -152,7 +152,6 @@ Perl_gp_free Perl_gp_ref Perl_grok_bin Perl_grok_bslash_c -Perl_grok_bslash_o Perl_grok_hex Perl_grok_number Perl_grok_numeric_radix @@ -833,6 +832,7 @@ Perl_warn_nocontext Perl_warner_nocontext perl_alloc_using perl_clone_using +Perl_grok_bslash_o Perl_sv_setsv_cow Perl_Slab_Alloc Perl_Slab_Free @@ -1085,15 +1085,6 @@ PERL_CALLCONV UV Perl_grok_bin(pTHX_ const char* start, STRLEN* len_p, I32* flag PERL_CALLCONV char Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning) __attribute__warn_unused_result__; -PERL_CALLCONV bool Perl_grok_bslash_o(pTHX_ const char* s, UV* uv, STRLEN* len, const char** error_msg, const bool output_warning) - __attribute__warn_unused_result__ - __attribute__nonnull__(pTHX_1) - __attribute__nonnull__(pTHX_2) - __attribute__nonnull__(pTHX_3) - __attribute__nonnull__(pTHX_4); -#define PERL_ARGS_ASSERT_GROK_BSLASH_O \ - assert(s); assert(uv); assert(len); assert(error_msg) - PERL_CALLCONV UV Perl_grok_hex(pTHX_ const char* start, STRLEN* len_p, I32* flags, NV *result) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) @@ -5194,6 +5185,15 @@ STATIC I32 S_do_trans_simple_utf8(pTHX_ SV * const sv) #endif #if defined(PERL_IN_DQUOTE_STATIC_C) +STATIC bool S_grok_bslash_o(pTHX_ const char* s, UV* uv, STRLEN* len, const char** error_msg, const bool output_warning) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2) + __attribute__nonnull__(pTHX_3) + __attribute__nonnull__(pTHX_4); +#define PERL_ARGS_ASSERT_GROK_BSLASH_O \ + assert(s); assert(uv); assert(len); assert(error_msg) + PERL_STATIC_INLINE I32 S_regcurly(pTHX_ const char *s) __attribute__warn_unused_result__ __attribute__pure__ @@ -3956,85 +3956,6 @@ Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning) return result; } -bool -Perl_grok_bslash_o(pTHX_ const char *s, - UV *uv, - STRLEN *len, - const char** error_msg, - const bool output_warning) -{ - -/* 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 - * On input: - * s points to a string that begins with 'o', and the previous character - * was a backslash. - * uv points to a UV that will hold the output value, valid only if the - * return from the function is TRUE - * len on success will point to the next character in the string past the - * end of this construct. - * on failure, it will point to the failure - * error_msg is a pointer that will be set to an internal buffer giving an - * error message upon failure (the return is FALSE). Untouched if - * function succeeds - * output_warning says whether to output any warning messages, or suppress - * them - */ - const char* e; - STRLEN numbers_len; - I32 flags = PERL_SCAN_ALLOW_UNDERSCORES - | PERL_SCAN_DISALLOW_PREFIX - /* XXX Until the message is improved in grok_oct, handle errors - * ourselves */ - | PERL_SCAN_SILENT_ILLDIGIT; - - PERL_ARGS_ASSERT_GROK_BSLASH_O; - - - assert(*s == 'o'); - s++; - - if (*s != '{') { - *len = 1; /* Move past the o */ - *error_msg = "Missing braces on \\o{}"; - return FALSE; - } - - e = strchr(s, '}'); - if (!e) { - *len = 2; /* Move past the o{ */ - *error_msg = "Missing right brace on \\o{"; - return FALSE; - } - - /* Return past the '}' no matter what is inside the braces */ - *len = e - s + 2; /* 2 = 1 for the o + 1 for the '}' */ - - s++; /* Point to first digit */ - - numbers_len = e - s; - if (numbers_len == 0) { - *error_msg = "Number with no digits"; - return FALSE; - } - - *uv = NATIVE_TO_UNI(grok_oct(s, &numbers_len, &flags, NULL)); - /* Note that if has non-octal, will ignore everything starting with that up - * to the '}' */ - - if (output_warning && numbers_len != (STRLEN) (e - s)) { - Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT), - /* diag_listed_as: Non-octal character '%c'. Resolved as "%s" */ - "Non-octal character '%c'. Resolved as \"\\o{%.*s}\"", - *(s + numbers_len), - (int) numbers_len, - s); - } - - return TRUE; -} - /* To workaround core dumps from the uninitialised tm_zone we get the * system to give us a reasonable struct to copy. This fix means that * strftime uses the tm_zone and tm_gmtoff values returned by |