X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utf8.c;h=b43c74ba108764869d1b814421f02bf165936823;hb=1a6108908b085da4d14ad0cdf8549f193a6fb877;hp=b62e552aac32dd10d3a8523f92e3ed3240120fce;hpb=35da51f7f2e09d38719c2d96d9f3eacd4f9f796a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/utf8.c b/utf8.c
index b62e552..b43c74b 100644
--- a/utf8.c
+++ b/utf8.c
@@ -1,6 +1,6 @@
 /*    utf8.c
  *
- *    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+ *    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
  *    by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
@@ -25,6 +25,13 @@
 #define PERL_IN_UTF8_C
 #include "perl.h"
 
+#ifndef EBCDIC
+/* Separate prototypes needed because in ASCII systems these
+ * usually macros but they still are compiled as code, too. */
+PERL_CALLCONV UV	Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags);
+PERL_CALLCONV U8*	Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv);
+#endif
+
 static const char unees[] =
     "Malformed UTF-8 character (unexpected end of string)";
 
@@ -524,7 +531,7 @@ malformed:
 
     if (flags & UTF8_CHECK_ONLY) {
 	if (retlen)
-	    *retlen = -1;
+	    *retlen = ((STRLEN) -1);
 	return 0;
     }
 
@@ -653,6 +660,7 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
 {
     dVAR;
     STRLEN len = 0;
+    U8 t = 0;
 
     /* Note: cannot use UTF8_IS_...() too eagerly here since e.g.
      * the bitops (especially ~) can create illegal UTF-8.
@@ -661,7 +669,7 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
     if (e < s)
 	goto warn_and_return;
     while (s < e) {
-	const U8 t = UTF8SKIP(s);
+	t = UTF8SKIP(s);
 	if (e - s < t) {
 	    warn_and_return:
 	    if (ckWARN_d(WARN_UTF8)) {
@@ -760,7 +768,7 @@ Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN *len)
         if (!UTF8_IS_INVARIANT(c) &&
             (!UTF8_IS_DOWNGRADEABLE_START(c) || (s >= send)
 	     || !(c = *s++) || !UTF8_IS_CONTINUATION(c))) {
-            *len = -1;
+            *len = ((STRLEN) -1);
             return 0;
         }
     }
@@ -888,7 +896,7 @@ Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
     }
 
     if (bytelen & 1)
-	Perl_croak(aTHX_ "panic: utf16_to_utf8: odd bytelen %"UVf, (UV)bytelen);
+	Perl_croak(aTHX_ "panic: utf16_to_utf8: odd bytelen %"UVuf, (UV)bytelen);
 
     pend = p + bytelen;
 
@@ -896,7 +904,11 @@ Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
 	UV uv = (p[0] << 8) + p[1]; /* UTF-16BE */
 	p += 2;
 	if (uv < 0x80) {
+#ifdef EBCDIC
+	    *d++ = UNI_TO_NATIVE(uv);
+#else
 	    *d++ = (U8)uv;
+#endif
 	    continue;
 	}
 	if (uv < 0x800) {
@@ -1548,7 +1560,7 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
     dSP;
     const size_t pkg_len = strlen(pkg);
     const size_t name_len = strlen(name);
-    HV * const stash = gv_stashpvn(pkg, pkg_len, FALSE);
+    HV * const stash = gv_stashpvn(pkg, pkg_len, 0);
     SV* errsv_save;
 
     PUSHSTACKi(PERLSI_MAGIC);
@@ -1608,7 +1620,7 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
     if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV) {
         if (SvPOK(retval))
 	    Perl_croak(aTHX_ "Can't find Unicode property definition \"%"SVf"\"",
-		       (void*)retval);
+		       SVfARG(retval));
 	Perl_croak(aTHX_ "SWASHNEW didn't return an HV ref");
     }
     return retval;
@@ -1737,6 +1749,7 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
 	return (tmps[off] << 24) + (tmps[off+1] << 16) + (tmps[off+2] << 8) + tmps[off + 3] ;
     }
     Perl_croak(aTHX_ "panic: swash_fetch got swatch of unexpected bit width");
+    NORETURN_FUNCTION_END;
 }
 
 /* Note: