Avoid negating an unsigned value. (The offset in the SV body table)
[p5sagit/p5-mst-13.2.git] / sv.c
diff --git a/sv.c b/sv.c
index 30193b0..c9f2e27 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -520,7 +520,7 @@ do_clean_all(pTHX_ SV *sv)
     DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) ));
     SvFLAGS(sv) |= SVf_BREAK;
     if (PL_comppad == (AV*)sv) {
-       PL_comppad = Nullav;
+       PL_comppad = NULL;
        PL_curpad = Null(SV**);
     }
     SvREFCNT_dec(sv);
@@ -809,14 +809,14 @@ static const struct body_details bodies_by_type[] = {
     /* 8 bytes on most ILP32 with IEEE doubles */
     {sizeof(xpv_allocated),
      copy_length(XPV, xpv_len)
-     + relative_STRUCT_OFFSET(XPV, xpv_allocated, xpv_cur),
-     - relative_STRUCT_OFFSET(XPV, xpv_allocated, xpv_cur),
+     - relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur),
+     + relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur),
      FALSE, NONV, HASARENA},
     /* 12 */
     {sizeof(xpviv_allocated),
      copy_length(XPVIV, xiv_u)
-     + relative_STRUCT_OFFSET(XPVIV, xpviv_allocated, xpv_cur),
-     - relative_STRUCT_OFFSET(XPVIV, xpviv_allocated, xpv_cur),
+     - relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur),
+     + relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur),
      FALSE, NONV, HASARENA},
     /* 20 */
     {sizeof(XPVNV), copy_length(XPVNV, xiv_u), 0, FALSE, HADNV, HASARENA},
@@ -831,14 +831,14 @@ static const struct body_details bodies_by_type[] = {
     /* 20 */
     {sizeof(xpvav_allocated),
      copy_length(XPVAV, xmg_stash)
-     + relative_STRUCT_OFFSET(XPVAV, xpvav_allocated, xav_fill),
-     - relative_STRUCT_OFFSET(XPVAV, xpvav_allocated, xav_fill),
+     - relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill),
+     + relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill),
      TRUE, HADNV, HASARENA},
     /* 20 */
     {sizeof(xpvhv_allocated),
      copy_length(XPVHV, xmg_stash)
-     + relative_STRUCT_OFFSET(XPVHV, xpvhv_allocated, xhv_fill),
-     - relative_STRUCT_OFFSET(XPVHV, xpvhv_allocated, xhv_fill),
+     - relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill),
+     + relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill),
      TRUE, HADNV, HASARENA},
     /* 76 */
     {sizeof(XPVCV), sizeof(XPVCV), 0, TRUE, HADNV, HASARENA},
@@ -1910,18 +1910,14 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
            }
            return I_V(Atof(SvPVX_const(sv)));
        }
-       if (!SvROK(sv)) {
-           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
-                   report_uninit(sv);
-           }
-           return 0;
+        if (SvROK(sv)) {
+           goto return_rok;
        }
-       /* Else this will drop through into the SvROK case just below, which
-          will return within the {} for all code paths.  */
-    }
-    if (SvTHINKFIRST(sv)) {
+       assert(SvTYPE(sv) >= SVt_PVMG);
+       /* This falls through to the report_uninit inside S_sv_2iuv_common.  */
+    } else if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
+       return_rok:
            if (SvAMAGIC(sv)) {
                SV * const tmpstr=AMG_CALLun(sv,numer);
                if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
@@ -1987,23 +1983,21 @@ Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
            }
            return U_V(Atof(SvPVX_const(sv)));
        }
-       if (!SvROK(sv)) {
-           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
-                   report_uninit(sv);
-           }
-           return 0;
+        if (SvROK(sv)) {
+           goto return_rok;
        }
