diff options
Diffstat (limited to 'mg.c')
| -rw-r--r-- | mg.c | 187 |
1 files changed, 81 insertions, 106 deletions
@@ -76,6 +76,7 @@ void setegid(uid_t id); #endif /* + * Pre-magic setup and post-magic takedown. * Use the "DESTRUCTOR" scope cleanup to reinstate magic. */ @@ -97,6 +98,8 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv) PERL_ARGS_ASSERT_SAVE_MAGIC; + assert(SvMAGICAL(sv)); + /* we shouldn't really be called here with RC==0, but it can sometimes * happen via mg_clear() (which also shouldn't be called when RC==0, * but it can happen). Handle this case gracefully(ish) by not RC++ @@ -108,11 +111,10 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv) bumped = TRUE; } - assert(SvMAGICAL(sv)); /* Turning READONLY off for a copy-on-write scalar (including shared hash keys) is a bad idea. */ if (SvIsCOW(sv)) - sv_force_normal_flags(sv, 0); + sv_force_normal_flags(sv, 0); SAVEDESTRUCTOR_X(S_restore_magic, INT2PTR(void*, (IV)mgs_ix)); @@ -125,9 +127,66 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv) SvMAGICAL_off(sv); SvREADONLY_off(sv); - if (!(SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK))) { - /* No public flags are set, so promote any private flags to public. */ - SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; +} + +static void +S_restore_magic(pTHX_ const void *p) +{ + dVAR; + MGS* const mgs = SSPTR(PTR2IV(p), MGS*); + SV* const sv = mgs->mgs_sv; + bool bumped; + + if (!sv) + return; + + if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { + SvTEMP_off(sv); /* if it's still magical, this value isn't temporary */ +#ifdef PERL_OLD_COPY_ON_WRITE + /* While magic was saved (and off) sv_setsv may well have seen + this SV as a prime candidate for COW. */ + if (SvIsCOW(sv)) + sv_force_normal_flags(sv, 0); +#endif + if (mgs->mgs_readonly) + SvREADONLY_on(sv); + if (mgs->mgs_magical) + SvFLAGS(sv) |= mgs->mgs_magical; + else + mg_magical(sv); + } + + bumped = mgs->mgs_bumped; + mgs->mgs_sv = NULL; /* mark the MGS structure as restored */ + + /* If we're still on top of the stack, pop us off. (That condition + * will be satisfied if restore_magic was called explicitly, but *not* + * if it's being called via leave_scope.) + * The reason for doing this is that otherwise, things like sv_2cv() + * may leave alloc gunk on the savestack, and some code + * (e.g. sighandler) doesn't expect that... + */ + if (PL_savestack_ix == mgs->mgs_ss_ix) + { + UV popval = SSPOPUV; + assert(popval == SAVEt_DESTRUCTOR_X); + PL_savestack_ix -= 2; + popval = SSPOPUV; + assert((popval & SAVE_MASK) == SAVEt_ALLOC); + PL_savestack_ix -= popval >> SAVE_TIGHT_SHIFT; + } + if (bumped) { + 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. + So artificially keep it alive a bit longer. + We avoid turning on the TEMP flag, which can cause the SV's + buffer to get stolen (and maybe other stuff). */ + sv_2mortal(sv); + SvTEMP_off(sv); + } + else + SvREFCNT_dec(sv); /* undo the inc in S_save_magic() */ } } @@ -948,21 +1007,17 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) else if (PL_compiling.cop_warnings == pWARN_ALL) { /* Get the bit mask for $warnings::Bits{all}, because * it could have been extended by warnings::register */ - HV * const bits=get_hv("warnings::Bits", 0); - if (bits) { - SV ** const bits_all = hv_fetchs(bits, "all", FALSE); - if (bits_all) - sv_setsv(sv, *bits_all); - } - else { - sv_setpvn(sv, WARN_ALLstring, WARNsize) ; - } + HV * const bits = get_hv("warnings::Bits", 0); + SV ** const bits_all = bits ? hv_fetchs(bits, "all", FALSE) : NULL; + if (bits_all) + sv_copypv(sv, *bits_all); + else + sv_setpvn(sv, WARN_ALLstring, WARNsize); } else { sv_setpvn(sv, (char *) (PL_compiling.cop_warnings + 1), *PL_compiling.cop_warnings); } - SvPOK_only(sv); } break; case '\015': /* $^MATCH */ @@ -1074,6 +1129,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) case '\\': if (PL_ors_sv) sv_copypv(sv, PL_ors_sv); + else + sv_setsv(sv, &PL_sv_undef); break; case '$': /* $$ */ { @@ -1089,23 +1146,22 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) { dSAVE_ERRNO; #ifdef VMS - sv_setnv(sv, (NV)((errno == EVMSERR) ? vaxc$errno : errno)); + sv_setiv(sv, (errno == EVMSERR) ? vaxc$errno : errno); #else - sv_setnv(sv, (NV)errno); + sv_setiv(sv, errno); #endif #ifdef OS2 if (errno == errno_isOS2 || errno == errno_isOS2_set) sv_setpv(sv, os2error(Perl_rc)); else #endif - sv_setpv(sv, errno ? Strerror(errno) : ""); + sv_setpv(sv, errno ? Strerror(errno) : ""); if (SvPOKp(sv)) - SvPOK_on(sv); /* may have got removed during taint processing */ + SvPOK_on(sv); /* may have got removed during taint processing - XXX OBSOLETE? CHIP */ RESTORE_ERRNO; } - SvRTRIM(sv); - SvNOK_on(sv); /* what a wonderful hack! */ + SvIOK_on(sv); /* what a wonderful hack! */ break; case '<': sv_setiv(sv, (IV)PL_uid); @@ -1324,7 +1380,6 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg) else sv_setsv(sv,&PL_sv_undef); PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv); - SvTEMP_off(sv); } } return 0; @@ -2117,7 +2172,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) found->mg_len = -1; return 0; } - len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv); + len = SvPOK_nog(lsv) ? SvCUR(lsv) : sv_len(lsv); pos = SvIV(sv); @@ -2707,13 +2762,10 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_rs = newSVsv(sv); break; case '\\': - SvREFCNT_dec(PL_ors_sv); - if (SvOK(sv) || SvGMAGICAL(sv)) { - PL_ors_sv = newSVsv(sv); - } - else { + if (SvOK(sv)) + sv_copypv(PL_ors_sv = newSV(0), sv); + else PL_ors_sv = NULL; - } break; case '[': if (SvIV(sv) != 0) @@ -3140,83 +3192,6 @@ cleanup: return; } - -static void -S_restore_magic(pTHX_ const void *p) -{ - dVAR; - MGS* const mgs = SSPTR(PTR2IV(p), MGS*); - SV* const sv = mgs->mgs_sv; - bool bumped; - - if (!sv) - return; - - if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) - { -#ifdef PERL_OLD_COPY_ON_WRITE - /* While magic was saved (and off) sv_setsv may well have seen - this SV as a prime candidate for COW. */ - if (SvIsCOW(sv)) - sv_force_normal_flags(sv, 0); -#endif - - if (mgs->mgs_readonly) - SvREADONLY_on(sv); - if (mgs->mgs_magical) - SvFLAGS(sv) |= mgs->mgs_magical; - else - mg_magical(sv); - if (SvGMAGICAL(sv)) { - /* downgrade public flags to private, - and discard any other private flags */ - - const U32 pubflags = SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK); - if (pubflags) { - SvFLAGS(sv) &= ~( pubflags | (SVp_IOK|SVp_NOK|SVp_POK) ); - SvFLAGS(sv) |= ( pubflags << PRIVSHIFT ); - } - } - } - - bumped = mgs->mgs_bumped; - mgs->mgs_sv = NULL; /* mark the MGS structure as restored */ - - /* If we're still on top of the stack, pop us off. (That condition - * will be satisfied if restore_magic was called explicitly, but *not* - * if it's being called via leave_scope.) - * The reason for doing this is that otherwise, things like sv_2cv() - * may leave alloc gunk on the savestack, and some code - * (e.g. sighandler) doesn't expect that... - */ - if (PL_savestack_ix == mgs->mgs_ss_ix) - { - UV popval = SSPOPUV; - assert(popval == SAVEt_DESTRUCTOR_X); - PL_savestack_ix -= 2; - popval = SSPOPUV; - assert((popval & SAVE_MASK) == SAVEt_ALLOC); - PL_savestack_ix -= popval >> SAVE_TIGHT_SHIFT; - } - if (bumped) { - 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. - So artificially keep it alive a bit longer. - We avoid turning on the TEMP flag, which can cause the SV's - buffer to get stolen (and maybe other stuff). */ - int was_temp = SvTEMP(sv); - sv_2mortal(sv); - if (!was_temp) { - SvTEMP_off(sv); - } - SvOK_off(sv); - } - else - SvREFCNT_dec(sv); /* undo the inc in S_save_magic() */ - } -} - /* clean up the mess created by Perl_sighandler(). * Note that this is only called during an exit in a signal handler; * a die is trapped by the call_sv() and the SAVEDESTRUCTOR_X manually |