Fix \p followed by a non-alpha

See threads beginning at
    http://nntp.perl.org/group/perl.perl5.porters/231263
    http://nntp.perl.org/group/perl.perl5.porters/231389

Prior to this commit, these did not generate the pattern that would be
expected, and displayed apparently irrelevant warnings.  Now this is a
fatal error.

This resolves [perl #126187].  I don't think it's worth a perldelta
entry for this ticket, as the new error message is now in perldelta, and
this never worked properly anyway; it's just now we have a proper error
message.  Patches welcome if you disagree.

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 77cb6a0..ae65866 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -192,7 +192,7 @@ and New Warnings
 
 =item *
 
-XXX L<message|perldiag/"message">
+L<Character following \p must be '{' or a single-character Unicode property name in regex;|perldiag/"Character following \%c must be '{' or a single-character Unicode property name in regex; marked by <-- HERE in m/%s/">
 
 =back
 

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 5e2fbeb..a9a326c 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1484,6 +1484,13 @@ Note that ASCII characters that don't map to control characters are
 discouraged, and will generate the warning (when enabled)
 L</""\c%c" is more clearly written simply as "%s"">.
 
+=item Character following \%c must be '{' or a single-character Unicode property name in regex; marked by <-- HERE in m/%s/
+
+(F) (In the above the C<%c> is replaced by either C<p> or C<P>.)  You
+specified something that isn't a legal Unicode property name.  Most
+Unicode properties are specified by C<\p{...}>.  But if the name is a
+single character one, the braces may be omitted.
+
 =item Character in 'C' format wrapped in pack
 
 (W pack) You said

diff --git a/regcomp.c b/regcomp.c
index a6d5e7f..b95b469 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -14598,18 +14598,44 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
                    vFAIL2("Empty \\%c{}", (U8)value);
                if (*RExC_parse == '{') {
                    const U8 c = (U8)value;
-                   e = strchr(RExC_parse++, '}');
-                    if (!e)
+                   e = strchr(RExC_parse, '}');
+                    if (!e) {
+                        RExC_parse++;
                         vFAIL2("Missing right brace on \\%c{}", c);
-                   while (isSPACE(*RExC_parse))
-                       RExC_parse++;
+                    }
+
+                    RExC_parse++;
+                    while (isSPACE(*RExC_parse)) {
+                         RExC_parse++;
+                   }
+
+                   if (UCHARAT(RExC_parse) == '^') {
+
+                        /* toggle.  (The rhs xor gets the single bit that
+                         * differs between P and p; the other xor inverts just
+                         * that bit) */
+                        value ^= 'P' ^ 'p';
+
+                        RExC_parse++;
+                        while (isSPACE(*RExC_parse)) {
+                            RExC_parse++;
+                        }
+                    }
+
                     if (e == RExC_parse)
                         vFAIL2("Empty \\%c{}", c);
+
                    n = e - RExC_parse;
                    while (isSPACE(*(RExC_parse + n - 1)))
                        n--;
-               }
-               else {
+               }   /* The \p isn't immediately followed by a '{' */
+               else if (! isALPHA(*RExC_parse)) {
+                    RExC_parse += (UTF) ? UTF8SKIP(RExC_parse) : 1;
+                    vFAIL2("Character following \\%c must be '{' or a "
+                           "single-character Unicode property name",
+                           (U8) value);
+                }
+                else {
                    e = RExC_parse;
                    n = 1;
                }
@@ -14617,19 +14643,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
                     SV* invlist;
                     char* name;
 
-                   if (UCHARAT(RExC_parse) == '^') {
-                        RExC_parse++;
-                        n--;
-                         /* toggle.  (The rhs xor gets the single bit that
-                          * differs between P and p; the other xor inverts just
-                          * that bit) */
-                         value ^= 'P' ^ 'p';
-
-                        while (isSPACE(*RExC_parse)) {
-                             RExC_parse++;
-                             n--;
-                        }
-                   }
                     /* Try to get the definition of the property into
                      * <invlist>.  If /i is in effect, the effective property
                      * will have its name be <__NAME_i>.  The design is

diff --git a/t/re/re_tests b/t/re/re_tests
index d777992..0dba249 100644 (file)
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -1939,6 +1939,10 @@ A(*FAIL:foo)[BC] A       n       $::REGERROR     foo
 
 \N(?#comment){SPACE}   A       c       -       Missing braces on \N{}
 ab(?#Comment){2}c      abbc    y       $&      abbc
+\p A   A       c       -       Character following \\p must be '{' or a single-character Unicode property name         # [perl #126187
+\P:A   A       c       -       Character following \\P must be '{' or a single-character Unicode property name
+\p^    A       c       -       Character following \\p must be '{' or a single-character Unicode property name
+\PU    A       c       -       Can't find Unicode property definition \"U\"
 
 # Keep these lines at the end of the file
 # vim: softtabstop=0 noexpandtab