diff options
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | pod/perldiag.pod | 10 | ||||
| -rw-r--r-- | regcomp.c | 6 | ||||
| -rw-r--r-- | t/op/qq.t | 20 | ||||
| -rw-r--r-- | t/porting/diag.t | 1 | ||||
| -rw-r--r-- | toke.c | 7 | ||||
| -rw-r--r-- | util.c | 33 |
7 files changed, 67 insertions, 11 deletions
@@ -628,6 +628,7 @@ 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 +EXpR |char |grok_bslash_c |const char source|const bool output_warning 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 diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 30971c6442..30ce129e4c 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1211,6 +1211,10 @@ references can be weakened. with an assignment operator, which implies modifying the value itself. Perhaps you need to copy the value to a temporary, and repeat that. +=item Character following "\\c" must be ASCII + +(F) In C<\cI<X>>, I<X> must be an ASCII character. + =item Character in 'C' format wrapped in pack (W pack) You said @@ -1419,6 +1423,12 @@ valid magic number. you have also specified an explicit size for the string. See L<perlfunc/pack>. +=item \\c%c" more clearly written simply as "%c + +(D deprecated) The C<\cI<X>> construct is intended to be a way to specify +non-printable characters. You used it for a printable one, which is better +written as simply itself. + =item Deep recursion on subroutine "%s" (W recursion) This subroutine has called itself (directly or indirectly) @@ -7445,8 +7445,7 @@ tryagain: break; case 'c': p++; - ender = UCHARAT(p++); - ender = toCTRL(ender); + ender = grok_bslash_c(*p++, SIZE_ONLY); break; case '0': case '1': case '2': case '3':case '4': case '5': case '6': case '7': case '8':case '9': @@ -8063,8 +8062,7 @@ parseit: goto recode_encoding; break; case 'c': - value = UCHARAT(RExC_parse++); - value = toCTRL(value); + value = grok_bslash_c(*RExC_parse++, SIZE_ONLY); break; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; } -print q(1..21 +print q(1..23 ); # This is() function is written to avoid "" @@ -61,3 +61,21 @@ is ("\x{000000000000000000000000000000000000000000000000000000000000000072}", is ("\x{0_06_5}", chr 101); is ("\x{1234}", chr 4660); is ("\x{10FFFD}", chr 1114109); + +# These kludged tests should change when we remove the temporary fatal error +# in util.c for "\c{" +# BE SURE TO remove the message from the __DATA__ section of porting/diag.t, +# and to verify the messages in util.c are adequately covered in perldiag.pod +my $value = eval '"\c{ACK}"'; +if ($^V lt v5.13.0 || $^V ge v5.14.0) { + is ($@, ""); + is ($value, ";ACK}"); +} +elsif ($@ ne "") { # 5.13 series, should fail + is ("1", "1"); # This .t only has 'is' at its disposal + is ("1", "1"); +} +else { # Something wrong; someone has removed the failure in util.c + is ("Should fail for 5.13 until fix test", "0"); + is ("1", "1"); +} diff --git a/t/porting/diag.t b/t/porting/diag.t index 06f9849c57..8a40a264af 100644 --- a/t/porting/diag.t +++ b/t/porting/diag.t @@ -282,6 +282,7 @@ Invalid strict version format (1.[0-9] required) Invalid version format (alpha without decimal) Invalid version format (misplaced _ in number) Invalid version object +It is proposed that "\\c{" no longer be valid. It has historically evaluated to ";". If you disagree with this proposal, send email to perl5-porters@perl.org Otherwise, or in the meantime, you can work around this failure by changing "\\c{" to ";" 'j' not supported on this platform 'J' not supported on this platform Layer does not match this perl @@ -3283,12 +3283,7 @@ S_scan_const(pTHX_ char *start) case 'c': s++; if (s < send) { - U8 c = *s++; -#ifdef EBCDIC - if (isLOWER(c)) - c = toUPPER(c); -#endif - *d++ = NATIVE_TO_NEED(has_utf8,toCTRL(c)); + *d++ = grok_bslash_c(*s++, 1); } else { yyerror("Missing control char name in \\c"); @@ -3683,6 +3683,39 @@ Perl_ebcdic_control(pTHX_ int ch) } #endif +/* 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) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "\"\\c%c\" more clearly written simply as \"%c\"", + source, + result); + } + } + + 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 |