[perl #35847] File::Find not performing as documented

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

diff --git a/sv.c b/sv.c
index 94f4b32..4b83f13 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2953,6 +2953,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
     SV *tsv, *origsv;
     char tbuf[64];     /* Must fit sprintf/Gconvert of longest IV/NV */
     char *tmpbuf = tbuf;
+    STRLEN len = 0;    /* Hush gcc. len is always initialised before use.  */
 
     if (!sv) {
        if (lp)
@@ -2972,12 +2973,10 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
            return SvPVX(sv);
        }
        if (SvIOKp(sv)) {
-           if (SvIsUV(sv))
-               (void)sprintf(tmpbuf,"%"UVuf, (UV)SvUVX(sv));
-           else
-               (void)sprintf(tmpbuf,"%"IVdf, (IV)SvIVX(sv));
+           len = SvIsUV(sv) ? my_sprintf(tmpbuf,"%"UVuf, (UV)SvUVX(sv))
+               : my_sprintf(tmpbuf,"%"IVdf, (IV)SvIVX(sv));
            tsv = Nullsv;
-           goto tokensave;
+           goto tokensave_has_len;
        }
        if (SvNOKp(sv)) {
            Gconvert(SvNVX(sv), NV_DIG, 0, tmpbuf);
@@ -3138,7 +3137,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                }
                tsv = NEWSV(0,0);
                if (SvOBJECT(sv)) {
-                   const char *name = HvNAME_get(SvSTASH(sv));
+                   const char * const name = HvNAME_get(SvSTASH(sv));
                    Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
                                   name ? name : "__ANON__" , typestr, PTR2UV(sv));
                }
@@ -3236,12 +3235,15 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
     return SvPVX(sv);
 
   tokensave:
+    len = strlen(tmpbuf);
+ tokensave_has_len:
+    assert (!tsv);
     if (SvROK(sv)) {   /* XXX Skip this when sv_pvn_force calls */
        /* Sneaky stuff here */
 
       tokensaveref:
        if (!tsv)
-           tsv = newSVpv(tmpbuf, 0);
+           tsv = newSVpvn(tmpbuf, len);
        sv_2mortal(tsv);
        if (lp)
            *lp = SvCUR(tsv);
@@ -3249,21 +3251,11 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
     }
     else {
         dVAR;
-       STRLEN len;
-        const char *t;
 
-       if (tsv) {
-           sv_2mortal(tsv);
-           t = SvPVX_const(tsv);
-           len = SvCUR(tsv);
-       }
-       else {
-           t = tmpbuf;
-           len = strlen(tmpbuf);
-       }
 #ifdef FIXNEGATIVEZERO
-       if (len == 2 && t[0] == '-' && t[1] == '0') {
-           t = "0";
+       if (len == 2 && tmpbuf[0] == '-' && tmpbuf[1] == '0') {
+           tmpbuf[0] = '0';
+           tmpbuf[1] = 0;
            len = 1;
        }
 #endif
@@ -3273,7 +3265,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        s = SvGROW_mutable(sv, len + 1);
        SvCUR_set(sv, len);
        SvPOKp_on(sv);
-       return memcpy(s, t, len + 1);
+       return memcpy(s, tmpbuf, len + 1);
     }
 }
 
@@ -3444,7 +3436,7 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
         * chars in the PV.  Given that there isn't such a flag
         * make the loop as fast as possible. */
        const U8 *s = (U8 *) SvPVX_const(sv);
-       const U8 *e = (U8 *) SvEND(sv);
+       const U8 * const e = (U8 *) SvEND(sv);
        const U8 *t = s;
        int hibit = 0;
        
@@ -3760,11 +3752,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                GvNAMELEN(dstr) = len;
                SvFAKE_on(dstr);        /* can coerce to non-glob */
            }
-           /* ahem, death to those who redefine active sort subs */
-           else if (PL_curstackinfo->si_type == PERLSI_SORT
-                    && GvCV(dstr) && PL_sortcop == CvSTART(GvCV(dstr)))
-               Perl_croak(aTHX_ "Can't redefine active sort subroutine %s",
-                     GvNAME(dstr));
 
 #ifdef GV_UNIQUE_CHECK
                 if (GvUNIQUE((GV*)dstr)) {
@@ -3867,13 +3854,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                            if (!GvCVGEN((GV*)dstr) &&
                                (CvROOT(cv) || CvXSUB(cv)))
                            {
-                               /* ahem, death to those who redefine
-                                * active sort subs */
-                               if (PL_curstackinfo->si_type == PERLSI_SORT &&
-                                     PL_sortcop == CvSTART(cv))
-                                   Perl_croak(aTHX_
-                                   "Can't redefine active sort subroutine %s",
-                                         GvENAME((GV*)dstr));
                                /* Redefining a sub - warning is mandatory if
                                   it was a const and its value changed. */
                                if (ckWARN(WARN_REDEFINE)
@@ -7417,19 +7397,15 @@ Perl_sv_reset(pTHX_ register const char *s, HV *stash)
                    av_clear(GvAV(gv));
                }
                if (GvHV(gv) && !HvNAME_get(GvHV(gv))) {
+#if defined(VMS)
+                   Perl_die(aTHX_ "Can't reset %%ENV on this system");
+#else /* ! VMS */
                    hv_clear(GvHV(gv));
-#ifndef PERL_MICRO
-#ifdef USE_ENVIRON_ARRAY
-                   if (gv == PL_envgv
-#  ifdef USE_ITHREADS
-                       && PL_curinterp == aTHX
-#  endif
-                   )
-                   {
-                       environ[0] = Nullch;
-                   }
-#endif
-#endif /* !PERL_MICRO */
+#  if defined(USE_ENVIRON_ARRAY)
+                   if (gv == PL_envgv)
+                       my_clearenv();
+#  endif /* USE_ENVIRON_ARRAY */
+#endif /* VMS */
                }
            }
        }
@@ -8135,11 +8111,7 @@ Like C<sv_setpviv>, but also handles 'set' magic.
 void
 Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv)
 {
-    char buf[TYPE_CHARS(UV)];
-    char *ebuf;
-    char * const ptr = uiv_2buf(buf, iv, 0, 0, &ebuf);
-
-    sv_setpvn(sv, ptr, ebuf - ptr);
+    sv_setpviv(sv, iv);
     SvSETMAGIC(sv);
 }
 
@@ -8748,7 +8720,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                {
                        q++; /* skip past the rest of the %vd format */
                        eptr = (const char *) vecstr;
-                       elen = strlen(eptr);
+                       elen = veclen;
                        vectorize=FALSE;
                        goto string;
                }
@@ -9349,7 +9321,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                && (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)
                && ckWARN(WARN_PRINTF))
            {
-               SV *msg = sv_newmortal();
+               SV * const msg = sv_newmortal();
                Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %sprintf: ",
                          (PL_op->op_type == OP_PRTF) ? "" : "s");
                if (c) {
@@ -11529,7 +11501,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_sortstash       = hv_dup(proto_perl->Tsortstash, param);
     PL_firstgv         = gv_dup(proto_perl->Tfirstgv, param);
     PL_secondgv                = gv_dup(proto_perl->Tsecondgv, param);
-    PL_sortcxix                = proto_perl->Tsortcxix;
     PL_efloatbuf       = Nullch;               /* reinits on demand */
     PL_efloatsize      = 0;                    /* reinits on demand */