Change of email address.

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index 5cfcc46..30ac035 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -123,16 +123,21 @@ Perl_mg_magical(pTHX_ SV *sv)
     const MAGIC* mg;
     PERL_ARGS_ASSERT_MG_MAGICAL;
     PERL_UNUSED_CONTEXT;
-    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-       const MGVTBL* const vtbl = mg->mg_virtual;
-       if (vtbl) {
-           if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
-               SvGMAGICAL_on(sv);
-           if (vtbl->svt_set)
-               SvSMAGICAL_on(sv);
-           if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
-               SvRMAGICAL_on(sv);
-       }
+    if ((mg = SvMAGIC(sv))) {
+       SvRMAGICAL_off(sv);
+       do {
+           const MGVTBL* const vtbl = mg->mg_virtual;
+           if (vtbl) {
+               if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
+                   SvGMAGICAL_on(sv);
+               if (vtbl->svt_set)
+                   SvSMAGICAL_on(sv);
+               if (vtbl->svt_clear)
+                   SvRMAGICAL_on(sv);
+           }
+       } while ((mg = mg->mg_moremagic));
+       if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)))
+           SvRMAGICAL_on(sv);
     }
 }
 
@@ -527,6 +532,7 @@ Perl_mg_free(pTHX_ SV *sv)
        SvMAGIC_set(sv, moremagic);
     }
     SvMAGIC_set(sv, NULL);
+    SvMAGICAL_off(sv);
     return 0;
 }
 
@@ -1324,35 +1330,6 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
     return 0;
 }
 
-/*
- * The signal handling nomenclature has gotten a bit confusing since the advent of
- * safe signals.  S_raise_signal only raises signals by analogy with what the 
- * underlying system's signal mechanism does.  It might be more proper to say that
- * it defers signals that have already been raised and caught.  
- *
- * PL_sig_pending and PL_psig_pend likewise do not track signals that are pending 
- * in the sense of being on the system's signal queue in between raising and delivery.  
- * They are only pending on Perl's deferral list, i.e., they track deferred signals 
- * awaiting delivery after the current Perl opcode completes and say nothing about
- * signals raised but not yet caught in the underlying signal implementation.
- */
-
-#ifndef SIG_PENDING_DIE_COUNT
-#  define SIG_PENDING_DIE_COUNT 120
-#endif
-
-static void
-S_raise_signal(pTHX_ int sig)
-{
-    dVAR;
-    /* Set a flag to say this signal is pending */
-    PL_psig_pend[sig]++;
-    /* And 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);
-}
-
 Signal_t
 #if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
 Perl_csighandler(int sig, siginfo_t *sip PERL_UNUSED_DECL, void *uap PERL_UNUSED_DECL)
@@ -1365,8 +1342,6 @@ Perl_csighandler(int sig)
 #else
     dTHX;
 #endif
-#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
-#endif
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
     (void) rsignal(sig, PL_csighandlerp);
     if (PL_sig_ignoring[sig]) return;
@@ -1379,9 +1354,7 @@ Perl_csighandler(int sig)
             exit(1);
 #endif
 #endif
-#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
-#endif
-   if (
+    if (
 #ifdef SIGILL
           sig == SIGILL ||
 #endif
@@ -1399,8 +1372,19 @@ Perl_csighandler(int sig)
 #else
        (*PL_sighandlerp)(sig);
 #endif
-   else
-       S_raise_signal(aTHX_ sig);
+    else {
+       /* Set a flag to say this signal is pending, that is awaiting delivery after
+        * the current Perl opcode completes */
+       PL_psig_pend[sig]++;
+
+#ifndef SIG_PENDING_DIE_COUNT
+#  define SIG_PENDING_DIE_COUNT 120
+#endif
+       /* And 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);
+    }
 }
 
 #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
@@ -1513,7 +1497,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
        PL_psig_name[i] = newSVpvn(s, len);
        SvREADONLY_on(PL_psig_name[i]);
     }
-    if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
+    if (isGV_with_GP(sv) || SvROK(sv)) {
        if (i) {
            (void)rsignal(i, PL_csighandlerp);
 #ifdef HAS_SIGPROCMASK
@@ -1555,7 +1539,8 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
         * tell whether HINT_STRICT_REFS is in force or not.
         */
        if (!strchr(s,':') && !strchr(s,'\''))
-           Perl_sv_insert(aTHX_ sv, 0, 0, STR_WITH_LEN("main::"));
+           Perl_sv_insert_flags(aTHX_ sv, 0, 0, STR_WITH_LEN("main::"),
+                                SV_GMAGIC);
        if (i)
            (void)rsignal(i, PL_csighandlerp);
        else
@@ -1598,10 +1583,11 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
     stash = GvSTASH(
         SvTYPE(mg->mg_obj) == SVt_PVGV
             ? (GV*)mg->mg_obj
-            : (GV*)SvMAGIC(mg->mg_obj)->mg_obj
+            : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
     );
 
-    mro_isa_changed_in(stash);
+    if (stash)
+       mro_isa_changed_in(stash);
 
     return 0;
 }
@@ -1623,10 +1609,11 @@ Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg)
     stash = GvSTASH(
         SvTYPE(mg->mg_obj) == SVt_PVGV
             ? (GV*)mg->mg_obj
-            : (GV*)SvMAGIC(mg->mg_obj)->mg_obj
+            : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
     );
 
-    mro_isa_changed_in(stash);
+    if (stash)
+       mro_isa_changed_in(stash);
 
     return 0;
 }
@@ -3135,7 +3122,7 @@ Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
 }
 
 /*
-=for apidoc magic_sethint
+=for apidoc magic_clearhint
 
 Triggered by a delete from %^H, records the key to
 C<PL_compiling.cop_hints_hash>.