By moving the "can't upgrade downwards" croak() in Perl_sv_upgrade()

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

diff --git a/sv.c b/sv.c
index cd7db08..42e9d91 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -544,7 +544,8 @@ Perl_sv_clean_all(pTHX)
   memory in the last arena-set (1/2 on average).  In trade, we get
   back the 1st slot in each arena (ie 1.7% of a CV-arena, less for
   smaller types).  The recovery of the wasted space allows use of
-  small arenas for large, rare body types,
+  small arenas for large, rare body types, by changing array* fields
+  in body_details_by_type[] below.
 */
 struct arena_desc {
     char       *arena;         /* the raw storage, allocated aligned */
@@ -555,7 +556,7 @@ struct arena_desc {
 struct arena_set;
 
 /* Get the maximum number of elements in set[] such that struct arena_set
-   will fit within PERL_ARENA_SIZE, which is probabably just under 4K, and
+   will fit within PERL_ARENA_SIZE, which is probably just under 4K, and
    therefore likely to be 1 aligned memory page.  */
 
 #define ARENAS_PER_SET  ((PERL_ARENA_SIZE - sizeof(struct arena_set*) \
@@ -1122,11 +1123,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     if (old_type == new_type)
        return;
 
-    if (old_type > new_type)
-       Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d",
-               (int)old_type, (int)new_type);
-
-
     old_body = SvANY(sv);
 
     /* Copying structures onto other structures that have been neatly zeroed
@@ -1207,6 +1203,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
            Perl_croak(aTHX_ "Can't upgrade %s (%" UVuf ") to %" UVuf,
                       sv_reftype(sv, 0), (UV) old_type, (UV) new_type);
     }
+
+    if (old_type > new_type)
+       Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d",
+               (int)old_type, (int)new_type);
+
     new_type_details = bodies_by_type + new_type;
 
     SvFLAGS(sv) &= ~SVTYPEMASK;
@@ -1252,6 +1253,27 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
            AvMAX(sv)   = -1;
            AvFILLp(sv) = -1;
            AvREAL_only(sv);
+           if (old_type_details->body_size) {
+               AvALLOC(sv) = 0;
+           } else {
+               /* It will have been zeroed when the new body was allocated.
+                  Lets not write to it, in case it confuses a write-back
+                  cache.  */
+           }
+       } else {
+           assert(!SvOK(sv));
+           SvOK_off(sv);
+#ifndef NODEFAULT_SHAREKEYS
+           HvSHAREKEYS_on(sv);         /* key-sharing on by default */
+#endif
+           HvMAX(sv) = 7; /* (start with 8 buckets) */
+           if (old_type_details->body_size) {
+               HvFILL(sv) = 0;
+           } else {
+               /* It will have been zeroed when the new body was allocated.
+                  Lets not write to it, in case it confuses a write-back
+                  cache.  */
+           }
        }
 
        /* SVt_NULL isn't the only thing upgraded to AV or HV.
@@ -1463,10 +1485,8 @@ Perl_sv_setiv(pTHX_ register SV *sv, IV i)
     SV_CHECK_THINKFIRST_COW_DROP(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
-       sv_upgrade(sv, SVt_IV);
-       break;
     case SVt_NV:
-       sv_upgrade(sv, SVt_PVNV);
+       sv_upgrade(sv, SVt_IV);
        break;
     case SVt_RV:
     case SVt_PV:
@@ -7978,6 +7998,8 @@ Perl_sv_bless(pTHX_ SV *sv, HV *stash)
         Perl_croak(aTHX_ "Can't bless non-reference value");
     tmpRef = SvRV(sv);
     if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
+       if (SvIsCOW(tmpRef))
+           sv_force_normal_flags(tmpRef, 0);
        if (SvREADONLY(tmpRef))
            Perl_croak(aTHX_ PL_no_modify);
        if (SvOBJECT(tmpRef)) {
@@ -12096,10 +12118,10 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
 
     case OP_ENTERSUB:
     case OP_GOTO:
-       /* XXX tmp hack: these to may call an XS sub, and currently
-         XS subs don't have a SUB entry on the context stack, so CV nad
-         pad deteminaion goes wrong, and BAD things happen. So, just
-         don't try to detemine the value under those circumanstances.
+       /* XXX tmp hack: these two may call an XS sub, and currently
+         XS subs don't have a SUB entry on the context stack, so CV and
+         pad determination goes wrong, and BAD things happen. So, just
+         don't try to determine the value under those circumstances.
          Need a better fix at dome point. DAPM 11/2007 */
        break;