This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[perl #122445] use magic on $DB::single etc to avoid overload issues
[perl5.git] / mg.c
diff --git a/mg.c b/mg.c
index 3f6eb2c..9653c70 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -17,24 +17,25 @@
 
 /*
 =head1 Magical Functions
 
 /*
 =head1 Magical Functions
-
 "Magic" is special data attached to SV structures in order to give them
 "magical" properties.  When any Perl code tries to read from, or assign to,
 an SV marked as magical, it calls the 'get' or 'set' function associated
 "Magic" is special data attached to SV structures in order to give them
 "magical" properties.  When any Perl code tries to read from, or assign to,
 an SV marked as magical, it calls the 'get' or 'set' function associated
-with that SV's magic. A get is called prior to reading an SV, in order to
+with that SV's magic.  A get is called prior to reading an SV, in order to
 give it a chance to update its internal value (get on $. writes the line
 give it a chance to update its internal value (get on $. writes the line
-number of the last read filehandle into to the SV's IV slot), while
+number of the last read filehandle into the SV's IV slot), while
 set is called after an SV has been written to, in order to allow it to make
 use of its changed value (set on $/ copies the SV's new value to the
 PL_rs global variable).
 
 Magic is implemented as a linked list of MAGIC structures attached to the
 set is called after an SV has been written to, in order to allow it to make
 use of its changed value (set on $/ copies the SV's new value to the
 PL_rs global variable).
 
 Magic is implemented as a linked list of MAGIC structures attached to the
-SV. Each MAGIC struct holds the type of the magic, a pointer to an array
+SV.  Each MAGIC struct holds the type of the magic, a pointer to an array
 of functions that implement the get(), set(), length() etc functions,
 of functions that implement the get(), set(), length() etc functions,
-plus space for some flags and pointers. For example, a tied variable has
+plus space for some flags and pointers.  For example, a tied variable has
 a MAGIC structure that contains a pointer to the object associated with the
 tie.
 
 a MAGIC structure that contains a pointer to the object associated with the
 tie.
 
+=cut
+
 */
 
 #include "EXTERN.h"
 */
 
 #include "EXTERN.h"
@@ -83,8 +84,7 @@ void setegid(uid_t id);
 struct magic_state {
     SV* mgs_sv;
     I32 mgs_ss_ix;
 struct magic_state {
     SV* mgs_sv;
     I32 mgs_ss_ix;
-    U32 mgs_magical;
-    bool mgs_readonly;
+    U32 mgs_flags;
     bool mgs_bumped;
 };
 /* MGS is typedef'ed to struct magic_state in perl.h */
     bool mgs_bumped;
 };
 /* MGS is typedef'ed to struct magic_state in perl.h */
@@ -92,7 +92,6 @@ struct magic_state {
 STATIC void
 S_save_magic_flags(pTHX_ I32 mgs_ix, SV *sv, U32 flags)
 {
 STATIC void
 S_save_magic_flags(pTHX_ I32 mgs_ix, SV *sv, U32 flags)
 {
-    dVAR;
     MGS* mgs;
     bool bumped = FALSE;
 
     MGS* mgs;
     bool bumped = FALSE;
 
@@ -115,8 +114,7 @@ S_save_magic_flags(pTHX_ I32 mgs_ix, SV *sv, U32 flags)
 
     mgs = SSPTR(mgs_ix, MGS*);
     mgs->mgs_sv = sv;
 
     mgs = SSPTR(mgs_ix, MGS*);
     mgs->mgs_sv = sv;
-    mgs->mgs_magical = SvMAGICAL(sv);
-    mgs->mgs_readonly = SvREADONLY(sv) != 0;
+    mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
     mgs->mgs_ss_ix = PL_savestack_ix;   /* points after the saved destructor */
     mgs->mgs_bumped = bumped;
 
     mgs->mgs_ss_ix = PL_savestack_ix;   /* points after the saved destructor */
     mgs->mgs_bumped = bumped;
 
@@ -135,11 +133,10 @@ Turns on the magical status of an SV.  See C<sv_magic>.
 */
 
 void
 */
 
 void
-Perl_mg_magical(pTHX_ SV *sv)
+Perl_mg_magical(SV *sv)
 {
     const MAGIC* mg;
     PERL_ARGS_ASSERT_MG_MAGICAL;
 {
     const MAGIC* mg;
     PERL_ARGS_ASSERT_MG_MAGICAL;
-    PERL_UNUSED_CONTEXT;
 
     SvMAGICAL_off(sv);
     if ((mg = SvMAGIC(sv))) {
 
     SvMAGICAL_off(sv);
     if ((mg = SvMAGIC(sv))) {
@@ -163,7 +160,7 @@ Perl_mg_magical(pTHX_ SV *sv)
 =for apidoc mg_get
 
 Do magic before a value is retrieved from the SV.  The type of SV must
 =for apidoc mg_get
 
 Do magic before a value is retrieved from the SV.  The type of SV must
-be >= SVt_PVMG. See C<sv_magic>.
+be >= SVt_PVMG.  See C<sv_magic>.
 
 =cut
 */
 
 =cut
 */
@@ -171,7 +168,6 @@ be >= SVt_PVMG. See C<sv_magic>.
 int
 Perl_mg_get(pTHX_ SV *sv)
 {
 int
 Perl_mg_get(pTHX_ SV *sv)
 {
-    dVAR;
     const I32 mgs_ix = SSNEW(sizeof(MGS));
     bool saved = FALSE;
     bool have_new = 0;
     const I32 mgs_ix = SSNEW(sizeof(MGS));
     bool saved = FALSE;
     bool have_new = 0;
@@ -203,13 +199,15 @@ Perl_mg_get(pTHX_ SV *sv)
            /* guard against magic having been deleted - eg FETCH calling
             * untie */
            if (!SvMAGIC(sv)) {
            /* guard against magic having been deleted - eg FETCH calling
             * untie */
            if (!SvMAGIC(sv)) {
-               (SSPTR(mgs_ix, MGS *))->mgs_magical = 0; /* recalculate flags */
+               /* recalculate flags */
+               (SSPTR(mgs_ix, MGS *))->mgs_flags &= ~(SVs_GMG|SVs_SMG|SVs_RMG);
                break;
            }
 
            /* recalculate flags if this entry was deleted. */
            if (mg->mg_flags & MGf_GSKIP)
                break;
            }
 
            /* recalculate flags if this entry was deleted. */
            if (mg->mg_flags & MGf_GSKIP)
-               (SSPTR(mgs_ix, MGS *))->mgs_magical = 0;
+               (SSPTR(mgs_ix, MGS *))->mgs_flags &=
+                    ~(SVs_GMG|SVs_SMG|SVs_RMG);
        }
        else if (vtbl == &PL_vtbl_utf8) {
            /* get-magic can reallocate the PV */
        }
        else if (vtbl == &PL_vtbl_utf8) {
            /* get-magic can reallocate the PV */
@@ -233,7 +231,8 @@ Perl_mg_get(pTHX_ SV *sv)
            have_new = 1;
            cur = mg;
            mg  = newmg;
            have_new = 1;
            cur = mg;
            mg  = newmg;
-           (SSPTR(mgs_ix, MGS *))->mgs_magical = 0; /* recalculate flags */
+           /* recalculate flags */
+           (SSPTR(mgs_ix, MGS *))->mgs_flags &= ~(SVs_GMG|SVs_SMG|SVs_RMG);
        }
     }
 
        }
     }
 
@@ -254,7 +253,6 @@ Do magic after a value is assigned to the SV.  See C<sv_magic>.
 int
 Perl_mg_set(pTHX_ SV *sv)
 {
 int
 Perl_mg_set(pTHX_ SV *sv)
 {
-    dVAR;
     const I32 mgs_ix = SSNEW(sizeof(MGS));
     MAGIC* mg;
     MAGIC* nextmg;
     const I32 mgs_ix = SSNEW(sizeof(MGS));
     MAGIC* mg;
     MAGIC* nextmg;
@@ -270,7 +268,7 @@ Perl_mg_set(pTHX_ SV *sv)
        nextmg = mg->mg_moremagic;      /* it may delete itself */
        if (mg->mg_flags & MGf_GSKIP) {
            mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
        nextmg = mg->mg_moremagic;      /* it may delete itself */
        if (mg->mg_flags & MGf_GSKIP) {
            mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
-           (SSPTR(mgs_ix, MGS*))->mgs_magical = 0;
+           (SSPTR(mgs_ix, MGS*))->mgs_flags &= ~(SVs_GMG|SVs_SMG|SVs_RMG);
        }
        if (PL_localizing == 2
            && PERL_MAGIC_TYPE_IS_VALUE_MAGIC(mg->mg_type))
        }
        if (PL_localizing == 2
            && PERL_MAGIC_TYPE_IS_VALUE_MAGIC(mg->mg_type))
@@ -298,7 +296,6 @@ higher.  Use sv_len() instead.
 U32
 Perl_mg_length(pTHX_ SV *sv)
 {
 U32
 Perl_mg_length(pTHX_ SV *sv)
 {
-    dVAR;
     MAGIC* mg;
     STRLEN len;
 
     MAGIC* mg;
     STRLEN len;
 
@@ -347,9 +344,9 @@ Perl_mg_size(pTHX_ SV *sv)
            /* FIXME */
        default:
            Perl_croak(aTHX_ "Size magic not implemented");
            /* FIXME */
        default:
            Perl_croak(aTHX_ "Size magic not implemented");
-           break;
+
     }
     }
-    return 0;
+    NOT_REACHED; /* NOTREACHED */
 }
 
 /*
 }
 
 /*
@@ -386,10 +383,8 @@ Perl_mg_clear(pTHX_ SV *sv)
 }
 
 static MAGIC*
 }
 
 static MAGIC*
-S_mg_findext_flags(pTHX_ const SV *sv, int type, const MGVTBL *vtbl, U32 flags)
+S_mg_findext_flags(const SV *sv, int type, const MGVTBL *vtbl, U32 flags)
 {
 {
-    PERL_UNUSED_CONTEXT;
-
     assert(flags <= 1);
 
     if (sv) {
     assert(flags <= 1);
 
     if (sv) {
@@ -416,9 +411,9 @@ Finds the magic pointer for type matching the SV.  See C<sv_magic>.
 */
 
 MAGIC*
 */
 
 MAGIC*
-Perl_mg_find(pTHX_ const SV *sv, int type)
+Perl_mg_find(const SV *sv, int type)
 {
 {
-    return S_mg_findext_flags(aTHX_ sv, type, NULL, 0);
+    return S_mg_findext_flags(sv, type, NULL, 0);
 }
 
 /*
 }
 
 /*
@@ -431,9 +426,9 @@ C<sv_magicext>.
 */
 
 MAGIC*
 */
 
 MAGIC*
-Perl_mg_findext(pTHX_ const SV *sv, int type, const MGVTBL *vtbl)
+Perl_mg_findext(const SV *sv, int type, const MGVTBL *vtbl)
 {
 {
-    return S_mg_findext_flags(aTHX_ sv, type, vtbl, 1);
+    return S_mg_findext_flags(sv, type, vtbl, 1);
 }
 
 MAGIC *
 }
 
 MAGIC *
@@ -447,7 +442,7 @@ Perl_mg_find_mglob(pTHX_ SV *sv)
         sv = LvTARG(sv);
     }
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
         sv = LvTARG(sv);
     }
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
-        return S_mg_findext_flags(aTHX_ sv, PERL_MAGIC_regex_global, 0, 0);
+        return S_mg_findext_flags(sv, PERL_MAGIC_regex_global, 0, 0);
     return NULL;
 }
 
     return NULL;
 }
 
@@ -493,7 +488,8 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
 =for apidoc mg_localize
 
 Copy some of the magic from an existing SV to new localized version of that
 =for apidoc mg_localize
 
 Copy some of the magic from an existing SV to new localized version of that
-SV. Container magic (eg %ENV, $1, tie) gets copied, value magic doesn't (eg
+SV.  Container magic (eg %ENV, $1, tie)
+gets copied, value magic doesn't (eg
 taint, pos).
 
 If setmagic is false then no set magic will be called on the new (empty) SV.
 taint, pos).
 
 If setmagic is false then no set magic will be called on the new (empty) SV.
@@ -506,7 +502,6 @@ and that will handle the magic.
 void
 Perl_mg_localize(pTHX_ SV *sv, SV *nsv, bool setmagic)
 {
 void
 Perl_mg_localize(pTHX_ SV *sv, SV *nsv, bool setmagic)
 {
-    dVAR;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_MG_LOCALIZE;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_MG_LOCALIZE;
@@ -621,7 +616,6 @@ Perl_mg_free_type(pTHX_ SV *sv, int how)
 U32
 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 {
 U32
 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     PERL_UNUSED_ARG(sv);
 
     PERL_ARGS_ASSERT_MAGIC_REGDATA_CNT;
     PERL_UNUSED_ARG(sv);
 
     PERL_ARGS_ASSERT_MAGIC_REGDATA_CNT;
@@ -653,8 +647,6 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_MAGIC_REGDATUM_GET;
 
     if (PL_curpm) {
     PERL_ARGS_ASSERT_MAGIC_REGDATUM_GET;
 
     if (PL_curpm) {
@@ -698,6 +690,7 @@ int
 Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
 {
     PERL_ARGS_ASSERT_MAGIC_REGDATUM_SET;
 Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
 {
     PERL_ARGS_ASSERT_MAGIC_REGDATUM_SET;
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
     Perl_croak_no_modify();
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
     Perl_croak_no_modify();
@@ -748,25 +741,29 @@ S_fixup_errno_string(pTHX_ SV* sv)
     PERL_ARGS_ASSERT_FIXUP_ERRNO_STRING;
 
     assert(SvOK(sv));
     PERL_ARGS_ASSERT_FIXUP_ERRNO_STRING;
 
     assert(SvOK(sv));
-    assert(strNE(SvPVX(sv), ""));
-
-    /* In some locales the error string may come back as UTF-8, in
-     * which case we should turn on that flag.  This didn't use to
-     * happen, and to avoid any possible backward compatibility issues,
-     * we don't turn on the flag unless we have to.  So the flag stays
-     * off for an entirely ASCII string.  We assume that if the string
-     * looks like UTF-8, it really is UTF-8:  "text in any other
-     * encoding that uses bytes with the high bit set is extremely
-     * unlikely to pass a UTF-8 validity test"
-     * (http://en.wikipedia.org/wiki/Charset_detection).  There is a
-     * potential that we will get it wrong however, especially on short
-     * error message text.  (If it turns out to be necessary, we could
-     * also keep track if the current LC_MESSAGES locale is UTF-8) */
-    if (! IN_BYTES  /* respect 'use bytes' */
-        && ! is_ascii_string((U8*) SvPVX_const(sv), SvCUR(sv))
-        && is_utf8_string((U8*) SvPVX_const(sv), SvCUR(sv)))
-    {
-        SvUTF8_on(sv);
+
+    if(strEQ(SvPVX(sv), "")) {
+       sv_catpv(sv, UNKNOWN_ERRNO_MSG);
+    }
+    else {
+
+        /* In some locales the error string may come back as UTF-8, in which
+         * case we should turn on that flag.  This didn't use to happen, and to
+         * avoid as many possible backward compatibility issues as possible, we
+         * don't turn on the flag unless we have to.  So the flag stays off for
+         * an entirely ASCII string.  We assume that if the string looks like
+         * UTF-8, it really is UTF-8:  "text in any other encoding that uses
+         * bytes with the high bit set is extremely unlikely to pass a UTF-8
+         * validity test" (http://en.wikipedia.org/wiki/Charset_detection).
+         * There is a potential that we will get it wrong however, especially
+         * on short error message text.  (If it turns out to be necessary, we
+         * could also keep track if the current LC_MESSAGES locale is UTF-8) */
+        if (! IN_BYTES  /* respect 'use bytes' */
+            && ! is_ascii_string((U8*) SvPVX_const(sv), SvCUR(sv))
+            && is_utf8_string((U8*) SvPVX_const(sv), SvCUR(sv)))
+        {
+            SvUTF8_on(sv);
+        }
     }
 }
 
     }
 }
 
@@ -778,7 +775,6 @@ S_fixup_errno_string(pTHX_ SV* sv)
 int
 Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     I32 paren;
     const char *s = NULL;
     REGEXP *rx;
     I32 paren;
     const char *s = NULL;
     REGEXP *rx;
@@ -839,7 +835,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 #elif defined(OS2)
         if (!(_emx_env & 0x200)) {     /* Under DOS */
             sv_setnv(sv, (NV)errno);
 #elif defined(OS2)
         if (!(_emx_env & 0x200)) {     /* Under DOS */
             sv_setnv(sv, (NV)errno);
-            sv_setpv(sv, errno ? Strerror(errno) : "");
+            sv_setpv(sv, errno ? my_strerror(errno) : "");
         } else {
             if (errno != errno_isOS2) {
                 const int tmp = _syserrno();
         } else {
             if (errno != errno_isOS2) {
                 const int tmp = _syserrno();
@@ -849,7 +845,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
             sv_setnv(sv, (NV)Perl_rc);
             sv_setpv(sv, os2error(Perl_rc));
         }
             sv_setnv(sv, (NV)Perl_rc);
             sv_setpv(sv, os2error(Perl_rc));
         }
-        if (strNE(SvPVX(sv), "")) {
+        if (SvOK(sv) && strNE(SvPVX(sv), "")) {
             fixup_errno_string(sv);
         }
 #   elif defined(WIN32)
             fixup_errno_string(sv);
         }
 #   elif defined(WIN32)
@@ -875,31 +871,31 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 
     case '!':
        {
 
     case '!':
        {
-       dSAVE_ERRNO;
+            dSAVE_ERRNO;
 #ifdef VMS
 #ifdef VMS
-       sv_setnv(sv, (NV)((errno == EVMSERR) ? vaxc$errno : errno));
+            sv_setnv(sv, (NV)((errno == EVMSERR) ? vaxc$errno : errno));
 #else
 #else
-       sv_setnv(sv, (NV)errno);
+            sv_setnv(sv, (NV)errno);
 #endif
 #ifdef OS2
 #endif
 #ifdef OS2
-       if (errno == errno_isOS2 || errno == errno_isOS2_set)
-           sv_setpv(sv, os2error(Perl_rc));
-       else
+            if (errno == errno_isOS2 || errno == errno_isOS2_set)
+                sv_setpv(sv, os2error(Perl_rc));
+            else
 #endif
 #endif
-       if (! errno) {
-            sv_setpvs(sv, "");
-        }
-        else {
+            if (! errno) {
+                sv_setpvs(sv, "");
+            }
+            else {
 
 
-            /* Strerror can return NULL on some platforms, which will result in
-             * 'sv' not being considered SvOK.  The SvNOK_on() below will cause
-             * just the number part to be valid */
-            sv_setpv(sv, Strerror(errno));
-            if (SvOK(sv)) {
-                fixup_errno_string(sv);
+                /* Strerror can return NULL on some platforms, which will
+                 * result in 'sv' not being considered SvOK.  The SvNOK_on()
+                 * below will cause just the number part to be valid */
+                sv_setpv(sv, my_strerror(errno));
+                if (SvOK(sv)) {
+                    fixup_errno_string(sv);
+                }
             }
             }
-        }
-       RESTORE_ERRNO;
+            RESTORE_ERRNO;
        }
 
        SvRTRIM(sv);
        }
 
        SvRTRIM(sv);
@@ -1109,12 +1105,15 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 #ifdef HAS_GETGROUPS
        {
            Groups_t *gary = NULL;
 #ifdef HAS_GETGROUPS
        {
            Groups_t *gary = NULL;
-           I32 i, num_groups = getgroups(0, gary);
-            Newx(gary, num_groups, Groups_t);
-            num_groups = getgroups(num_groups, gary);
-           for (i = 0; i < num_groups; i++)
-               Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]);
-            Safefree(gary);
+           I32 i;
+            I32 num_groups = getgroups(0, gary);
+            if (num_groups > 0) {
+                Newx(gary, num_groups, Groups_t);
+                num_groups = getgroups(num_groups, gary);
+                for (i = 0; i < num_groups; i++)
+                    Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]);
+                Safefree(gary);
+            }
        }
        (void)SvIOK_on(sv);     /* what a wonderful hack! */
 #endif
        }
        (void)SvIOK_on(sv);     /* what a wonderful hack! */
 #endif
@@ -1140,7 +1139,6 @@ Perl_magic_getuvar(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     STRLEN len = 0, klen;
     const char * const key = MgPV_const(mg,klen);
     const char *s = "";
     STRLEN len = 0, klen;
     const char * const key = MgPV_const(mg,klen);
     const char *s = "";
@@ -1249,7 +1247,6 @@ Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     PERL_ARGS_ASSERT_MAGIC_SET_ALL_ENV;
     PERL_UNUSED_ARG(mg);
 #if defined(VMS)
     PERL_ARGS_ASSERT_MAGIC_SET_ALL_ENV;
     PERL_UNUSED_ARG(mg);
 #if defined(VMS)
@@ -1272,7 +1269,6 @@ Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     PERL_ARGS_ASSERT_MAGIC_CLEAR_ALL_ENV;
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
     PERL_ARGS_ASSERT_MAGIC_CLEAR_ALL_ENV;
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
@@ -1296,7 +1292,6 @@ restore_sigmask(pTHX_ SV *save_sv)
 int
 Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     /* Are we fetching a signal entry? */
     int i = (I16)mg->mg_private;
 
     /* Are we fetching a signal entry? */
     int i = (I16)mg->mg_private;
 
@@ -1353,6 +1348,12 @@ Perl_csighandler(int sig)
 #else
     dTHX;
 #endif
 #else
     dTHX;
 #endif
+#if defined(__cplusplus) && defined(__GNUC__)
+    /* g++ doesn't support PERL_UNUSED_DECL, so the sip and uap
+     * parameters would be warned about. */
+    PERL_UNUSED_ARG(sip);
+    PERL_UNUSED_ARG(uap);
+#endif
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
     (void) rsignal(sig, PL_csighandlerp);
     if (PL_sig_ignoring[sig]) return;
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
     (void) rsignal(sig, PL_csighandlerp);
     if (PL_sig_ignoring[sig]) return;
@@ -1424,6 +1425,7 @@ Perl_csighandler_init(void)
 static void
 unblock_sigmask(pTHX_ void* newset)
 {
 static void
 unblock_sigmask(pTHX_ void* newset)
 {
+    PERL_UNUSED_CONTEXT;
     sigprocmask(SIG_UNBLOCK, (sigset_t*)newset, NULL);
 }
 #endif
     sigprocmask(SIG_UNBLOCK, (sigset_t*)newset, NULL);
 }
 #endif
@@ -1431,7 +1433,6 @@ unblock_sigmask(pTHX_ void* newset)
 void
 Perl_despatch_signals(pTHX)
 {
 void
 Perl_despatch_signals(pTHX)
 {
-    dVAR;
     int sig;
     PL_sig_pending = 0;
     for (sig = 1; sig < SIG_SIZE; sig++) {
     int sig;
     PL_sig_pending = 0;
     for (sig = 1; sig < SIG_SIZE; sig++) {
@@ -1633,7 +1634,6 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     PERL_ARGS_ASSERT_MAGIC_SETISA;
     PERL_UNUSED_ARG(sv);
 
     PERL_ARGS_ASSERT_MAGIC_SETISA;
     PERL_UNUSED_ARG(sv);
 
@@ -1648,9 +1648,7 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     HV* stash;
     HV* stash;
-
     PERL_ARGS_ASSERT_MAGIC_CLEARISA;
 
     /* Bail out if destruction is going on */
     PERL_ARGS_ASSERT_MAGIC_CLEARISA;
 
     /* Bail out if destruction is going on */
@@ -1664,6 +1662,7 @@ Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg)
           same function. */
        mg = mg_find(mg->mg_obj, PERL_MAGIC_isa);
 
           same function. */
        mg = mg_find(mg->mg_obj, PERL_MAGIC_isa);
 
+    assert(mg);
     if (SvTYPE(mg->mg_obj) == SVt_PVAV) { /* multiple stashes */
        SV **svp = AvARRAY((AV *)mg->mg_obj);
        I32 items = AvFILLp((AV *)mg->mg_obj) + 1;
     if (SvTYPE(mg->mg_obj) == SVt_PVAV) { /* multiple stashes */
        SV **svp = AvARRAY((AV *)mg->mg_obj);
        I32 items = AvFILLp((AV *)mg->mg_obj) + 1;
@@ -1751,7 +1750,6 @@ SV*
 Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
                    U32 argc, ...)
 {
 Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
                    U32 argc, ...)
 {
-    dVAR;
     dSP;
     SV* ret = NULL;
 
     dSP;
     SV* ret = NULL;
 
@@ -1762,7 +1760,6 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
     if (flags & G_WRITING_TO_STDERR) {
        SAVETMPS;
 
     if (flags & G_WRITING_TO_STDERR) {
        SAVETMPS;
 
-       save_re_context();
        SAVESPTR(PL_stderrgv);
        PL_stderrgv = NULL;
     }
        SAVESPTR(PL_stderrgv);
        PL_stderrgv = NULL;
     }
@@ -1808,7 +1805,6 @@ STATIC SV*
 S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
     int n, SV *val)
 {
 S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
     int n, SV *val)
 {
-    dVAR;
     SV* arg1 = NULL;
 
     PERL_ARGS_ASSERT_MAGIC_METHCALL1;
     SV* arg1 = NULL;
 
     PERL_ARGS_ASSERT_MAGIC_METHCALL1;
@@ -1833,7 +1829,6 @@ S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
 STATIC int
 S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, SV *meth)
 {
 STATIC int
 S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, SV *meth)
 {
-    dVAR;
     SV* ret;
 
     PERL_ARGS_ASSERT_MAGIC_METHPACK;
     SV* ret;
 
     PERL_ARGS_ASSERT_MAGIC_METHPACK;
@@ -1858,7 +1853,6 @@ Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     MAGIC *tmg;
     SV    *val;
 
     MAGIC *tmg;
     SV    *val;
 
@@ -1900,7 +1894,6 @@ Perl_magic_clearpack(pTHX_ SV *sv, MAGIC *mg)
 U32
 Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
 {
 U32
 Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     I32 retval = 0;
     SV* retsv;
 
     I32 retval = 0;
     SV* retsv;
 
@@ -1918,8 +1911,6 @@ Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_MAGIC_WIPEPACK;
 
     Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(CLEAR), G_DISCARD, 0);
     PERL_ARGS_ASSERT_MAGIC_WIPEPACK;
 
     Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(CLEAR), G_DISCARD, 0);
@@ -1929,7 +1920,6 @@ Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 {
 int
 Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
 {
-    dVAR;
     SV* ret;
 
     PERL_ARGS_ASSERT_MAGIC_NEXTPACK;
     SV* ret;
 
     PERL_ARGS_ASSERT_MAGIC_NEXTPACK;
@@ -1952,7 +1942,6 @@ Perl_magic_existspack(pTHX_ SV *sv, const MAGIC *mg)
 SV *
 Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 {
 SV *
 Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 {
-    dVAR;
     SV *retval;
     SV * const tied = SvTIED_obj(MUTABLE_SV(hv), mg);
     HV * const pkg = SvSTASH((const SV *)SvRV(tied));
     SV *retval;
     SV * const tied = SvTIED_obj(MUTABLE_SV(hv), mg);
     HV * const pkg = SvSTASH((const SV *)SvRV(tied));
@@ -1981,7 +1970,6 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 int
 Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     SV **svp;
 
     PERL_ARGS_ASSERT_MAGIC_SETDBLINE;
     SV **svp;
 
     PERL_ARGS_ASSERT_MAGIC_SETDBLINE;
@@ -2019,7 +2007,6 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
 {
 int
 Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
 {
-    dVAR;
     AV * const obj = MUTABLE_AV(mg->mg_obj);
 
     PERL_ARGS_ASSERT_MAGIC_GETARYLEN;
     AV * const obj = MUTABLE_AV(mg->mg_obj);
 
     PERL_ARGS_ASSERT_MAGIC_GETARYLEN;
@@ -2035,7 +2022,6 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
 int
 Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     AV * const obj = MUTABLE_AV(mg->mg_obj);
 
     PERL_ARGS_ASSERT_MAGIC_SETARYLEN;
     AV * const obj = MUTABLE_AV(mg->mg_obj);
 
     PERL_ARGS_ASSERT_MAGIC_SETARYLEN;
@@ -2052,10 +2038,9 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_cleararylen_p(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_cleararylen_p(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_MAGIC_CLEARARYLEN_P;
     PERL_UNUSED_ARG(sv);
     PERL_ARGS_ASSERT_MAGIC_CLEARARYLEN_P;
     PERL_UNUSED_ARG(sv);
+    PERL_UNUSED_CONTEXT;
 
     /* Reset the iterator when the array is cleared */
 #if IVSIZE == I32SIZE
 
     /* Reset the iterator when the array is cleared */
 #if IVSIZE == I32SIZE
@@ -2071,8 +2056,6 @@ Perl_magic_cleararylen_p(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_MAGIC_FREEARYLEN_P;
     PERL_UNUSED_ARG(sv);
 
     PERL_ARGS_ASSERT_MAGIC_FREEARYLEN_P;
     PERL_UNUSED_ARG(sv);
 
@@ -2096,7 +2079,6 @@ Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     SV* const lsv = LvTARG(sv);
     MAGIC * const found = mg_find_mglob(lsv);
 
     SV* const lsv = LvTARG(sv);
     MAGIC * const found = mg_find_mglob(lsv);
 
@@ -2117,7 +2099,6 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     SV* const lsv = LvTARG(sv);
     SSize_t pos;
     STRLEN len;
     SV* const lsv = LvTARG(sv);
     SSize_t pos;
     STRLEN len;
@@ -2197,7 +2178,6 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     STRLEN len, lsv_len, oldtarglen, newtarglen;
     const char * const tmps = SvPV_const(sv, len);
     SV * const lsv = LvTARG(sv);
     STRLEN len, lsv_len, oldtarglen, newtarglen;
     const char * const tmps = SvPV_const(sv, len);
     SV * const lsv = LvTARG(sv);
@@ -2251,23 +2231,19 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_MAGIC_GETTAINT;
     PERL_UNUSED_ARG(sv);
 #ifdef NO_TAINT_SUPPORT
     PERL_UNUSED_ARG(mg);
 #endif
 
     PERL_ARGS_ASSERT_MAGIC_GETTAINT;
     PERL_UNUSED_ARG(sv);
 #ifdef NO_TAINT_SUPPORT
     PERL_UNUSED_ARG(mg);
 #endif
 
-    TAINT_IF((PL_localizing != 1) && (mg->mg_len & 1));
+    TAINT_IF((PL_localizing != 1) && (mg->mg_len & 1) && IN_PERL_RUNTIME);
     return 0;
 }
 
 int
 Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg)
 {
     return 0;
 }
 
 int
 Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_MAGIC_SETTAINT;
     PERL_UNUSED_ARG(sv);
 
     PERL_ARGS_ASSERT_MAGIC_SETTAINT;
     PERL_UNUSED_ARG(sv);
 
@@ -2304,7 +2280,6 @@ Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg)
 SV *
 Perl_defelem_target(pTHX_ SV *sv, MAGIC *mg)
 {
 SV *
 Perl_defelem_target(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     SV *targ = NULL;
     PERL_ARGS_ASSERT_DEFELEM_TARGET;
     if (!mg) mg = mg_find(sv, PERL_MAGIC_defelem);
     SV *targ = NULL;
     PERL_ARGS_ASSERT_DEFELEM_TARGET;
     if (!mg) mg = mg_find(sv, PERL_MAGIC_defelem);
@@ -2369,7 +2344,6 @@ Perl_magic_setdefelem(pTHX_ SV *sv, MAGIC *mg)
 void
 Perl_vivify_defelem(pTHX_ SV *sv)
 {
 void
 Perl_vivify_defelem(pTHX_ SV *sv)
 {
-    dVAR;
     MAGIC *mg;
     SV *value = NULL;
 
     MAGIC *mg;
     SV *value = NULL;
 
@@ -2490,7 +2464,9 @@ Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 {
+#ifdef USE_ITHREADS
     dVAR;
     dVAR;
+#endif
     const char *s;
     I32 paren;
     const REGEXP * rx;
     const char *s;
     I32 paren;
     const REGEXP * rx;
@@ -2744,8 +2720,34 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        }
        break;
     case '/':
        }
        break;
     case '/':
-       SvREFCNT_dec(PL_rs);
-       PL_rs = newSVsv(sv);
+        {
+            SV *tmpsv= sv;
+            if (SvROK(sv)) {
+                SV *referent= SvRV(sv);
+                const char *reftype= sv_reftype(referent, 0);
+                /* XXX: dodgy type check: This leaves me feeling dirty, but the alternative
+                 * is to copy pretty much the entire sv_reftype() into this routine, or to do
+                 * a full string comparison on the return of sv_reftype() both of which
+                 * make me feel worse! NOTE, do not modify this comment without reviewing the
+                 * corresponding comment in sv_reftype(). - Yves */
+                if (reftype[0] == 'S' || reftype[0] == 'L') {
+                    IV val= SvIV(referent);
+                    if (val <= 0) {
+                        tmpsv= &PL_sv_undef;
+                        Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                            "Setting $/ to a reference to %s as a form of slurp is deprecated, treating as undef",
+                            SvIV(SvRV(sv)) < 0 ? "a negative integer" : "zero"
+                        );
+                    }
+                } else {
+              /* diag_listed_as: Setting $/ to %s reference is forbidden */
+                    Perl_croak(aTHX_ "Setting $/ to a%s %s reference is forbidden",
+                                      *reftype == 'A' ? "n" : "", reftype);
+                }
+            }
+            SvREFCNT_dec(PL_rs);
+            PL_rs = newSVsv(tmpsv);
+        }
        break;
     case '\\':
        SvREFCNT_dec(PL_ors_sv);
        break;
     case '\\':
        SvREFCNT_dec(PL_ors_sv);
@@ -2794,7 +2796,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        break;
     case '<':
        {
        break;
     case '<':
        {
-        int rc = 0;
+        /* XXX $< currently silently ignores failures */
        const Uid_t new_uid = SvUID(sv);
        PL_delaymagic_uid = new_uid;
        if (PL_delaymagic) {
        const Uid_t new_uid = SvUID(sv);
        PL_delaymagic_uid = new_uid;
        if (PL_delaymagic) {
@@ -2802,34 +2804,32 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETRUID
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETRUID
-       rc = setruid(new_uid);
+       PERL_UNUSED_RESULT(setruid(new_uid));
 #else
 #ifdef HAS_SETREUID
 #else
 #ifdef HAS_SETREUID
-        rc = setreuid(new_uid, (Uid_t)-1);
+        PERL_UNUSED_RESULT(setreuid(new_uid, (Uid_t)-1));
 #else
 #ifdef HAS_SETRESUID
 #else
 #ifdef HAS_SETRESUID
-       rc = setresuid(new_uid, (Uid_t)-1, (Uid_t)-1);
+        PERL_UNUSED_RESULT(setresuid(new_uid, (Uid_t)-1, (Uid_t)-1));
 #else
        if (new_uid == PerlProc_geteuid()) {            /* special case $< = $> */
 #ifdef PERL_DARWIN
            /* workaround for Darwin's setuid peculiarity, cf [perl #24122] */
            if (new_uid != 0 && PerlProc_getuid() == 0)
 #else
        if (new_uid == PerlProc_geteuid()) {            /* special case $< = $> */
 #ifdef PERL_DARWIN
            /* workaround for Darwin's setuid peculiarity, cf [perl #24122] */
            if (new_uid != 0 && PerlProc_getuid() == 0)
-                rc = PerlProc_setuid(0);
+                PERL_UNUSED_RESULT(PerlProc_setuid(0));
 #endif
 #endif
-            rc = PerlProc_setuid(new_uid);
+            PERL_UNUSED_RESULT(PerlProc_setuid(new_uid));
        } else {
            Perl_croak(aTHX_ "setruid() not implemented");
        }
 #endif
 #endif
 #endif
        } else {
            Perl_croak(aTHX_ "setruid() not implemented");
        }
 #endif
 #endif
 #endif
-        /* XXX $< currently silently ignores failures */
-        PERL_UNUSED_VAR(rc);
        break;
        }
     case '>':
        {
        break;
        }
     case '>':
        {
-        int rc = 0;
+        /* XXX $> currently silently ignores failures */
        const Uid_t new_euid = SvUID(sv);
        PL_delaymagic_euid = new_euid;
        if (PL_delaymagic) {
        const Uid_t new_euid = SvUID(sv);
        PL_delaymagic_euid = new_euid;
        if (PL_delaymagic) {
@@ -2837,29 +2837,27 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETEUID
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETEUID
-       rc = seteuid(new_euid);
+       PERL_UNUSED_RESULT(seteuid(new_euid));
 #else
 #ifdef HAS_SETREUID
 #else
 #ifdef HAS_SETREUID
-       rc = setreuid((Uid_t)-1, new_euid);
+       PERL_UNUSED_RESULT(setreuid((Uid_t)-1, new_euid));
 #else
 #ifdef HAS_SETRESUID
 #else
 #ifdef HAS_SETRESUID
-       rc = setresuid((Uid_t)-1, new_euid, (Uid_t)-1);
+       PERL_UNUSED_RESULT(setresuid((Uid_t)-1, new_euid, (Uid_t)-1));
 #else
        if (new_euid == PerlProc_getuid())              /* special case $> = $< */
 #else
        if (new_euid == PerlProc_getuid())              /* special case $> = $< */
-           rc = PerlProc_setuid(new_euid);
+           PERL_UNUSED_RESULT(PerlProc_setuid(new_euid));
        else {
            Perl_croak(aTHX_ "seteuid() not implemented");
        }
 #endif
 #endif
 #endif
        else {
            Perl_croak(aTHX_ "seteuid() not implemented");
        }
 #endif
 #endif
 #endif
-        /* XXX $> currently silently ignores failures */
-        PERL_UNUSED_VAR(rc);
        break;
        }
     case '(':
        {
        break;
        }
     case '(':
        {
-        int rc = 0;
+        /* XXX $( currently silently ignores failures */
        const Gid_t new_gid = SvGID(sv);
        PL_delaymagic_gid = new_gid;
        if (PL_delaymagic) {
        const Gid_t new_gid = SvGID(sv);
        PL_delaymagic_gid = new_gid;
        if (PL_delaymagic) {
@@ -2867,34 +2865,33 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETRGID
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETRGID
-       rc = setrgid(new_gid);
+       PERL_UNUSED_RESULT(setrgid(new_gid));
 #else
 #ifdef HAS_SETREGID
 #else
 #ifdef HAS_SETREGID
-       rc = setregid(new_gid, (Gid_t)-1);
+       PERL_UNUSED_RESULT(setregid(new_gid, (Gid_t)-1));
 #else
 #ifdef HAS_SETRESGID
 #else
 #ifdef HAS_SETRESGID
-        rc = setresgid(new_gid, (Gid_t)-1, (Gid_t) -1);
+        PERL_UNUSED_RESULT(setresgid(new_gid, (Gid_t)-1, (Gid_t) -1));
 #else
        if (new_gid == PerlProc_getegid())                      /* special case $( = $) */
 #else
        if (new_gid == PerlProc_getegid())                      /* special case $( = $) */
-           rc = PerlProc_setgid(new_gid);
+           PERL_UNUSED_RESULT(PerlProc_setgid(new_gid));
        else {
            Perl_croak(aTHX_ "setrgid() not implemented");
        }
 #endif
 #endif
 #endif
        else {
            Perl_croak(aTHX_ "setrgid() not implemented");
        }
 #endif
 #endif
 #endif
-        /* XXX $( currently silently ignores failures */
-        PERL_UNUSED_VAR(rc);
        break;
        }
     case ')':
        {
        break;
        }
     case ')':
        {
-        int rc = 0;
+        /* XXX $) currently silently ignores failures */
        Gid_t new_egid;
 #ifdef HAS_SETGROUPS
        {
            const char *p = SvPV_const(sv, len);
             Groups_t *gary = NULL;
        Gid_t new_egid;
 #ifdef HAS_SETGROUPS
        {
            const char *p = SvPV_const(sv, len);
             Groups_t *gary = NULL;
+            const char* endptr;
 #ifdef _SC_NGROUPS_MAX
            int maxgrp = sysconf(_SC_NGROUPS_MAX);
 
 #ifdef _SC_NGROUPS_MAX
            int maxgrp = sysconf(_SC_NGROUPS_MAX);
 
@@ -2906,22 +2903,23 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 
             while (isSPACE(*p))
                 ++p;
 
             while (isSPACE(*p))
                 ++p;
-            new_egid = (Gid_t)Atol(p);
+            new_egid = (Gid_t)grok_atou(p, &endptr);
             for (i = 0; i < maxgrp; ++i) {
             for (i = 0; i < maxgrp; ++i) {
-                while (*p && !isSPACE(*p))
-                    ++p;
+                if (endptr == NULL)
+                    break;
+                p = endptr;
                 while (isSPACE(*p))
                     ++p;
                 if (!*p)
                     break;
                 while (isSPACE(*p))
                     ++p;
                 if (!*p)
                     break;
-                if(!gary)
+                if (!gary)
                     Newx(gary, i + 1, Groups_t);
                 else
                     Renew(gary, i + 1, Groups_t);
                     Newx(gary, i + 1, Groups_t);
                 else
                     Renew(gary, i + 1, Groups_t);
-                gary[i] = (Groups_t)Atol(p);
+                gary[i] = (Groups_t)grok_atou(p, &endptr);
             }
             if (i)
             }
             if (i)
-                rc = setgroups(i, gary);
+                PERL_UNUSED_RESULT(setgroups(i, gary));
            Safefree(gary);
        }
 #else  /* HAS_SETGROUPS */
            Safefree(gary);
        }
 #else  /* HAS_SETGROUPS */
@@ -2933,24 +2931,22 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETEGID
            break;                              /* don't do magic till later */
        }
 #ifdef HAS_SETEGID
-       rc = setegid(new_egid);
+       PERL_UNUSED_RESULT(setegid(new_egid));
 #else
 #ifdef HAS_SETREGID
 #else
 #ifdef HAS_SETREGID
-       rc = setregid((Gid_t)-1, new_egid);
+       PERL_UNUSED_RESULT(setregid((Gid_t)-1, new_egid));
 #else
 #ifdef HAS_SETRESGID
 #else
 #ifdef HAS_SETRESGID
-       rc = setresgid((Gid_t)-1, new_egid, (Gid_t)-1);
+       PERL_UNUSED_RESULT(setresgid((Gid_t)-1, new_egid, (Gid_t)-1));
 #else
        if (new_egid == PerlProc_getgid())                      /* special case $) = $( */
 #else
        if (new_egid == PerlProc_getgid())                      /* special case $) = $( */
-           rc = PerlProc_setgid(new_egid);
+           PERL_UNUSED_RESULT(PerlProc_setgid(new_egid));
        else {
            Perl_croak(aTHX_ "setegid() not implemented");
        }
 #endif
 #endif
 #endif
        else {
            Perl_croak(aTHX_ "setegid() not implemented");
        }
 #endif
 #endif
 #endif
-        /* XXX $) currently silently ignores failures */
-        PERL_UNUSED_VAR(rc);
        break;
        }
     case ':':
        break;
        }
     case ':':
@@ -3049,7 +3045,6 @@ Perl_whichsig_sv(pTHX_ SV *sigsv)
     const char *sigpv;
     STRLEN siglen;
     PERL_ARGS_ASSERT_WHICHSIG_SV;
     const char *sigpv;
     STRLEN siglen;
     PERL_ARGS_ASSERT_WHICHSIG_SV;
-    PERL_UNUSED_CONTEXT;
     sigpv = SvPV_const(sigsv, siglen);
     return whichsig_pvn(sigpv, siglen);
 }
     sigpv = SvPV_const(sigsv, siglen);
     return whichsig_pvn(sigpv, siglen);
 }
@@ -3058,7 +3053,6 @@ I32
 Perl_whichsig_pv(pTHX_ const char *sig)
 {
     PERL_ARGS_ASSERT_WHICHSIG_PV;
 Perl_whichsig_pv(pTHX_ const char *sig)
 {
     PERL_ARGS_ASSERT_WHICHSIG_PV;
-    PERL_UNUSED_CONTEXT;
     return whichsig_pvn(sig, strlen(sig));
 }
 
     return whichsig_pvn(sig, strlen(sig));
 }
 
@@ -3131,11 +3125,19 @@ Perl_sighandler(int sig)
     }
 
     if (!cv || !CvROOT(cv)) {
     }
 
     if (!cv || !CvROOT(cv)) {
-       Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), "SIG%s handler \"%s\" not defined.\n",
-                      PL_sig_name[sig], (gv ? GvENAME(gv)
-                                         : ((cv && CvGV(cv))
-                                            ? GvENAME(CvGV(cv))
-                                            : "__ANON__")));
+       const HEK * const hek = gv
+                       ? GvENAME_HEK(gv)
+                       : cv && CvNAMED(cv)
+                          ? CvNAME_HEK(cv)
+                          : cv && CvGV(cv) ? GvENAME_HEK(CvGV(cv)) : NULL;
+       if (hek)
+           Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
+                               "SIG%s handler \"%"HEKf"\" not defined.\n",
+                                PL_sig_name[sig], hek);
+            /* diag_listed_as: SIG%s handler "%s" not defined */
+       else Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
+                          "SIG%s handler \"__ANON__\" not defined.\n",
+                           PL_sig_name[sig]);
        goto cleanup;
     }
 
        goto cleanup;
     }
 
@@ -3238,7 +3240,6 @@ cleanup:
 static void
 S_restore_magic(pTHX_ const void *p)
 {
 static void
 S_restore_magic(pTHX_ const void *p)
 {
-    dVAR;
     MGS* const mgs = SSPTR(PTR2IV(p), MGS*);
     SV* const sv = mgs->mgs_sv;
     bool bumped;
     MGS* const mgs = SSPTR(PTR2IV(p), MGS*);
     SV* const sv = mgs->mgs_sv;
     bool bumped;
@@ -3254,10 +3255,8 @@ S_restore_magic(pTHX_ const void *p)
        if (SvIsCOW(sv))
            sv_force_normal_flags(sv, 0);
 #endif
        if (SvIsCOW(sv))
            sv_force_normal_flags(sv, 0);
 #endif
-       if (mgs->mgs_readonly)
-           SvREADONLY_on(sv);
-       if (mgs->mgs_magical)
-           SvFLAGS(sv) |= mgs->mgs_magical;
+       if (mgs->mgs_flags)
+           SvFLAGS(sv) |= mgs->mgs_flags;
        else
            mg_magical(sv);
     }
        else
            mg_magical(sv);
     }
@@ -3304,7 +3303,6 @@ S_restore_magic(pTHX_ const void *p)
 static void
 S_unwind_handler_stack(pTHX_ const void *p)
 {
 static void
 S_unwind_handler_stack(pTHX_ const void *p)
 {
-    dVAR;
     PERL_UNUSED_ARG(p);
 
     PL_savestack_ix -= 5; /* Unprotect save in progress. */
     PERL_UNUSED_ARG(p);
 
     PL_savestack_ix -= 5; /* Unprotect save in progress. */
@@ -3323,7 +3321,6 @@ reference.
 int
 Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     SV *key = (mg->mg_len == HEf_SVKEY) ? MUTABLE_SV(mg->mg_ptr)
        : newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP);
 
     SV *key = (mg->mg_len == HEf_SVKEY) ? MUTABLE_SV(mg->mg_ptr)
        : newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP);
 
@@ -3354,8 +3351,6 @@ C<PL_compiling.cop_hints_hash>.
 int
 Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_MAGIC_CLEARHINT;
     PERL_UNUSED_ARG(sv);
 
     PERL_ARGS_ASSERT_MAGIC_CLEARHINT;
     PERL_UNUSED_ARG(sv);
 
@@ -3400,6 +3395,7 @@ Perl_magic_copycallchecker(pTHX_ SV *sv, MAGIC *mg, SV *nsv,
 
     sv_magic(nsv, &PL_sv_undef, mg->mg_type, NULL, 0);
     nmg = mg_find(nsv, mg->mg_type);
 
     sv_magic(nsv, &PL_sv_undef, mg->mg_type, NULL, 0);
     nmg = mg_find(nsv, mg->mg_type);
+    assert(nmg);
     if (nmg->mg_flags & MGf_REFCOUNTED) SvREFCNT_dec(nmg->mg_obj);
     nmg->mg_ptr = mg->mg_ptr;
     nmg->mg_obj = SvREFCNT_inc_simple(mg->mg_obj);
     if (nmg->mg_flags & MGf_REFCOUNTED) SvREFCNT_dec(nmg->mg_obj);
     nmg->mg_ptr = mg->mg_ptr;
     nmg->mg_obj = SvREFCNT_inc_simple(mg->mg_obj);
@@ -3407,6 +3403,27 @@ Perl_magic_copycallchecker(pTHX_ SV *sv, MAGIC *mg, SV *nsv,
     return 1;
 }
 
     return 1;
 }
 
+int
+Perl_magic_setdebugvar(pTHX_ SV *sv, MAGIC *mg) {
+    PERL_ARGS_ASSERT_MAGIC_SETDEBUGVAR;
+
+    assert(mg->mg_private >= DBVARMG_SINGLE && mg->mg_private < DBVARMG_COUNT);
+
+    PL_DBcontrol[mg->mg_private] = SvIV_nomg(sv);
+
+    return 1;
+}
+
+int
+Perl_magic_getdebugvar(pTHX_ SV *sv, MAGIC *mg) {
+    PERL_ARGS_ASSERT_MAGIC_GETDEBUGVAR;
+
+    assert(mg->mg_private >= DBVARMG_SINGLE && mg->mg_private < DBVARMG_COUNT);
+    sv_setiv(sv, PL_DBcontrol[mg->mg_private]);
+
+    return 0;
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd
 /*
  * Local variables:
  * c-indentation-style: bsd
Unnamed repository; edit this file 'description' to name the repository.