This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert "Mention the unit of time"
[perl5.git] / mg.c
diff --git a/mg.c b/mg.c
index 1bc5bf7..5cfa8cb 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -383,15 +383,18 @@ Perl_mg_clear(pTHX_ SV *sv)
 {
     const I32 mgs_ix = SSNEW(sizeof(MGS));
     MAGIC* mg;
+    MAGIC *nextmg;
 
     PERL_ARGS_ASSERT_MG_CLEAR;
 
     save_magic(mgs_ix, sv);
 
-    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+    for (mg = SvMAGIC(sv); mg; mg = nextmg) {
         const MGVTBL* const vtbl = mg->mg_virtual;
        /* omit GSKIP -- never set here */
 
+       nextmg = mg->mg_moremagic; /* it may delete itself */
+
        if (vtbl && vtbl->svt_clear)
            CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg);
     }
@@ -974,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
@@ -1234,10 +1238,14 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     /* Are we fetching a signal entry? */
-    const I32 i = whichsig(MgPV_nolen_const(mg));
+    int i = (I16)mg->mg_private;
 
     PERL_ARGS_ASSERT_MAGIC_GETSIG;
 
+    if (!i) {
+       mg->mg_private = i = whichsig(MgPV_nolen_const(mg));
+    }
+
     if (i > 0) {
        if(PL_psig_ptr[i])
            sv_setsv(sv,PL_psig_ptr[i]);
@@ -1308,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]++;
@@ -1322,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);
@@ -1413,7 +1422,11 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
        }
     }
     else {
-       i = whichsig(s);        /* ...no, a brick */
+       i = (I16)mg->mg_private;
+       if (!i) {
+           i = whichsig(s);    /* ...no, a brick */
+           mg->mg_private = (U16)i;
+       }
        if (i <= 0) {
            if (sv && ckWARN(WARN_SIGNAL))
                Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", s);
@@ -1522,38 +1535,17 @@ int
 Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
-    HV* stash;
-
     PERL_ARGS_ASSERT_MAGIC_SETISA;
     PERL_UNUSED_ARG(sv);
 
-    /* Bail out if destruction is going on */
-    if(PL_dirty) return 0;
-
     /* Skip _isaelem because _isa will handle it shortly */
     if (PL_delaymagic & DM_ARRAY && mg->mg_type == PERL_MAGIC_isaelem)
        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)
 {
@@ -1565,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
@@ -2560,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);
        }