diff options
| -rw-r--r-- | lib/utf8_heavy.pl | 2 | ||||
| -rw-r--r-- | pod/perldiag.pod | 8 | ||||
| -rw-r--r-- | regcomp.c | 25 | ||||
| -rwxr-xr-x | t/op/pat.t | 7 |
4 files changed, 35 insertions, 7 deletions
diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl index e8cf0cc4ab..e86b727397 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 06434a2a58..9447b4216e 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 @@ -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 f5a2eddced..a3f652230c 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"; +} |