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 (file)
--- 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 (file)
--- 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 '+':