From: SADAHIRO Tomoyuki <BQW10602@nifty.com>
Date: Sun, 4 Dec 2005 16:24:59 +0000 (+0900)
Subject: Rework the error messages from the swashget code.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=660a461690361c615b3b45ef731dd3d6f0d55d01;p=p5sagit%2Fp5-mst-13.2.git

Rework the error messages from the swashget code.

Subject: Re: XS-assisted SWASHGET (esp. for t/uni/class.t speedup)
Message-Id: <20051204162431.D723.BQW10602@nifty.com>

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

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 6e5207f..148d994 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -695,15 +695,6 @@ found in the PATH.
 found in the PATH, or at least not with the correct permissions.  The
 script exists in the current directory, but PATH prohibits running it.
 
-=item Can't find %s property definition %s
-
-(F) You may have tried to use C<\p> which means a Unicode property (for
-example C<\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
-by C<\\p> (just the C<\p>) or by C<\Q\p> (the rest of the string, until
-possible C<\E>).
-
 =item Can't find string terminator %s anywhere before EOF
 
 (F) Perl strings can stretch over multiple lines.  This message means
@@ -716,6 +707,15 @@ If you're getting this error from a here-document, you may have included
 unseen whitespace before or after your closing tag. A good programmer's
 editor will have a way to help you find these characters.
 
+=item Can't find Unicode property definition "%s"
+
+(F) You may have tried to use C<\p> which means a Unicode property (for
+example C<\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
+by C<\\p> (just the C<\p>) or by C<\Q\p> (the rest of the string, until
+possible C<\E>).
+
 =item Can't fork
 
 (F) A fatal error occurred while trying to fork while opening a
diff --git a/utf8.c b/utf8.c
index 8c9992f..bb8a67c 100644
--- a/utf8.c
+++ b/utf8.c
@@ -1708,7 +1708,7 @@ Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8)
 
 	    if (!svp || !(tmps = (U8*)SvPV(*svp, slen))
 		     || (slen << 3) < needents)
-		Perl_croak(aTHX_ "The swatch does not have proper length");
+		Perl_croak(aTHX_ "panic: swash_fetch got improper swatch");
 	}
 
 	PL_last_swash_hv = hv;
@@ -1734,7 +1734,7 @@ Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8)
 	off <<= 2;
 	return (tmps[off] << 24) + (tmps[off+1] << 16) + (tmps[off+2] << 8) + tmps[off + 3] ;
     }
-    Perl_croak(aTHX_ "panic: swash_fetch");
+    Perl_croak(aTHX_ "panic: swash_fetch got swatch of unexpected bit width");
     return 0;
 }
 
@@ -1765,7 +1765,8 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
     UV     end   = start + span;
 
     if (bits != 1 && bits != 8 && bits != 16 && bits != 32) {
-	Perl_croak(aTHX_ "swash_get: unknown bits %"UVuf, (UV) bits);
+	Perl_croak(aTHX_ "panic: swash_get doesn't expect bits %"UVuf,
+						 (UV)bits);
     }
 
     /* create and initialize $swatch */
@@ -1957,28 +1958,23 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
 	}
 
 	othersvp = hv_fetch(hv, (char *)namestr, namelen, FALSE);
-	if (*othersvp && SvROK(*othersvp) &&
-			 SvTYPE(SvRV(*othersvp))==SVt_PVHV)
-	    otherhv = (HV*)SvRV(*othersvp);
-	else
-	    Perl_croak(aTHX_ "otherhv is not a hash reference");
-
+	otherhv = (HV*)SvRV(*othersvp);
 	otherbitssvp = hv_fetch(otherhv, "BITS", 4, FALSE);
 	otherbits = (STRLEN)SvUV(*otherbitssvp);
 	if (bits < otherbits)
-	    Perl_croak(aTHX_ "swash_get: swatch size mismatch");
+	    Perl_croak(aTHX_ "panic: swash_get found swatch size mismatch");
 
 	/* The "other" swatch must be destroyed after. */
 	other = swash_get(*othersvp, start, span);
 	o = (U8*)SvPV(other, olen);
 
 	if (!olen)
-	    Perl_croak(aTHX_ "swash_get didn't return valid swatch for other");
+	    Perl_croak(aTHX_ "panic: swash_get got improper swatch");
 
 	s = (U8*)SvPV(swatch, slen);
 	if (bits == 1 && otherbits == 1) {
 	    if (slen != olen)
-		Perl_croak(aTHX_ "swash_get: swatch length mismatch");
+		Perl_croak(aTHX_ "panic: swash_get found swatch length mismatch");
 
 	    switch (opc) {
 	    case '+':