diff options
-rw-r--r-- | lib/utf8_heavy.pl | 4 | ||||
-rw-r--r-- | pod/perldiag.pod | 4 | ||||
-rwxr-xr-x | t/op/pat.t | 15 | ||||
-rw-r--r-- | utf8.c | 6 |
4 files changed, 25 insertions, 4 deletions
diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl index 28e0d704d6..70bd018f81 100644 --- a/lib/utf8_heavy.pl +++ b/lib/utf8_heavy.pl @@ -95,7 +95,8 @@ sub SWASHNEW { ## If we reach this line, it's because we couldn't figure ## out what to do with $type. Ouch. ## - croak("Can't find Unicode character property \"$type\""); + + return $type; } print "found it (file='$file')\n" if DEBUG; @@ -161,6 +162,7 @@ sub SWASHNEW { if ($char =~ /[-+!]/) { my ($c,$t) = split(/::/, $name, 2); # bogus use of ::, really my $subobj = $c->SWASHNEW($t, "", 0, 0, 0); + return $subobj unless ref $subobj; push @extras, $name => $subobj; $bits = $subobj->{BITS} if $bits < $subobj->{BITS}; } diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 3b3a71fef4..60b67c9da8 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -683,7 +683,9 @@ editor will have a way to help you find these characters. =item Can't find %s property definition %s (F) You may have tried to use C<\p> which means a Unicode property for -example \p{Lu} is all uppercase letters. Escape the C<\p>, either +example \p{Lu} is all uppercase letters. if you did mean to use a +Unicode property, see L<perlunicode> for the list of known properties. +If you didn't mean to use a Unicode property, escape the C<\p>, either C<\\p> (just the C<\p>) or by C<\Q\p> (the rest of the string, until possible C<\E>). diff --git a/t/op/pat.t b/t/op/pat.t index 2c897cf337..82749a077a 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -6,7 +6,7 @@ $| = 1; -print "1..903\n"; +print "1..908\n"; BEGIN { chdir 't' if -d 't'; @@ -2778,6 +2778,7 @@ print "# some Unicode properties\n"; # This is not really a regex test but regexes bring # out the issue nicely. use strict; + my $test = 893; my $u3 = "f\x{df}\x{100}"; my $u2 = substr($u3,0,2); my $u1 = substr($u2,0,1); @@ -2804,6 +2805,7 @@ print "# some Unicode properties\n"; { print "# qr/.../x\n"; + my $test = 904; my $R = qr/ A B C # D E/x; @@ -2816,3 +2818,14 @@ print "# some Unicode properties\n"; print eval {"ABCDE" =~ m/($R)/} ? "ok $test\n" : "not ok $test\n"; $test++; } + +{ + print "# illegal Unicode properties\n"; + my $test = 907; + + print eval { "a" =~ /\pq / } ? "not ok $test\n" : "ok $test\n"; + $test++; + + print eval { "a" =~ /\p{qrst} / } ? "not ok $test\n" : "ok $test\n"; + $test++; +} @@ -1543,8 +1543,12 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none) Copy(pv, PL_tokenbuf, len+1, char); PL_curcop->op_private = PL_hints; } - if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV) + if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV) { + if (SvPOK(retval)) + Perl_croak(aTHX_ "Can't find Unicode property definition \"%s\"", + SvPV_nolen(retval)); Perl_croak(aTHX_ "SWASHNEW didn't return an HV ref"); + } return retval; } |