This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Correct the IO::Select version in perldelta
[perl5.git] / mg.c
diff --git a/mg.c b/mg.c
index efc4d6e..1ac7e31 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -286,7 +286,7 @@ Perl_mg_set(pTHX_ SV *sv)
            mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
            (SSPTR(mgs_ix, MGS*))->mgs_magical = 0;
        }
-       if (PL_localizing == 2 && !S_is_container_magic(mg))
+       if (PL_localizing == 2 && (!S_is_container_magic(mg) || sv == DEFSV))
            continue;
        if (vtbl && vtbl->svt_set)
            vtbl->svt_set(aTHX_ sv, mg);
@@ -511,6 +511,9 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv, bool setmagic)
 
     PERL_ARGS_ASSERT_MG_LOCALIZE;
 
+    if (nsv == DEFSV)
+       return;
+
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
        const MGVTBL* const vtbl = mg->mg_virtual;
        if (!S_is_container_magic(mg))
@@ -1434,6 +1437,14 @@ Perl_csighandler_init(void)
 }
 #endif
 
+#if defined HAS_SIGPROCMASK
+static void
+unblock_sigmask(pTHX_ void* newset)
+{
+    sigprocmask(SIG_UNBLOCK, (sigset_t*)newset, NULL);
+}
+#endif
+
 void
 Perl_despatch_signals(pTHX)
 {
@@ -1443,15 +1454,38 @@ Perl_despatch_signals(pTHX)
     for (sig = 1; sig < SIG_SIZE; sig++) {
        if (PL_psig_pend[sig]) {
            dSAVE_ERRNO;
-           PERL_BLOCKSIG_ADD(set, sig);
+#ifdef HAS_SIGPROCMASK
+           /* From sigaction(2) (FreeBSD man page):
+            * | Signal routines normally execute with the signal that
+            * | caused their invocation blocked, but other signals may
+            * | yet occur.
+            * Emulation of this behavior (from within Perl) is enabled
+            * using sigprocmask
+            */
+           int was_blocked;
+           sigset_t newset, oldset;
+
+           sigemptyset(&newset);
+           sigaddset(&newset, sig);
+           sigprocmask(SIG_BLOCK, &newset, &oldset);
+           was_blocked = sigismember(&oldset, sig);
+           if (!was_blocked) {
+               SV* save_sv = newSVpvn((char *)(&newset), sizeof(sigset_t));
+               ENTER;
+               SAVEFREESV(save_sv);
+               SAVEDESTRUCTOR_X(unblock_sigmask, SvPV_nolen(save_sv));
+           }
+#endif
            PL_psig_pend[sig] = 0;
-           PERL_BLOCKSIG_BLOCK(set);
 #if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
            (*PL_sighandlerp)(sig, NULL, NULL);
 #else
            (*PL_sighandlerp)(sig);
 #endif
-           PERL_BLOCKSIG_UNBLOCK(set);
+#ifdef HAS_SIGPROCMASK
+           if (!was_blocked)
+               LEAVE;
+#endif
            RESTORE_ERRNO;
        }
     }
@@ -1715,7 +1749,7 @@ Perl_magic_setnkeys(pTHX_ SV *sv, MAGIC *mg)
 
 Invoke a magic method (like FETCH).
 
-* sv and mg are the tied thinggy and the tie magic;
+* sv and mg are the tied thingy and the tie magic;
 * meth is the name of the method to call;
 * argc is the number of args (in addition to $self) to pass to the method;
        the args themselves are any values following the argc argument.
@@ -2970,7 +3004,7 @@ Perl_whichsig(pTHX_ const char *sig)
 
 Signal_t
 #if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
-Perl_sighandler(int sig, siginfo_t *sip, void *uap PERL_UNUSED_DECL)
+Perl_sighandler(int sig, siginfo_t *sip, void *uap)
 #else
 Perl_sighandler(int sig)
 #endif
@@ -2997,20 +3031,14 @@ Perl_sighandler(int sig)
                exit(sig);
        }
 
