Move the modules, tests, prove and Changes file from lib/ to

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

diff --git a/sv.c b/sv.c
index 6431cba..04d6e43 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1543,6 +1543,8 @@ Perl_sv_setiv(pTHX_ register SV *const sv, const IV i)
        break;
 
     case SVt_PVGV:
+       if (!isGV_with_GP(sv))
+           break;
     case SVt_PVAV:
     case SVt_PVHV:
     case SVt_PVCV:
@@ -1650,6 +1652,8 @@ Perl_sv_setnv(pTHX_ register SV *const sv, const NV num)
        break;
 
     case SVt_PVGV:
+       if (!isGV_with_GP(sv))
+           break;
     case SVt_PVAV:
     case SVt_PVHV:
     case SVt_PVCV:
@@ -3162,13 +3166,21 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *const sv, const I32 flags)
            const U8 ch = *t++;
            /* Check for hi bit */
            if (!NATIVE_IS_INVARIANT(ch)) {
-               STRLEN len = SvCUR(sv) + 1; /* Plus the \0 */
+               STRLEN len = SvCUR(sv);
+               /* *Currently* bytes_to_utf8() adds a '\0' after every string
+                  it converts. This isn't documented. It's not clear if it's
+                  a bad thing to be doing, and should be changed to do exactly
+                  what the documentation says. If so, this code will have to
+                  be changed.
+                  As is, we mustn't rely on our incoming SV being well formed
+                  and having a trailing '\0', as certain code in pp_formline
+                  can send us partially built SVs. */
                U8 * const recoded = bytes_to_utf8((U8*)s, &len);
 
                SvPV_free(sv); /* No longer using what was there before. */
                SvPV_set(sv, (char*)recoded);
-               SvCUR_set(sv, len - 1);
-               SvLEN_set(sv, len); /* No longer know the real size. */
+               SvCUR_set(sv, len);
+               SvLEN_set(sv, len + 1); /* No longer know the real size. */
                break;
            }
        }
@@ -4377,6 +4389,7 @@ Perl_sv_chop(pTHX_ register SV *const sv, register const char *const ptr)
 #ifdef DEBUGGING
     const U8 *real_start;
 #endif
+    STRLEN max_delta;
 
     PERL_ARGS_ASSERT_SV_CHOP;
 
@@ -4387,8 +4400,17 @@ Perl_sv_chop(pTHX_ register SV *const sv, register const char *const ptr)
        /* Nothing to do.  */
        return;
     }
-    assert(ptr > SvPVX_const(sv));
+    /* SvPVX(sv) may move in SV_CHECK_THINKFIRST(sv), but after this line,
+       nothing uses the value of ptr any more.  */
+    max_delta = SvLEN(sv) ? SvLEN(sv) : SvCUR(sv);
+    if (ptr <= SvPVX_const(sv))
+       Perl_croak(aTHX_ "panic: sv_chop ptr=%p, start=%p, end=%p",
+                  ptr, SvPVX_const(sv), SvPVX_const(sv) + max_delta);
     SV_CHECK_THINKFIRST(sv);
+    if (delta > max_delta)
+       Perl_croak(aTHX_ "panic: sv_chop ptr=%p (was %p), start=%p, end=%p",
+                  SvPVX_const(sv) + delta, ptr, SvPVX_const(sv),
+                  SvPVX_const(sv) + max_delta);
 
     if (!SvOOK(sv)) {
        if (!SvLEN(sv)) { /* make copy of shared string */
@@ -7818,11 +7840,14 @@ Perl_sv_2io(pTHX_ SV *const sv)
        io = (IO*)sv;
        break;
     case SVt_PVGV:
-       gv = (GV*)sv;
-       io = GvIO(gv);
-       if (!io)
-           Perl_croak(aTHX_ "Bad filehandle: %s", GvNAME(gv));
-       break;
+       if (isGV_with_GP(sv)) {
+           gv = (GV*)sv;
+           io = GvIO(gv);
+           if (!io)
+               Perl_croak(aTHX_ "Bad filehandle: %s", GvNAME(gv));
+           break;
+       }
+       /* FALL THROUGH */
     default:
        if (!SvOK(sv))
            Perl_croak(aTHX_ PL_no_usym, "filehandle");
@@ -7875,10 +7900,13 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **const st, GV **const gvp, const I32 lref)
        *gvp = NULL;
        return NULL;
     case SVt_PVGV:
-       gv = (GV*)sv;
-       *gvp = gv;
-       *st = GvESTASH(gv);
-       goto fix_gv;
+       if (isGV_with_GP(sv)) {
+           gv = (GV*)sv;
+           *gvp = gv;
+           *st = GvESTASH(gv);
+           goto fix_gv;
+       }
+       /* FALL THROUGH */
 
     default:
        if (SvROK(sv)) {
@@ -7893,12 +7921,12 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **const st, GV **const gvp, const I32 lref)
                *st = CvSTASH(cv);
                return cv;
            }
-           else if(isGV(sv))
+           else if(isGV_with_GP(sv))
                gv = (GV*)sv;
            else
                Perl_croak(aTHX_ "Not a subroutine reference");
        }
-       else if (isGV(sv)) {
+       else if (isGV_with_GP(sv)) {
            SvGETMAGIC(sv);
            gv = (GV*)sv;
        }
@@ -7910,7 +7938,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **const st, GV **const gvp, const I32 lref)
            return NULL;
        }
        /* Some flags to gv_fetchsv mean don't really create the GV  */
-       if (SvTYPE(gv) != SVt_PVGV) {
+       if (!isGV_with_GP(gv)) {
            *st = NULL;
            return NULL;
        }
@@ -8125,7 +8153,8 @@ Perl_sv_reftype(pTHX_ const SV *const sv, const int ob)
        case SVt_PVAV:          return "ARRAY";
        case SVt_PVHV:          return "HASH";
        case SVt_PVCV:          return "CODE";
-       case SVt_PVGV:          return "GLOB";
+       case SVt_PVGV:          return (char *) (isGV_with_GP(sv)
+                                   ? "GLOB" : "SCALAR");
        case SVt_PVFM:          return "FORMAT";
        case SVt_PVIO:          return "IO";
        case SVt_BIND:          return "BIND";