X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fre-engine-Hooks.git;a=blobdiff_plain;f=src%2F5016001%2Fdquote_static.c;fp=src%2F5016001%2Fdquote_static.c;h=b744d73113227f79fcb49c95fec62ec05b37a5de;hp=e23ec4623a9cfc31d4fa9900648df5c8a4a41bce;hb=3844497d56f979a0275bf10b2a322c9e9baab2bf;hpb=7a8e4ba50dd698a702ecce6a8c9c4d793fa690ac diff --git a/src/5016001/dquote_static.c b/src/5016001/dquote_static.c index e23ec46..b744d73 100644 --- a/src/5016001/dquote_static.c +++ b/src/5016001/dquote_static.c @@ -13,155 +13,155 @@ /* - regcurly - a little FSA that accepts {\d+,?\d*} - Pulled from regcomp.c. + Pulled from regcomp.c. */ PERL_STATIC_INLINE I32 S_regcurly(pTHX_ register const char *s) { - PERL_ARGS_ASSERT_REGCURLY; - - if (*s++ != '{') - return FALSE; - if (!isDIGIT(*s)) - return FALSE; - while (isDIGIT(*s)) - s++; - if (*s == ',') { - s++; - while (isDIGIT(*s)) - s++; - } - if (*s != '}') - return FALSE; - return TRUE; + PERL_ARGS_ASSERT_REGCURLY; + + if (*s++ != '{') + return FALSE; + if (!isDIGIT(*s)) + return FALSE; + while (isDIGIT(*s)) + s++; + if (*s == ',') { + s++; + while (isDIGIT(*s)) + s++; + } + if (*s != '}') + return FALSE; + return TRUE; } /* XXX Add documentation after final interface and behavior is decided */ /* May want to show context for error, so would pass Perl_bslash_c(pTHX_ const char* current, const char* start, const bool output_warning) - U8 source = *current; + U8 source = *current; */ STATIC char S_grok_bslash_c(pTHX_ const char source, const bool utf8, const bool output_warning) { - U8 result; - - if (utf8) { - /* Trying to deprecate non-ASCII usages. This construct has never - * worked for a utf8 variant. So, even though are accepting non-ASCII - * Latin1 in 5.14, no need to make them work under utf8 */ - if (! isASCII(source)) { - Perl_croak(aTHX_ "Character following \"\\c\" must be ASCII"); - } - } - - result = toCTRL(source); - if (! isASCII(source)) { - Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "Character following \"\\c\" must be ASCII"); - } - else if (! isCNTRL(result) && output_warning) { - if (source == '{') { - Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "\"\\c{\" is deprecated and is more clearly written as \";\""); - } - else { - U8 clearer[3]; - U8 i = 0; - if (! isALNUM(result)) { - clearer[i++] = '\\'; - } - clearer[i++] = result; - clearer[i++] = '\0'; - - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "\"\\c%c\" is more clearly written simply as \"%s\"", - source, - clearer); - } - } - - return result; + U8 result; + + if (utf8) { + /* Trying to deprecate non-ASCII usages. This construct has never + * worked for a utf8 variant. So, even though are accepting non-ASCII + * Latin1 in 5.14, no need to make them work under utf8 */ + if (! isASCII(source)) { + Perl_croak(aTHX_ "Character following \"\\c\" must be ASCII"); + } + } + + result = toCTRL(source); + if (! isASCII(source)) { + Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), + "Character following \"\\c\" must be ASCII"); + } + else if (! isCNTRL(result) && output_warning) { + if (source == '{') { + Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), + "\"\\c{\" is deprecated and is more clearly written as \";\""); + } + else { + U8 clearer[3]; + U8 i = 0; + if (! isALNUM(result)) { + clearer[i++] = '\\'; + } + clearer[i++] = result; + clearer[i++] = '\0'; + + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "\"\\c%c\" is more clearly written simply as \"%s\"", + source, + clearer); + } + } + + return result; } STATIC bool S_grok_bslash_o(pTHX_ const char *s, - UV *uv, - STRLEN *len, - const char** error_msg, - const bool output_warning) + 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 + * 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 + * 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; + 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; } /*