From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Thu, 28 Mar 2002 13:45:48 +0000 (+0000)
Subject: A little bit better error message for \pq, still
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bc45ce41590a23464acf3b62efacccf60e155a7c;p=p5sagit%2Fp5-mst-13.2.git

A little bit better error message for \pq, still
not good because the script context is not shown.

p4raw-id: //depot/perl@15581
---

diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl
index 28e0d70..70bd018 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 3b3a71f..60b67c9 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 2c897cf..82749a0 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 7c16826..85a22a1 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;
 }