diff options
| -rw-r--r-- | dquote_static.c | 41 | ||||
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | global.sym | 2 | ||||
| -rw-r--r-- | proto.h | 6 | ||||
| -rw-r--r-- | util.c | 41 |
6 files changed, 47 insertions, 47 deletions
diff --git a/dquote_static.c b/dquote_static.c index dd58c6bb60..28afd25ae0 100644 --- a/dquote_static.c +++ b/dquote_static.c @@ -36,6 +36,47 @@ S_regcurly(pTHX_ register const char *s) 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; + + May want to add eg, WARN_REGEX +*/ + +STATIC char +S_grok_bslash_c(pTHX_ const char source, const bool output_warning) +{ + + U8 result; + + if (! isASCII(source)) { + Perl_croak(aTHX_ "Character following \"\\c\" must be ASCII"); + } + + result = toCTRL(source); + if (! isCNTRL(result)) { + if (source == '{') { + Perl_croak(aTHX_ "It is proposed that \"\\c{\" no longer be valid. It has historically evaluated to\n \";\". If you disagree with this proposal, send email to perl5-porters@perl.org\nOtherwise, or in the meantime, you can work around this failure by changing\n\"\\c{\" to \";\""); + } + else if (output_warning) { + U8 clearer[3]; + U8 i = 0; + if (! isALNUM(result)) { + clearer[i++] = '\\'; + } + clearer[i++] = result; + clearer[i++] = '\0'; + + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "\"\\c%c\" more clearly written simply as \"%s\"", + source, + clearer); + } + } + + return result; +} + STATIC bool S_grok_bslash_o(pTHX_ const char *s, UV *uv, @@ -656,8 +656,8 @@ Ap |void |vload_module|U32 flags|NN SV* name|NULLOK SV* ver|NULLOK va_list* args 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 #ifdef PERL_IN_DQUOTE_STATIC_C +EXMsR |char |grok_bslash_c |const char source|const bool output_warning 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 @@ -819,7 +819,6 @@ #define _swash_inversion_hash(a) Perl__swash_inversion_hash(aTHX_ a) #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 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) @@ -860,6 +859,7 @@ # endif # endif # if defined(PERL_IN_DQUOTE_STATIC_C) +#define grok_bslash_c(a,b) S_grok_bslash_c(aTHX_ a,b) #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 diff --git a/global.sym b/global.sym index 736087d888..eb7d828ecb 100644 --- a/global.sym +++ b/global.sym @@ -151,7 +151,6 @@ Perl_getcwd_sv Perl_gp_free Perl_gp_ref Perl_grok_bin -Perl_grok_bslash_c Perl_grok_hex Perl_grok_number Perl_grok_numeric_radix @@ -832,6 +831,7 @@ Perl_warn_nocontext Perl_warner_nocontext perl_alloc_using perl_clone_using +Perl_grok_bslash_c Perl_grok_bslash_o Perl_sv_setsv_cow Perl_Slab_Alloc @@ -1082,9 +1082,6 @@ PERL_CALLCONV UV Perl_grok_bin(pTHX_ const char* start, STRLEN* len_p, I32* flag #define PERL_ARGS_ASSERT_GROK_BIN \ assert(start); assert(len_p); assert(flags) -PERL_CALLCONV char Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning) - __attribute__warn_unused_result__; - 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) @@ -5185,6 +5182,9 @@ STATIC I32 S_do_trans_simple_utf8(pTHX_ SV * const sv) #endif #if defined(PERL_IN_DQUOTE_STATIC_C) +STATIC char S_grok_bslash_c(pTHX_ const char source, const bool output_warning) + __attribute__warn_unused_result__; + 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) @@ -3915,47 +3915,6 @@ Perl_report_evil_fh(pTHX_ const GV *gv) } } -/* 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; - - May want to add eg, WARN_REGEX -*/ - -char -Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning) -{ - - U8 result; - - if (! isASCII(source)) { - Perl_croak(aTHX_ "Character following \"\\c\" must be ASCII"); - } - - result = toCTRL(source); - if (! isCNTRL(result)) { - if (source == '{') { - Perl_croak(aTHX_ "It is proposed that \"\\c{\" no longer be valid. It has historically evaluated to\n \";\". If you disagree with this proposal, send email to perl5-porters@perl.org\nOtherwise, or in the meantime, you can work around this failure by changing\n\"\\c{\" to \";\""); - } - else if (output_warning) { - U8 clearer[3]; - U8 i = 0; - if (! isALNUM(result)) { - clearer[i++] = '\\'; - } - clearer[i++] = result; - clearer[i++] = '\0'; - - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), - "\"\\c%c\" more clearly written simply as \"%s\"", - source, - clearer); - } - } - - return result; -} - /* 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 |