X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=ee705ada893a54306f32a2e94d8ab795c26b11b9;hb=32babee08ee923133079392c9eae66cc543e1115;hp=0cd694038aa65e19cc5acf8ae666f4c22d6da8cf;hpb=308d26d578ee2df470607dca403b28c61f26c974;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index 0cd6940..ee705ad 100644 --- 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; } @@ -397,10 +429,7 @@ Perl_mg_free(pTHX_ SV *sv) return 0; } - -#if !defined(NSIG) || defined(M_UNIX) || defined(__unix) || defined(M_XENIX) #include -#endif U32 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) @@ -494,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 '+': @@ -569,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') { @@ -651,8 +677,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setsv(sv, &PL_sv_undef); break; case '\017': /* ^O & ^OPEN */ - if (*(mg->mg_ptr+1) == '\0') + if (*(mg->mg_ptr+1) == '\0') { sv_setpv(sv, PL_osname); + SvTAINTED_off(sv); + } else if (strEQ(mg->mg_ptr, "\017PEN")) { if (!PL_compiling.cop_io) sv_setsv(sv, &PL_sv_undef); @@ -1784,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; } @@ -1930,14 +1963,14 @@ Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg) SV **svp = AvARRAY(av); I32 i = AvFILLp(av); while (i >= 0) { - if (svp[i] && svp[i] != &PL_sv_undef) { + if (svp[i]) { if (!SvWEAKREF(svp[i])) Perl_croak(aTHX_ "panic: magic_killbackrefs"); /* XXX Should we check that it hasn't changed? */ SvRV(svp[i]) = 0; (void)SvOK_off(svp[i]); SvWEAKREF_off(svp[i]); - svp[i] = &PL_sv_undef; + svp[i] = Nullsv; } i--; } @@ -2092,12 +2125,14 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) break; case '\017': /* ^O */ if (*(mg->mg_ptr+1) == '\0') { - if (PL_osname) + if (PL_osname) { Safefree(PL_osname); - if (SvOK(sv)) - PL_osname = savepv(SvPV(sv,len)); - else PL_osname = Nullch; + } + if (SvOK(sv)) { + TAINT_PROPER("assigning to $^O"); + PL_osname = savepv(SvPV(sv,len)); + } } else if (strEQ(mg->mg_ptr, "\017PEN")) { if (!PL_compiling.cop_io) @@ -2512,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; @@ -2531,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: */ @@ -2595,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)