-    /* Max number of items pushed there is 3*n or 4. We cannot fix
-       infinity, so we fix 4 (in fact 5): */
-    if (PL_savestack_ix + 15 <= PL_savestack_max) {
-       flags |= 1;
-       PL_savestack_ix += 5;           /* Protect save in progress. */
-       SAVEDESTRUCTOR_X(S_unwind_handler_stack, NULL);
-    }
-    if (PL_markstack_ptr < PL_markstack_max - 2) {
-       flags |= 2;
-       PL_markstack_ptr++;             /* Protect mark. */
-    }
-    if (PL_scopestack_ix < PL_scopestack_max - 3) {
-       flags |= 4;
-       PL_scopestack_ix++;
+    if (PL_signals &  PERL_SIGNALS_UNSAFE_FLAG) {
+       /* Max number of items pushed there is 3*n or 4. We cannot fix
+          infinity, so we fix 4 (in fact 5): */
+       if (PL_savestack_ix + 15 <= PL_savestack_max) {
+           flags |= 1;
+           PL_savestack_ix += 5;               /* Protect save in progress. */
+           SAVEDESTRUCTOR_X(S_unwind_handler_stack, NULL);
+       }
     }
     /* sv_2cv is too complicated, try a simpler variant first: */
     if (!SvROK(PL_psig_ptr[sig]) || !(cv = MUTABLE_CV(SvRV(PL_psig_ptr[sig])))
@@ -3034,9 +3062,11 @@ Perl_sighandler(int sig)
     flags |= 8;
     SAVEFREESV(sv);
 
-    /* make sure our assumption about the size of the SAVEs are correct:
-     * 3 for SAVEDESTRUCTOR_X, 2 for SAVEFREESV */
-    assert(old_ss_ix + 2 + ((flags & 1) ? 3+5 : 0)  == PL_savestack_ix);
+    if (PL_signals &  PERL_SIGNALS_UNSAFE_FLAG) {
+       /* make sure our assumption about the size of the SAVEs are correct:
+        * 3 for SAVEDESTRUCTOR_X, 2 for SAVEFREESV */
+       assert(old_ss_ix + 2 + ((flags & 1) ? 3+5 : 0)  == PL_savestack_ix);
+    }
 
     PUSHSTACKi(PERLSI_SIGNAL);
     PUSHMARK(SP);
@@ -3076,15 +3106,20 @@ Perl_sighandler(int sig)
     POPSTACK;
     if (SvTRUE(ERRSV)) {
 #ifndef PERL_MICRO
-#ifdef HAS_SIGPROCMASK
        /* Handler "died", for example to get out of a restart-able read().
         * Before we re-do that on its behalf re-enable the signal which was
         * blocked by the system when we entered.
         */
-       sigset_t set;
-       sigemptyset(&set);
-       sigaddset(&set,sig);
-       sigprocmask(SIG_UNBLOCK, &set, NULL);
+#ifdef HAS_SIGPROCMASK
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+       if (sip || uap)
+#endif
+       {
+           sigset_t set;
+           sigemptyset(&set);
+           sigaddset(&set,sig);
+           sigprocmask(SIG_UNBLOCK, &set, NULL);
+       }
 #else
        /* Not clear if this will work */
        (void)rsignal(sig, SIG_IGN);
@@ -3096,10 +3131,6 @@ Perl_sighandler(int sig)
 cleanup:
     /* pop any of SAVEFREESV, SAVEDESTRUCTOR_X and "save in progress" */
     PL_savestack_ix = old_ss_ix;
-    if (flags & 2)
-       PL_markstack_ptr--;
-    if (flags & 4)
-       PL_scopestack_ix -= 1;
     if (flags & 8)
        SvREFCNT_dec(sv);
     PL_op = myop;                      /* Apparently not needed... */
@@ -3185,8 +3216,7 @@ S_restore_magic(pTHX_ const void *p)
 /* 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
- * skipped over. This is why we don't need to fix up the markstack and
- * scopestack - they're going to be set to 0 anyway */
+ * skipped over. */
 
 static void
 S_unwind_handler_stack(pTHX_ const void *p)