More leniency to the \p and \P: now can have whitespace

between the property definition and the curlies; now can
invert the property by having a caret between the open
curly and the property.

p4raw-id: //depot/perl@12269

diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl
index e8cf0cc..e86b727 100644 (file)
--- a/lib/utf8_heavy.pl
+++ b/lib/utf8_heavy.pl
@@ -26,7 +26,7 @@ sub SWASHNEW {
     while (($caller = caller($i)) eq __PACKAGE__) { $i++ }
     my $encoding = $enc{$caller} || "unicore";
     (my $file = $type) =~ s!::!/!g;
-    if ($file =~ /^In[- ]?(.+)/i) {
+    if ($file =~ /^In[- _]?(.+?)$/i) {
        my $In = $1;
        defined %utf8::In || do "$encoding/In.pl";
        my $prefix = substr(lc($In), 0, 3);

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 06434a2..9447b42 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1294,6 +1294,10 @@ Your code will be interpreted as an attempt to call a method named
 "elseif" for the class returned by the following block.  This is
 unlikely to be what you want.
 
+=item Empty %s
+
+(F) Empty C<\p{}> or C<\P{}>.
+
 =item entering effective %s failed
 
 (F) While under the C<use filetest> pragma, switching the real and
@@ -1940,6 +1944,10 @@ can vary from one line to the next.
 (S) This is an educated guess made in conjunction with the message "%s
 found where operator expected".  Often the missing operator is a comma.
 
+=item Missing right brace on %s
+
+(F) Missing right brace in C<\p{...}> or C<\P{...}>.
+
 =item Missing right curly or square bracket
 
 (F) The lexer counted more opening curly or square brackets than closing

diff --git a/regcomp.c b/regcomp.c
index 4455730..dda273d 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -3423,20 +3423,35 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
                if (*RExC_parse == '{') {
                    e = strchr(RExC_parse++, '}');
                     if (!e)
-                        vFAIL("Missing right brace on \\p{}");
+                        vFAIL2("Missing right brace on \\%c{}", value);
+                   while (isSPACE(UCHARAT(RExC_parse)))
+                       RExC_parse++;
+                    if (e == RExC_parse)
+                        vFAIL2("Empty \\%c{}", value);
                    n = e - RExC_parse;
+                   while (isSPACE(UCHARAT(RExC_parse + n - 1)))
+                       n--;
                }
                else {
                    e = RExC_parse;
                    n = 1;
                }
                if (!SIZE_ONLY) {
+                   if (UCHARAT(RExC_parse) == '^') {
+                        RExC_parse++;
+                        n--;
+                        value = value == 'p' ? 'P' : 'p'; /* toggle */
+                        while (isSPACE(UCHARAT(RExC_parse))) {
+                             RExC_parse++;
+                             n--;
+                        }
+                   }
                    if (value == 'p')
-                       Perl_sv_catpvf(aTHX_ listsv,
-                                      "+utf8::%.*s\n", (int)n, RExC_parse);
+                        Perl_sv_catpvf(aTHX_ listsv,
+                                       "+utf8::%.*s\n", (int)n, RExC_parse);
                    else
-                       Perl_sv_catpvf(aTHX_ listsv,
-                                      "!utf8::%.*s\n", (int)n, RExC_parse);
+                        Perl_sv_catpvf(aTHX_ listsv,
+                                       "!utf8::%.*s\n", (int)n, RExC_parse);
                }
                RExC_parse = e + 1;
                ANYOF_FLAGS(ret) |= ANYOF_UNICODE;

diff --git a/t/op/pat.t b/t/op/pat.t
index f5a2edd..a3f6522 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..716\n";
+print "1..717\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -2131,3 +2131,8 @@ sub ok ($$) {
     print "not " unless "\x80" =~ /\p{in-latin1_SUPPLEMENT}/;
     print "ok 716\n";
 }
+
+{
+    print "not " unless "\x80" =~ /\P{  ^  In Latin 1 Supplement  }/;
+    print "ok 717\n";
+}