Re: Cygwin PerlIO.t failing

[perl5.git] / doop.c

diff --git a/doop.c b/doop.c
index 9f0fa64..20379a9 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -1,6 +1,6 @@
 /*    doop.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -697,6 +697,9 @@ Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg)
     char *pat = SvPV(*sarg, patlen);
     bool do_taint = FALSE;
 
+    SvUTF8_off(sv);
+    if (DO_UTF8(*sarg))
+        SvUTF8_on(sv);
     sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
     SvSETMAGIC(sv);
     if (do_taint)
@@ -751,7 +754,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 #ifdef UV_IS_QUAD
            else if (size == 64) {
                if (ckWARN(WARN_PORTABLE))
-                   Perl_warner(aTHX_ WARN_PORTABLE,
+                   Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
                                "Bit vector size > 32 non-portable");
                if (offset >= srclen)
                    retnum = 0;
@@ -820,7 +823,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 #ifdef UV_IS_QUAD
        else if (size == 64) {
            if (ckWARN(WARN_PORTABLE))
-               Perl_warner(aTHX_ WARN_PORTABLE,
+               Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
                            "Bit vector size > 32 non-portable");
            retnum =
                ((UV) s[offset    ] << 56) +
@@ -869,7 +872,7 @@ Perl_do_vecset(pTHX_ SV *sv)
     lval = SvUV(sv);
     offset = LvTARGOFF(sv);
     if (offset < 0)
-       Perl_croak(aTHX_ "Assigning to negative offset in vec");
+       Perl_croak(aTHX_ "Negative offset to vec in lvalue context");
     size = LvTARGLEN(sv);
     if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */
        Perl_croak(aTHX_ "Illegal number of bits in vec");
@@ -907,7 +910,7 @@ Perl_do_vecset(pTHX_ SV *sv)
 #ifdef UV_IS_QUAD
        else if (size == 64) {
            if (ckWARN(WARN_PORTABLE))
-               Perl_warner(aTHX_ WARN_PORTABLE,
+               Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
                            "Bit vector size > 32 non-portable");
            s[offset  ] = (lval >> 56) & 0xff;
            s[offset+1] = (lval >> 48) & 0xff;
@@ -1333,8 +1336,19 @@ Perl_do_kv(pTHX)
     PUTBACK;   /* hv_iternext and hv_iterval might clobber stack_sp */
     while ((entry = hv_iternext(keys))) {
        SPAGAIN;
-       if (dokeys)
-           XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
+       if (dokeys) {
+           SV* sv = hv_iterkeysv(entry);
+           if (HvUTF8KEYS((SV*)hv) && !DO_UTF8(sv)) {
+               STRLEN len, i;
+               char* s = SvPV(sv, len);
+               for (i = 0; i < len && NATIVE_IS_INVARIANT(s[i]); i++);
+               if (i < len) {
+                   sv = newSVsv(sv);
+                   sv_utf8_upgrade(sv);
+               }
+           }
+           XPUSHs(sv); /* won't clobber stack_sp */
+       }
        if (dovalues) {
            PUTBACK;
            tmpstr = realhv ?