From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sat, 29 Sep 2001 20:05:24 +0000 (+0000)
Subject: More leniency to the \p and \P: now can have whitespace
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ab13f0c73a71a1ea41c4bdcd1f78f8b903cc458c;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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";
+}