Merge the bulk of Perl_magic_clearsig() into Perl_magic_setsig().

The comment at the top of Perl_magic_clearsig() said:
    XXX Some of this code was copied from Perl_magic_setsig. A little
    refactoring might be in order.
and it was not wrong.

Perl_magic_clearsig() is almost equivalent to Perl_magic_setsig() with the new
signal handler as "DEFAULT". Externally, the sv parameter to Perl_magic_setsig()
was Not NULL, so use a NULL sv to signal that the code is being called as
Perl_magic_clearsig(), for the places where the behaviour of the two diverges.

diff --git a/embed.fnc b/embed.fnc
index 5f02822..7048e01 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -568,7 +568,7 @@ p   |int    |magic_setnkeys |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setpack  |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setpos   |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setregexp|NN SV* sv|NN MAGIC* mg
-p      |int    |magic_setsig   |NN SV* sv|NN MAGIC* mg
+p      |int    |magic_setsig   |NULLOK SV* sv|NN MAGIC* mg
 p      |int    |magic_setsubstr|NN SV* sv|NN MAGIC* mg
 p      |int    |magic_settaint |NN SV* sv|NN MAGIC* mg
 p      |int    |magic_setuvar  |NN SV* sv|NN MAGIC* mg

diff --git a/mg.c b/mg.c
index 025061f..55d46d2 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1265,70 +1265,10 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
 {
-    /* XXX Some of this code was copied from Perl_magic_setsig. A little
-     * refactoring might be in order.
-     */
-    dVAR;
-    register const char * const s = MgPV_nolen_const(mg);
     PERL_ARGS_ASSERT_MAGIC_CLEARSIG;
     PERL_UNUSED_ARG(sv);
-    if (*s == '_') {
-       SV** svp = NULL;
-       if (strEQ(s,"__DIE__"))
-           svp = &PL_diehook;
-       else if (strEQ(s,"__WARN__") && PL_warnhook != PERL_WARNHOOK_FATAL)
-           svp = &PL_warnhook;
-       if (svp && *svp) {
-           SV *const to_dec = *svp;
-           *svp = NULL;
-           SvREFCNT_dec(to_dec);
-       }
-    }
-    else {
-       /* Are we clearing a signal entry? */
-       const I32 i = whichsig(s);
-       if (i > 0) {
-#ifdef HAS_SIGPROCMASK
-           sigset_t set, save;
-           SV* save_sv;
-           /* Avoid having the signal arrive at a bad time, if possible. */
-           sigemptyset(&set);
-           sigaddset(&set,i);
-           sigprocmask(SIG_BLOCK, &set, &save);
-           ENTER;
-           save_sv = newSVpvn((char *)(&save), sizeof(sigset_t));
-           SAVEFREESV(save_sv);
-           SAVEDESTRUCTOR_X(restore_sigmask, save_sv);
-#endif
-           PERL_ASYNC_CHECK();
-#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
-           if (!PL_sig_handlers_initted) Perl_csighandler_init();
-#endif
-#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
-           PL_sig_defaulting[i] = 1;
-           (void)rsignal(i, PL_csighandlerp);
-#else
-           (void)rsignal(i, (Sighandler_t) SIG_DFL);
-#endif
-           if(PL_psig_name[i]) {
-               SvREFCNT_dec(PL_psig_name[i]);
-               PL_psig_name[i]=0;
-           }
-           if(PL_psig_ptr[i]) {
-               SV * const to_dec=PL_psig_ptr[i];
-               PL_psig_ptr[i]=0;
-#ifdef HAS_SIGPROCMASK
-               LEAVE;
-#endif
-               SvREFCNT_dec(to_dec);
-           }
-#ifdef HAS_SIGPROCMASK
-           else
-               LEAVE;
-#endif
-       }
-    }
 
+    magic_setsig(NULL, mg);
     return sv_unmagic(sv, mg->mg_type);
 }
 
