[perl 7711: EPOC] updates

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

diff --git a/sv.c b/sv.c
index 726f853..2cc3c43 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1497,6 +1497,9 @@ Perl_sv_2iv(pTHX_ register SV *sv)
              return SvIV(tmpstr);
          return PTR2IV(SvRV(sv));
        }
+       if (SvREADONLY(sv) && SvFAKE(sv)) {
+           sv_force_normal(sv);
+       }
        if (SvREADONLY(sv) && !SvOK(sv)) {
            dTHR;
            if (ckWARN(WARN_UNINITIALIZED))
@@ -2567,7 +2570,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
            SvIVX(dstr) = SvIVX(sstr);
            if (SvIsUV(sstr))
                SvIsUV_on(dstr);
-           SvTAINT(dstr);
+           if (SvTAINTED(sstr))
+               SvTAINT(dstr);
            return;
        }
        goto undef_sstr;
@@ -2587,7 +2591,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
            }
            SvNVX(dstr) = SvNVX(sstr);
            (void)SvNOK_only(dstr);
-           SvTAINT(dstr);
+           if (SvTAINTED(sstr))
+               SvTAINT(dstr);
            return;
        }
        goto undef_sstr;
@@ -2656,7 +2661,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
            GvINTRO_off(dstr);          /* one-shot flag */
            gp_free((GV*)dstr);
            GvGP(dstr) = gp_ref(GvGP(sstr));
-           SvTAINT(dstr);
+           if (SvTAINTED(sstr))
+               SvTAINT(dstr);
            if (GvIMPORTED(dstr) != GVf_IMPORTED
                && CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
            {
@@ -2764,7 +2770,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
                                    Perl_warner(aTHX_ WARN_REDEFINE,
                                        CvCONST(cv)
                                        ? "Constant subroutine %s redefined"
-                                       : "Subroutine %s redefined", 
+                                       : "Subroutine %s redefined",
                                        GvENAME((GV*)dstr));
                                }
                            }
@@ -2813,7 +2819,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
                    SvREFCNT_dec(dref);
                if (intro)
                    SAVEFREESV(sref);
-               SvTAINT(dstr);
+               if (SvTAINTED(sstr))
+                   SvTAINT(dstr);
                return;
            }
            if (SvPVX(dstr)) {
@@ -2922,7 +2929,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
        else
            (void)SvOK_off(dstr);
     }
-    SvTAINT(dstr);
+    if (SvTAINTED(sstr))
+       SvTAINT(dstr);
 }
 
 /*
@@ -3986,26 +3994,20 @@ UTF8 bytes as a single character.
 STRLEN
 Perl_sv_len_utf8(pTHX_ register SV *sv)
 {
-    U8 *s;
-    U8 *send;
-    STRLEN len;
-
     if (!sv)
        return 0;
 
 #ifdef NOTYET
     if (SvGMAGICAL(sv))
-       len = mg_length(sv);
+       return mg_length(sv);
     else
 #endif
-       s = (U8*)SvPV(sv, len);
-    send = s + len;
-    len = 0;
-    while (s < send) {
-       s += UTF8SKIP(s);
-       len++;
+    {
+       STRLEN len;
+       U8 *s = (U8*)SvPV(sv, len);
+
+       return Perl_utf8_length(aTHX_ s, s + len);
     }
-    return len;
 }
 
 void
@@ -5132,7 +5134,7 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash)
                }
                if (GvHV(gv) && !HvNAME(GvHV(gv))) {
                    hv_clear(GvHV(gv));
-#if !defined( VMS) && !defined(EPOC)  /* VMS has no environ array */
+#ifdef USE_ENVIRON_ARRAY
                    if (gv == PL_envgv)
                        environ[0] = Nullch;
 #endif
@@ -6616,15 +6618,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                *--eptr = '#';
            *--eptr = '%';
 
-           {
-               STORE_NUMERIC_STANDARD_SET_LOCAL();
-#ifdef USE_LOCALE_NUMERIC
-               if (!was_standard && maybe_tainted)
-                   *maybe_tainted = TRUE;
-#endif
-               (void)sprintf(PL_efloatbuf, eptr, nv);
-               RESTORE_NUMERIC_STANDARD();
-           }
+           (void)sprintf(PL_efloatbuf, eptr, nv);
 
            eptr = PL_efloatbuf;
            elen = strlen(PL_efloatbuf);
@@ -7832,6 +7826,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling);
     if (!specialWARN(PL_compiling.cop_warnings))
        PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings);
+    if (!specialCopIO(PL_compiling.cop_io))
+       PL_compiling.cop_io = sv_dup_inc(PL_compiling.cop_io);
     PL_curcop          = (COP*)any_dup(proto_perl->Tcurcop, proto_perl);
 
     /* pseudo environmental stuff */