DB_File 1.810

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

diff --git a/mg.c b/mg.c
index 9f3075d..ee705ad 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1,7 +1,7 @@
 /*    mg.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -15,6 +15,24 @@
 
 /*
 =head1 Magical Functions
+
+"Magic" is special data attached to SV structures in order to give them
+"magical" properties.  When any Perl code tries to read from, or assign to,
+an SV marked as magical, it calls the 'get' or 'set' function associated
+with that SV's magic. A get is called prior to reading an SV, in order to
+give it a chance to update its internal value (get on $. writes the line
+number of the last read filehandle into to the SV's IV slot), while
+set is called after an SV has been written to, in order to allow it to make
+use of its changed value (set on $/ copies the SV's new value to the
+PL_rs global variable).
+
+Magic is implemented as a linked list of MAGIC structures attached to the
+SV. Each MAGIC struct holds the type of the magic, a pointer to an array
+of functions that implement the get(), set(), length() etc functions,
+plus space for some flags and pointers. For example, a tied variable has
+a MAGIC structure that contains a pointer to the object associated with the
+tie.
+
 */
 
 #include "EXTERN.h"
@@ -129,6 +147,18 @@ Perl_mg_get(pTHX_ SV *sv)
     int new = 0;
     MAGIC *newmg, *head, *cur, *mg;
     I32 mgs_ix = SSNEW(sizeof(MGS));
+    int was_temp = SvTEMP(sv);
+    /* guard against sv having being freed midway by holding a private
+       reference. */
+
+    /* sv_2mortal has this side effect of turning on the TEMP flag, which can
+       cause the SV's buffer to get stolen (and maybe other stuff).
+       So restore it.
+    */
+    sv_2mortal(SvREFCNT_inc(sv));
+    if (!was_temp) {
+       SvTEMP_off(sv);
+    }
 
     save_magic(mgs_ix, sv);
 
@@ -143,10 +173,6 @@ Perl_mg_get(pTHX_ SV *sv)
        if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
            CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg);
 
-           /* guard against sv having been freed */
-           if (SvTYPE(sv) == SVTYPEMASK) {
-               Perl_croak(aTHX_ "Tied variable freed while still in use");
-           }
            /* guard against magic having been deleted - eg FETCH calling
             * untie */
            if (!SvMAGIC(sv))
@@ -178,6 +204,12 @@ Perl_mg_get(pTHX_ SV *sv)
     }
 
     restore_magic(aTHX_ INT2PTR(void *, (IV)mgs_ix));
+
+    if (SvREFCNT(sv) == 1) {
+       /* We hold the last reference to this SV, which implies that the
+          SV was deleted as a side effect of the routines we called.  */
+       (void)SvOK_off(sv);
+    }
     return 0;
 }
 
@@ -491,12 +523,12 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
            }
            else {
                if (ckWARN(WARN_UNINITIALIZED))
-                   report_uninit();
+                   report_uninit(sv);
            }
        }
        else {
            if (ckWARN(WARN_UNINITIALIZED))
-               report_uninit();
+               report_uninit(sv);
        }
        return 0;
     case '+':
@@ -566,9 +598,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 
     case '\004':               /* ^D */
        sv_setiv(sv, (IV)(PL_debug & DEBUG_MASK));
-#if defined(YYDEBUG) && defined(DEBUGGING)
-       PL_yydebug = DEBUG_p_TEST;
-#endif
        break;
     case '\005':  /* ^E */
         if (*(mg->mg_ptr+1) == '\0') {
@@ -1783,16 +1812,21 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
        sv_utf8_upgrade(lsv);
        sv_pos_u2b(lsv, &lvoff, &lvlen);
        sv_insert(lsv, lvoff, lvlen, tmps, len);
+       LvTARGLEN(sv) = sv_len_utf8(sv);
        SvUTF8_on(lsv);
     }
     else if (lsv && SvUTF8(lsv)) {
        sv_pos_u2b(lsv, &lvoff, &lvlen);
+       LvTARGLEN(sv) = len;
        tmps = (char*)bytes_to_utf8((U8*)tmps, &len);
        sv_insert(lsv, lvoff, lvlen, tmps, len);
        Safefree(tmps);
     }
-    else
-        sv_insert(lsv, lvoff, lvlen, tmps, len);
+    else {
+       sv_insert(lsv, lvoff, lvlen, tmps, len);
+       LvTARGLEN(sv) = len;
+    }
+
 
     return 0;
 }
@@ -2513,8 +2547,6 @@ Perl_sighandler(int sig)
        flags |= 1;
     if (PL_markstack_ptr < PL_markstack_max - 2)
        flags |= 4;
-    if (PL_retstack_ix < PL_retstack_max - 2)
-       flags |= 8;
     if (PL_scopestack_ix < PL_scopestack_max - 3)
        flags |= 16;
 
@@ -2532,10 +2564,6 @@ Perl_sighandler(int sig)
     }
     if (flags & 4)
        PL_markstack_ptr++;             /* Protect mark. */
-    if (flags & 8) {
-       PL_retstack_ix++;
-       PL_retstack[PL_retstack_ix] = NULL;
-    }
     if (flags & 16)
        PL_scopestack_ix += 1;
     /* sv_2cv is too complicated, try a simpler variant first: */
@@ -2596,8 +2624,6 @@ cleanup:
        PL_savestack_ix -= 8; /* Unprotect save in progress. */
     if (flags & 4)
        PL_markstack_ptr--;
-    if (flags & 8)
-       PL_retstack_ix--;
     if (flags & 16)
        PL_scopestack_ix -= 1;
     if (flags & 64)