-       /* Else this will drop through into the SvROK case just below, which
-          will return within the {} for all code paths.  */
-    }
-    if (SvTHINKFIRST(sv)) {
+       assert(SvTYPE(sv) >= SVt_PVMG);
+       /* This falls through to the report_uninit inside S_sv_2iuv_common.  */
+    } else if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
-         SV* tmpstr;
-          if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) &&
-                (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv))))
-             return SvUV(tmpstr);
-         return PTR2UV(SvRV(sv));
+       return_rok:
+           if (SvAMAGIC(sv)) {
+               SV *const tmpstr = AMG_CALLun(sv,numer);
+               if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
+                   return SvUV(tmpstr);
+               }
+           }
+           return PTR2UV(SvRV(sv));
        }
        if (SvIsCOW(sv)) {
            sv_force_normal_flags(sv, 0);
@@ -2054,24 +2048,23 @@ Perl_sv_2nv(pTHX_ register SV *sv)
                return (NV)SvUVX(sv);
            else
                return (NV)SvIVX(sv);
-       }       
-        if (!SvROK(sv)) {
-           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
-                   report_uninit(sv);
-           }
-            return (NV)0;
-        }
-       /* Else this will drop through into the SvROK case just below, which
-          will return within the {} for all code paths.  */
-    }
-    if (SvTHINKFIRST(sv)) {
+       }
+        if (SvROK(sv)) {
+           goto return_rok;
+       }
+       assert(SvTYPE(sv) >= SVt_PVMG);
+       /* This falls through to the report_uninit near the end of the
+          function. */
+    } else if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
-         SV* tmpstr;
-          if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)) &&
-                (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv))))
-             return SvNV(tmpstr);
-         return PTR2NV(SvRV(sv));
+       return_rok:
+           if (SvAMAGIC(sv)) {
+               SV *const tmpstr = AMG_CALLun(sv,numer);
+                if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
+                   return SvNV(tmpstr);
+               }
+           }
+           return PTR2NV(SvRV(sv));
        }
        if (SvIsCOW(sv)) {
            sv_force_normal_flags(sv, 0);
@@ -2357,7 +2350,6 @@ char *
 Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 {
     register char *s;
-    int olderrno;
 
     if (!sv) {
        if (lp)
@@ -2415,46 +2407,43 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                return memcpy(s, tbuf, len + 1);
            }
        }
-        if (!SvROK(sv)) {
-           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
-                   report_uninit(sv);
-           }
-           if (lp)
-               *lp = 0;
-            return (char *)"";
-        }
-       /* Else this will drop through into the SvROK case just below, which
-          will return within the {} for all code paths.  */
-    }
-    if (SvTHINKFIRST(sv)) {
+        if (SvROK(sv)) {
+           goto return_rok;
+       }
+       assert(SvTYPE(sv) >= SVt_PVMG);
+       /* This falls through to the report_uninit near the end of the
+          function. */
+    } else if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
-           SV* tmpstr;
-
-            if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) &&
-                (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
-               /* Unwrap this:  */
-               /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr); */
-
-                char *pv;
-               if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) {
-                   if (flags & SV_CONST_RETURN) {
-                       pv = (char *) SvPVX_const(tmpstr);
+       return_rok:
+            if (SvAMAGIC(sv)) {
+               SV *const tmpstr = AMG_CALLun(sv,string);
+               if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
+                   /* Unwrap this:  */
+                   /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr);
+                    */
+
+                   char *pv;
+                   if ((SvFLAGS(tmpstr) & (SVf_POK)) == SVf_POK) {
+                       if (flags & SV_CONST_RETURN) {
+                           pv = (char *) SvPVX_const(tmpstr);
+                       } else {
+                           pv = (flags & SV_MUTABLE_RETURN)
+                               ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr);
+                       }
+                       if (lp)
+                           *lp = SvCUR(tmpstr);
                    } else {
-                       pv = (flags & SV_MUTABLE_RETURN)
-                           ? SvPVX_mutable(tmpstr) : SvPVX(tmpstr);
+                       pv = sv_2pv_flags(tmpstr, lp, flags);
                    }
-                   if (lp)
-                       *lp = SvCUR(tmpstr);
-               } else {
-                   pv = sv_2pv_flags(tmpstr, lp, flags);
+                   if (SvUTF8(tmpstr))
+                       SvUTF8_on(sv);
+                   else
+                       SvUTF8_off(sv);
+                   return pv;
                }
