summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/utf8_heavy.pl4
-rw-r--r--pod/perldiag.pod4
-rwxr-xr-xt/op/pat.t15
-rw-r--r--utf8.c6
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++;
+}
diff --git a/utf8.c b/utf8.c
index 7c16826979..85a22a1ffd 100644
--- a/utf8.c
+++ b/utf8.c
@@ -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;
}