patch@27373 VMS build fix + more long pathname stuff

[p5sagit/p5-mst-13.2.git] / utf8.c

diff --git a/utf8.c b/utf8.c
index 7dc5d99..e5079cb 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -186,7 +186,7 @@ five bytes or more.
 
 =cut */
 STATIC STRLEN
-S_is_utf8_char_slow(pTHX_ const U8 *s, const STRLEN len)
+S_is_utf8_char_slow(const U8 *s, const STRLEN len)
 {
     U8 u = *s;
     STRLEN slen;
@@ -238,6 +238,7 @@ STRLEN
 Perl_is_utf8_char(pTHX_ const U8 *s)
 {
     const STRLEN len = UTF8SKIP(s);
+    PERL_UNUSED_CONTEXT;
 #ifdef IS_UTF8_CHAR
     if (IS_UTF8_CHAR_FAST(len))
         return IS_UTF8_CHAR(s, len) ? len : 0;
@@ -264,6 +265,7 @@ Perl_is_utf8_string(pTHX_ const U8 *s, STRLEN len)
     const U8* x = s;
     const U8* send;
 
+    PERL_UNUSED_CONTEXT;
     if (!len)
        len = strlen((const char *)s);
     send = s + len;
@@ -329,6 +331,7 @@ Perl_is_utf8_string_loclen(pTHX_ const U8 *s, STRLEN len, const U8 **ep, STRLEN
     const U8* x = s;
     const U8* send;
     STRLEN c;
+    PERL_UNUSED_CONTEXT;
 
     if (!len)
         len = strlen((const char *)s);
@@ -755,6 +758,7 @@ on the first byte of character or just after the last byte of a character.
 U8 *
 Perl_utf8_hop(pTHX_ const U8 *s, I32 off)
 {
+    PERL_UNUSED_CONTEXT;
     /* Note: cannot use UTF8_IS_...() too eagerly here since e.g
      * the bitops (especially ~) can create illegal UTF-8.
      * In other words: in Perl UTF-8 is not just for Unicode. */
@@ -835,6 +839,7 @@ Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *len, bool *is_utf8)
     const U8 *send;
     I32 count = 0;
 
+    PERL_UNUSED_CONTEXT;
     if (!*is_utf8)
         return (U8 *)start;
 
@@ -852,7 +857,7 @@ Perl_bytes_from_utf8(pTHX_ const U8 *s, STRLEN *len, bool *is_utf8)
 
     *is_utf8 = 0;              
 
-    Newxz(d, (*len) - count + 1, U8);
+    Newx(d, (*len) - count + 1, U8);
     s = start; start = d;
     while (s < send) {
        U8 c = *s++;
@@ -887,8 +892,9 @@ Perl_bytes_to_utf8(pTHX_ const U8 *s, STRLEN *len)
     const U8 * const send = s + (*len);
     U8 *d;
     U8 *dst;
+    PERL_UNUSED_CONTEXT;
 
-    Newxz(d, (*len) * 2 + 1, U8);
+    Newx(d, (*len) * 2 + 1, U8);
     dst = d;
 
     while (s < send) {
@@ -1596,8 +1602,15 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits
     if (!gv_fetchmeth(stash, "SWASHNEW", 8, -1)) {     /* demand load utf8 */
        ENTER;
        errsv_save = newSVsv(ERRSV);
+       /* It is assumed that callers of this routine are not passing in any
+          user derived data.  */
+       /* Need to do this after save_re_context() as it will set PL_tainted to
+          1 while saving $1 etc (see the code after getrx: in Perl_magic_get).
+          Even line to create errsv_save can turn on PL_tainted.  */
+       SAVEBOOL(PL_tainted);
+       PL_tainted = 0;
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn(pkg,pkg_len),
-                        Nullsv);
+                        NULL);
        if (!SvTRUE(ERRSV))
            sv_setsv(ERRSV, errsv_save);
        SvREFCNT_dec(errsv_save);
@@ -1784,11 +1797,11 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
     STRLEN lcur, xcur, scur;
 
     HV* const hv = (HV*)SvRV(swash);
-    SV** const listsvp = hv_fetch(hv, "LIST", 4, FALSE);
-    SV** const typesvp = hv_fetch(hv, "TYPE", 4, FALSE);
-    SV** const bitssvp = hv_fetch(hv, "BITS", 4, FALSE);
-    SV** const nonesvp = hv_fetch(hv, "NONE", 4, FALSE);
-    SV** const extssvp = hv_fetch(hv, "EXTRAS", 6, FALSE);
+    SV** const listsvp = hv_fetchs(hv, "LIST", FALSE);
+    SV** const typesvp = hv_fetchs(hv, "TYPE", FALSE);
+    SV** const bitssvp = hv_fetchs(hv, "BITS", FALSE);
+    SV** const nonesvp = hv_fetchs(hv, "NONE", FALSE);
+    SV** const extssvp = hv_fetchs(hv, "EXTRAS", FALSE);
     const U8* const typestr = (U8*)SvPV_nolen(*typesvp);
     const int  typeto  = typestr[0] == 'T' && typestr[1] == 'o';
     const STRLEN bits  = SvUV(*bitssvp);
@@ -1991,7 +2004,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
 
        othersvp = hv_fetch(hv, (char *)namestr, namelen, FALSE);
        otherhv = (HV*)SvRV(*othersvp);
-       otherbitssvp = hv_fetch(otherhv, "BITS", 4, FALSE);
+       otherbitssvp = hv_fetchs(otherhv, "BITS", FALSE);
        otherbits = (STRLEN)SvUV(*otherbitssvp);
        if (bits < otherbits)
            Perl_croak(aTHX_ "panic: swash_get found swatch size mismatch");
@@ -2051,7 +2064,7 @@ S_swash_get(pTHX_ SV* swash, UV start, UV span)
                }
 
                if (opc == '+' && otherval)
-                   ; /* replace with otherval */
+                   /*EMPTY*/;   /* replace with otherval */
                else if (opc == '!' && !otherval)
                    otherval = 1;
                else if (opc == '-' && otherval)