[inseparable changes from patch from perl5.003_18 to perl5.003_19]

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

diff --git a/sv.c b/sv.c
index 87a1a2d..d8704b8 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1288,7 +1288,7 @@ register SV *sv;
     switch (SvTYPE(sv)) {
     case SVt_NULL:
        sv_upgrade(sv, SVt_IV);
-       return SvIVX(sv);
+       break;
     case SVt_PV:
        sv_upgrade(sv, SVt_PVIV);
        break;
@@ -1357,7 +1357,7 @@ register SV *sv;
     switch (SvTYPE(sv)) {
     case SVt_NULL:
        sv_upgrade(sv, SVt_IV);
-       return SvUVX(sv);
+       break;
     case SVt_PV:
        sv_upgrade(sv, SVt_PVIV);
        break;
@@ -1938,8 +1938,14 @@ register SV *sstr;
                        GvIMPORTED_HV_on(dstr);
                    break;
                case SVt_PVCV:
-                   if (intro)
+                   if (intro) {
+                       if (GvCVGEN(dstr) && GvCV(dstr) != (CV*)sref) {
+                           SvREFCNT_dec(GvCV(dstr));
+                           GvCV(dstr) = Nullcv;
+                           GvCVGEN(dstr) = 0;
+                       }
                        SAVESPTR(GvCV(dstr));
+                   }
                    else {
                        CV* cv = GvCV(dstr);
                        if (cv) {
@@ -1949,12 +1955,13 @@ register SV *sstr;
                                    (CvROOT(cv) || CvXSUB(cv)) )
                                warn("Subroutine %s redefined",
                                    GvENAME((GV*)dstr));
-                           SvFAKE_on(cv);
                        }
                    }
                    if (GvCV(dstr) != (CV*)sref) {
                        GvCV(dstr) = (CV*)sref;
+                       GvCVGEN(dstr) = 0; /* Switch off cacheness. */
                        GvASSUMECV_on(dstr);
+                       sub_generation++;
                    }
                    if (curcop->cop_stash != GvSTASH(dstr))
                        GvIMPORTED_CV_on(dstr);
@@ -2579,15 +2586,15 @@ register SV *sv;
     assert(SvREFCNT(sv) == 0);
 
     if (SvOBJECT(sv)) {
-       dSP;
-       GV* destructor;
-
        if (defstash) {         /* Still have a symbol table? */
-           destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
+           dSP;
+           GV* destructor;
 
            ENTER;
            SAVEFREESV(SvSTASH(sv));
-           if (destructor && GvCV(destructor)) {
+
+           destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
+           if (destructor) {
                SV ref;
 
                Zero(&ref, 1, SV);
@@ -2599,10 +2606,12 @@ register SV *sv;
                PUSHMARK(SP);
                PUSHs(&ref);
                PUTBACK;
-               perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR);
+               perl_call_sv((SV*)GvCV(destructor),
+                            G_DISCARD|G_EVAL|G_KEEPERR);
                del_XRV(SvANY(&ref));
                SvREFCNT(sv)--;
            }
+
            LEAVE;
        }
        else
@@ -2897,40 +2906,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);
     }
@@ -3580,7 +3591,7 @@ I32 lref;
            return Nullcv;
        *st = GvESTASH(gv);
     fix_gv:
-       if (lref && !GvCV(gv)) {
+       if (lref && !GvCVu(gv)) {
            SV *tmpsv;
            ENTER;
            tmpsv = NEWSV(704,0);
@@ -3590,10 +3601,10 @@ I32 lref;
                   Nullop,
                   Nullop);
            LEAVE;
-           if (!GvCV(gv))
+           if (!GvCVu(gv))
                croak("Unable to create sub named \"%s\"", SvPV(sv,na));
        }
-       return GvCV(gv);
+       return GvCVu(gv);
     }
 }
 
@@ -3952,7 +3963,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;
@@ -3963,7 +3974,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;
@@ -4046,9 +4057,6 @@ SV* sv;
              strcat(d, " ),");
          }
       }
-#ifdef OVERLOAD
-      if (flags & SVpgv_AM)    strcat(d, "withOVERLOAD,");
-#endif /* OVERLOAD */
     }
 
     d += strlen(d);