-                if (SvUTF8(tmpstr))
-                    SvUTF8_on(sv);
-                else
-                    SvUTF8_off(sv);
-                return pv;
-            } else {
+           }
+           {
                SV *tsv;
                MAGIC *mg;
                const SV *const referent = (SV*)SvRV(sv);
@@ -2504,10 +2493,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 
        if (SvTYPE(sv) < SVt_PVIV)
            sv_upgrade(sv, SVt_PVIV);
-       if (isUIOK)
-           ptr = uiv_2buf(buf, 0, SvUVX(sv), 1, &ebuf);
-       else
-           ptr = uiv_2buf(buf, SvIVX(sv), 0, 0, &ebuf);
+       ptr = uiv_2buf(buf, SvIVX(sv), SvUVX(sv), isUIOK, &ebuf);
        /* inlined from sv_setpvn */
        SvGROW_mutable(sv, (STRLEN)(ebuf - ptr + 1));
        Move(ptr,SvPVX_mutable(sv),ebuf - ptr,char);
@@ -2522,11 +2508,12 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
            SvIsUV_on(sv);
     }
     else if (SvNOKp(sv)) {
+       const int olderrno = errno;
        if (SvTYPE(sv) < SVt_PVNV)
            sv_upgrade(sv, SVt_PVNV);
        /* The +20 is pure guesswork.  Configure test needed. --jhi */
        s = SvGROW_mutable(sv, NV_DIG + 20);
-       olderrno = errno;       /* some Xenix systems wipe out errno here */
+       /* some Xenix systems wipe out errno here */
 #ifdef apollo
        if (SvNVX(sv) == 0.0)
            (void)strcpy(s,"0");
@@ -6717,7 +6704,7 @@ Perl_sv_2io(pTHX_ SV *sv)
            Perl_croak(aTHX_ PL_no_usym, "filehandle");
        if (SvROK(sv))
            return sv_2io(SvRV(sv));
-       gv = gv_fetchsv(sv, FALSE, SVt_PVIO);
+       gv = gv_fetchsv(sv, 0, SVt_PVIO);
        if (gv)
            io = GvIO(gv);
        else
@@ -6734,6 +6721,7 @@ Perl_sv_2io(pTHX_ SV *sv)
 
 Using various gambits, try to get a CV from an SV; in addition, try if
 possible to set C<*st> and C<*gvp> to the stash and GV associated with it.
+The flags in C<lref> are passed to sv_fetchsv.
 
 =cut
 */
@@ -6746,7 +6734,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
     CV *cv = Nullcv;
 
     if (!sv)
-       return *gvp = Nullgv, Nullcv;
+       return *st = NULL, *gvp = Nullgv, Nullcv;
     switch (SvTYPE(sv)) {
     case SVt_PVCV:
        *st = CvSTASH(sv);
@@ -6754,6 +6742,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
        return (CV*)sv;
     case SVt_PVHV:
     case SVt_PVAV:
+       *st = NULL;
        *gvp = Nullgv;
        return Nullcv;
     case SVt_PVGV:
@@ -6785,8 +6774,10 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
        else
            gv = gv_fetchsv(sv, lref, SVt_PVCV);
        *gvp = gv;
-       if (!gv)
+       if (!gv) {
+           *st = NULL;
            return Nullcv;
+       }
        *st = GvESTASH(gv);
     fix_gv:
        if (lref && !GvCVu(gv)) {
@@ -7269,7 +7260,7 @@ S_sv_unglob(pTHX_ SV *sv)
        gp_free((GV*)sv);
     if (GvSTASH(sv)) {
        sv_del_backref((SV*)GvSTASH(sv), sv);
-       GvSTASH(sv) = Nullhv;
+       GvSTASH(sv) = NULL;
     }
     sv_unmagic(sv, PERL_MAGIC_glob);
     Safefree(GvNAME(sv));
@@ -7998,21 +7989,23 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                vecsv = svargs[efix ? efix-1 : svix++];
                vecstr = (U8*)SvPV_const(vecsv,veclen);
                vec_utf8 = DO_UTF8(vecsv);
-               /* if this is a version object, we need to return the
-                * stringified representation (which the SvPVX_const has
-                * already done for us), but not vectorize the args
+
+               /* if this is a version object, we need to convert
+                * back into v-string notation and then let the
+                * vectorize happen normally
                 */
-               if ( *q == 'd' && sv_derived_from(vecsv,"version") )
-               {
-                       q++; /* skip past the rest of the %vd format */
-                       eptr = (const char *) vecstr;
-                       elen = veclen;
-                       if (elen && *eptr == 'v') {
-                           eptr++;
-                           elen--;
-                       }
-                       vectorize=FALSE;
-                       goto string;
+               if (sv_derived_from(vecsv, "version")) {
+                   char *version = savesvpv(vecsv);
+                   vecsv = sv_newmortal();
+                   /* scan_vstring is expected to be called during
+                    * tokenization, so we need to fake up the end
+                    * of the buffer for it
+                    */
+                   PL_bufend = version + veclen;
+                   scan_vstring(version, vecsv);
+                   vecstr = (U8*)SvPV_const(vecsv, veclen);
+                   vec_utf8 = DO_UTF8(vecsv);
+                   Safefree(version);
                }
            }
            else {
@@ -9320,9 +9313,9 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
            case SVt_PVNV:
            case SVt_PVIV:
            case SVt_PV:
-               assert(sv_type_details->copy);
+               assert(sv_type_details->size);
                if (sv_type_details->arena) {
-                   new_body_inline(new_body, sv_type_details->copy, sv_type);
+                   new_body_inline(new_body, sv_type_details->size, sv_type);
                    new_body
                        = (void*)((char*)new_body - sv_type_details->offset);
                } else {
@@ -9561,7 +9554,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
                                           : cv_dup(cx->blk_sub.cv,param));
                ncx->blk_sub.argarray   = (cx->blk_sub.hasargs
                                           ? av_dup_inc(cx->blk_sub.argarray, param)
-                                          : Nullav);
+                                          : NULL);
                ncx->blk_sub.savearray  = av_dup_inc(cx->blk_sub.savearray, param);
                ncx->blk_sub.olddepth   = cx->blk_sub.olddepth;
                ncx->blk_sub.hasargs    = cx->blk_sub.hasargs;
@@ -10243,6 +10236,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_minus_p         = proto_perl->Iminus_p;
     PL_minus_l         = proto_perl->Iminus_l;
     PL_minus_a         = proto_perl->Iminus_a;
+    PL_minus_E         = proto_perl->Iminus_E;
     PL_minus_F         = proto_perl->Iminus_F;
     PL_doswitches      = proto_perl->Idoswitches;
     PL_dowarn          = proto_perl->Idowarn;
@@ -10586,7 +10580,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 #endif
 
     /* swatch cache */
-    PL_last_swash_hv   = Nullhv;       /* reinits on demand */
+    PL_last_swash_hv   = NULL; /* reinits on demand */
     PL_last_swash_klen = 0;
     PL_last_swash_key[0]= '\0';
     PL_last_swash_tmps = (U8*)NULL;