Add missing syms to global.sym; update magic doc

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

diff --git a/sv.c b/sv.c
index 95c3340..db34eb0 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -330,13 +330,17 @@ SV* sv;
 }
 #endif
 
+static bool in_clean_objs = FALSE;
+
 void
 sv_clean_objs()
 {
+    in_clean_objs = TRUE;
 #ifndef DISABLE_DESTRUCTOR_KLUDGE
     visit(do_clean_named_objs);
 #endif
     visit(do_clean_objs);
+    in_clean_objs = FALSE;
 }
 
 static void
@@ -348,14 +352,14 @@ SV* sv;
     SvREFCNT_dec(sv);
 }
 
-static int in_clean_all = 0;
+static bool in_clean_all = FALSE;
 
 void
 sv_clean_all()
 {
-    in_clean_all = 1;
+    in_clean_all = TRUE;
     visit(do_clean_all);
-    in_clean_all = 0;
+    in_clean_all = FALSE;
 }
 
 void
@@ -1945,11 +1949,14 @@ register SV *sstr;
                                    (CvROOT(cv) || CvXSUB(cv)) )
                                warn("Subroutine %s redefined",
                                    GvENAME((GV*)dstr));
-                           SvFAKE_on(cv);
+                           if (SvREFCNT(cv) == 1)
+                               SvFAKE_on(cv);
                        }
                    }
+                   sub_generation++;
                    if (GvCV(dstr) != (CV*)sref) {
                        GvCV(dstr) = (CV*)sref;
+                       GvCVGEN(dstr) = 0; /* Switch off cacheness. */
                        GvASSUMECV_on(dstr);
                    }
                    if (curcop->cop_stash != GvSTASH(dstr))
@@ -2073,7 +2080,7 @@ register SV *sstr;
 void
 sv_setpvn(sv,ptr,len)
 register SV *sv;
-register char *ptr;
+register const char *ptr;
 register STRLEN len;
 {
     assert(len >= 0);  /* STRLEN is probably unsigned, so this may
@@ -2105,7 +2112,7 @@ register STRLEN len;
 void
 sv_setpv(sv,ptr)
 register SV *sv;
-register char *ptr;
+register const char *ptr;
 {
     register STRLEN len;
 
@@ -2390,7 +2397,7 @@ I32 namlen;
        mg->mg_virtual = &vtbl_substr;
        break;
     case 'y':
-       mg->mg_virtual = &vtbl_vivary;
+       mg->mg_virtual = &vtbl_itervar;
        break;
     case '*':
        mg->mg_virtual = &vtbl_glob;
@@ -2560,6 +2567,7 @@ register SV *nsv;
     }
     SvREFCNT(sv) = 0;
     sv_clear(sv);
+    assert(!SvREFCNT(sv));
     StructCopy(nsv,sv,SV);
     SvREFCNT(sv) = refcnt;
     SvFLAGS(nsv) |= SVTYPEMASK;                /* Mark as freed */
@@ -2608,7 +2616,7 @@ register SV *sv;
                --sv_objcount;  /* XXX Might want something more general */
        }
        if (SvREFCNT(sv)) {
-           SV *ret;  
+           SV *ret;
            if ( perldb
                 && (ret = perl_get_sv("DB::ret", FALSE))
                 && SvROK(ret) && SvRV(ret) == sv && SvREFCNT(sv) == 1) {
@@ -2616,8 +2624,12 @@ register SV *sv;
                SvRV(ret) = 0;
                SvROK_off(ret);
                SvREFCNT(sv) = 0;
-           } else {
-               croak("DESTROY created new reference to dead object");
+           }
+           else {
+               if (in_clean_objs)
+                   croak("DESTROY created new reference to dead object");
+               /* DESTROY gave object new lease on life */
+               return;
            }
        }
     }
@@ -2760,7 +2772,8 @@ SV *sv;
     }
 #endif
     sv_clear(sv);
-    del_SV(sv);
+    if (! SvREFCNT(sv))
+       del_SV(sv);
 }
 
 STRLEN
@@ -2887,40 +2900,42 @@ register SV *sv2;
 }
 
 #ifdef USE_LOCALE_COLLATE
-
+/*
+ * Any scalar variable may carry an 'o' magic that contains the
+ * scalar data of the variable transformed to such a format that
+ * a normal memory comparison can be used to compare the data
+ * according to the locale settings.
+ */
 char *
 sv_collxfrm(sv, nxp)
      SV *sv;
      STRLEN *nxp;
 {
-    /* Any scalar variable may carry an 'o' magic that contains the
-     * scalar data of the variable transformed to such a format that
-     * a normal memory comparison can be used to compare the data
-     * according to the locale settings. */
-
-    MAGIC *mg = NULL;
+    MAGIC *mg;
 
-    if (SvMAGICAL(sv)) {
-       mg = mg_find(sv, 'o');
-       if (mg && *(U32*)mg->mg_ptr != collation_ix)
-           mg = NULL;
-    }
-
-    if (! mg) {
+    mg = SvMAGICAL(sv) ? mg_find(sv, 'o') : NULL;
+    if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != collation_ix) {
        char *s, *xf;
        STRLEN len, xlen;
 
+       if (mg)
+           Safefree(mg->mg_ptr);
        s = SvPV(sv, len);
        if ((xf = mem_collxfrm(s, len, &xlen))) {
-           sv_magic(sv, 0, 'o', 0, 0);
-           if ((mg = mg_find(sv, 'o'))) {
-               mg->mg_ptr = xf;
-               mg->mg_len = xlen;
+           if (! mg) {
+               sv_magic(sv, 0, 'o', 0, 0);
+               mg = mg_find(sv, 'o');
+               assert(mg);
            }
+           mg->mg_ptr = xf;
+           mg->mg_len = xlen;
+       }
+       else {
+           mg->mg_ptr = NULL;
+           mg->mg_len = -1;
        }
     }
-
-    if (mg) {
+    if (mg && mg->mg_ptr) {
        *nxp = mg->mg_len;
        return mg->mg_ptr + sizeof(collation_ix);
     }
@@ -3942,7 +3957,7 @@ void
 sv_untaint(sv)
 SV *sv;
 {
-    if (SvMAGICAL(sv)) {
+    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
        MAGIC *mg = mg_find(sv, 't');
        if (mg)
            mg->mg_len &= ~1;
@@ -3953,7 +3968,7 @@ bool
 sv_tainted(sv)
 SV *sv;
 {
-    if (SvMAGICAL(sv)) {
+    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
        MAGIC *mg = mg_find(sv, 't');
        if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv))
            return TRUE;