Deal with "\c{", and its kin

make regen is needed

This patch forbids non-ascii following the "\c".  It also terminates for
"\c{" with a message to contact p5p if there is need for continuing its
current definition.  And if the character following the "\c" causes the
result to not be a control character, a warning is issued.  This is
currently 'deprecated', which by default is turned on.  This can easily
be changed later.

This patch is the initial patch.  It does not do any fancy showing the
context where the problematic construct occurs.  This can be added
later.

It gathers the 3 occurrences of evaluating \c and puts them in one
common routine.

diff --git a/embed.fnc b/embed.fnc
index 08a6e96..60bf9a7 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -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 30971c6..30ce129 100644 (file)
--- 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)

diff --git a/regcomp.c b/regcomp.c
index 56d7e55..a9ebb73 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -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':

diff --git a/t/op/qq.t b/t/op/qq.t
index d883169..b15ec52 100644 (file)
--- a/t/op/qq.t
+++ b/t/op/qq.t
@@ -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 06f9849..8a40a26 100644 (file)
--- 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

diff --git a/toke.c b/toke.c
index 5f3abe8..fa0d939 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -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");

diff --git a/util.c b/util.c
index 89fea23..a1a71df 100644 (file)
--- a/util.c
+++ b/util.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