@@ -1431,6 +1371,7 @@ Perl_despatch_signals(pTHX)
     }
 }
 
+/* sv of NULL signifies that we're acting as magic_clearsig.  */
 int
 Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 {
@@ -1454,12 +1395,18 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     if (*s == '_') {
        if (strEQ(s,"__DIE__"))
            svp = &PL_diehook;
-       else if (strEQ(s,"__WARN__"))
+       else if (strEQ(s,"__WARN__")
+                && (sv ? 1 : PL_warnhook != PERL_WARNHOOK_FATAL)) {
+           /* Merge the existing behaviours, which are as follows:
+              magic_setsig, we always set svp to &PL_warnhook
+              (hence we always change the warnings handler)
+              For magic_clearsig, we don't change the warnings handler if it's
+              set to the &PL_warnhook.  */
            svp = &PL_warnhook;
-       else
+       } else if (sv)
            Perl_croak(aTHX_ "No such hook: %s", s);
        i = 0;
-       if (*svp) {
+       if (svp && *svp) {
            if (*svp != PERL_WARNHOOK_FATAL)
                to_dec = *svp;
            *svp = NULL;
@@ -1468,7 +1415,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     else {
        i = whichsig(s);        /* ...no, a brick */
        if (i <= 0) {
-           if (ckWARN(WARN_SIGNAL))
+           if (sv && ckWARN(WARN_SIGNAL))
                Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", s);
            return 0;
        }
@@ -1494,12 +1441,17 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #endif
        SvREFCNT_dec(PL_psig_name[i]);
        to_dec = PL_psig_ptr[i];
-       PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv);
-       SvTEMP_off(sv); /* Make sure it doesn't go away on us */
-       PL_psig_name[i] = newSVpvn(s, len);
-       SvREADONLY_on(PL_psig_name[i]);
+       if (sv) {
+           PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv);
+           SvTEMP_off(sv); /* Make sure it doesn't go away on us */
+           PL_psig_name[i] = newSVpvn(s, len);
+           SvREADONLY_on(PL_psig_name[i]);
+       } else {
+           PL_psig_name[i] = NULL;
+           PL_psig_ptr[i] = NULL;
+       }
     }
-    if (isGV_with_GP(sv) || SvROK(sv)) {
+    if (sv && (isGV_with_GP(sv) || SvROK(sv))) {
        if (i) {
            (void)rsignal(i, PL_csighandlerp);
 #ifdef HAS_SIGPROCMASK
@@ -1512,8 +1464,12 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
            SvREFCNT_dec(to_dec);
        return 0;
     }
-    s = SvOK(sv) ? SvPV_force(sv,len) : "DEFAULT";
-    if (strEQ(s,"IGNORE")) {
+    if (sv && SvOK(sv)) {
+       s = SvPV_force(sv, len);
+    } else {
+       sv = NULL;
+    }
+    if (sv && strEQ(s,"IGNORE")) {
        if (i) {
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
            PL_sig_ignoring[i] = 1;
@@ -1523,7 +1479,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #endif
        }
     }
-    else if (strEQ(s,"DEFAULT") || !*s) {
+    else if (!sv || strEQ(s,"DEFAULT") || !len) {
        if (i) {
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
            PL_sig_defaulting[i] = 1;

diff --git a/proto.h b/proto.h
index 3f95eb5..b34e9a8 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1731,10 +1731,9 @@ PERL_CALLCONV int        Perl_magic_setregexp(pTHX_ SV* sv, MAGIC* mg)
        assert(sv); assert(mg)
 
 PERL_CALLCONV int      Perl_magic_setsig(pTHX_ SV* sv, MAGIC* mg)
-                       __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_MAGIC_SETSIG  \
-       assert(sv); assert(mg)
+       assert(mg)
 
 PERL_CALLCONV int      Perl_magic_setsubstr(pTHX_ SV* sv, MAGIC* mg)
                        __attribute__nonnull__(pTHX_1)