X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=5cfa8cb9204aa30a35d9ef757e40907b78b60498;hb=fb6e4a4e4598d2f4d2f011525b2ff33f3b73f007;hp=157d3cdd6ec13de216845c5846f9addac1e9c03d;hpb=2243c3b2519b9854cb76fbdb41e692fd0a494fa2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index 157d3cd..5cfa8cb 100644 --- a/mg.c +++ b/mg.c @@ -977,6 +977,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) { sv_setiv(sv, (IV)STATUS_CURRENT); #ifdef COMPLEX_STATUS + SvUPGRADE(sv, SVt_PVLV); LvTARGOFF(sv) = PL_statusvalue; LvTARGLEN(sv) = PL_statusvalue_vms; #endif @@ -1315,13 +1316,14 @@ Perl_csighandler(int sig) #endif (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)) /* Call the perl level handler now-- - * with risk we may be in malloc() etc. */ + * with risk we may be in malloc() or being destructed etc. */ #if defined(HAS_SIGACTION) && defined(SA_SIGINFO) (*PL_sighandlerp)(sig, NULL, NULL); #else (*PL_sighandlerp)(sig); #endif else { + if (!PL_psig_pend) return; /* Set a flag to say this signal is pending, that is awaiting delivery after * the current Perl opcode completes */ PL_psig_pend[sig]++; @@ -1329,7 +1331,7 @@ Perl_csighandler(int sig) #ifndef SIG_PENDING_DIE_COUNT # define SIG_PENDING_DIE_COUNT 120 #endif - /* And one to say _a_ signal is pending */ + /* Add one to say _a_ signal is pending */ if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT) Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded", (unsigned long)SIG_PENDING_DIE_COUNT); @@ -1422,7 +1424,8 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) else { i = (I16)mg->mg_private; if (!i) { - mg->mg_private = i = whichsig(s); /* ...no, a brick */ + i = whichsig(s); /* ...no, a brick */ + mg->mg_private = (U16)i; } if (i <= 0) { if (sv && ckWARN(WARN_SIGNAL)) @@ -1532,8 +1535,6 @@ int Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) { dVAR; - HV* stash; - PERL_ARGS_ASSERT_MAGIC_SETISA; PERL_UNUSED_ARG(sv); @@ -1541,29 +1542,10 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) if (PL_delaymagic & DM_ARRAY && mg->mg_type == PERL_MAGIC_isaelem) return 0; - /* Bail out if destruction is going on */ - if(PL_dirty) return 0; - - /* XXX Once it's possible, we need to - detect that our @ISA is aliased in - other stashes, and act on the stashes - of all of the aliases */ - - /* The first case occurs via setisa, - the second via setisa_elem, which - calls this same magic */ - stash = GvSTASH( - SvTYPE(mg->mg_obj) == SVt_PVGV - ? (const GV *)mg->mg_obj - : (const GV *)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj - ); - - if (stash) - mro_isa_changed_in(stash); - - return 0; + return magic_clearisa(NULL, mg); } +/* sv of NULL signifies that we're acting as magic_setisa. */ int Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg) { @@ -1575,9 +1557,17 @@ Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg) /* Bail out if destruction is going on */ if(PL_dirty) return 0; - av_clear(MUTABLE_AV(sv)); + if (sv) + av_clear(MUTABLE_AV(sv)); - /* XXX see comments in magic_setisa */ + /* XXX Once it's possible, we need to + detect that our @ISA is aliased in + other stashes, and act on the stashes + of all of the aliases */ + + /* The first case occurs via setisa, + the second via setisa_elem, which + calls this same magic */ stash = GvSTASH( SvTYPE(mg->mg_obj) == SVt_PVGV ? (const GV *)mg->mg_obj @@ -2570,6 +2560,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) case '?': #ifdef COMPLEX_STATUS if (PL_localizing == 2) { + SvUPGRADE(sv, SVt_PVLV); PL_statusvalue = LvTARGOFF(sv); PL_statusvalue_vms = LvTARGLEN(sv); }