Also IRIX seems to have NaN comparison issues.

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index 2284783..0f1c314 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -127,7 +127,7 @@ S_save_magic_flags(pTHX_ I32 mgs_ix, SV *sv, U32 flags)
 /*
 =for apidoc mg_magical
 
 /*
 =for apidoc mg_magical
 

-Turns on the magical status of an SV.  See C<sv_magic>.
+Turns on the magical status of an SV.  See C<L</sv_magic>>.

 
 =cut
 */
 
 =cut
 */


@@ -160,7 +160,7 @@ Perl_mg_magical(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 >= C<SVt_PVMG>.  See C<L</sv_magic>>.

 
 =cut
 */
 
 =cut
 */


@@ -245,7 +245,7 @@ Perl_mg_get(pTHX_ SV *sv)
 /*
 =for apidoc mg_set
 
 /*
 =for apidoc mg_set
 

-Do magic after a value is assigned to the SV.  See C<sv_magic>.
+Do magic after a value is assigned to the SV.  See C<L</sv_magic>>.

 
 =cut
 */
 
 =cut
 */


@@ -285,10 +285,10 @@ Perl_mg_set(pTHX_ SV *sv)
 =for apidoc mg_length
 
 Reports on the SV's length in bytes, calling length magic if available,
 =for apidoc mg_length
 
 Reports on the SV's length in bytes, calling length magic if available,

-but does not set the UTF8 flag on the sv.  It will fall back to 'get'
+but does not set the UTF8 flag on C<sv>.  It will fall back to 'get'

 magic if there is no 'length' magic, but with no indication as to
 magic if there is no 'length' magic, but with no indication as to

-whether it called 'get' magic.  It assumes the sv is a PVMG or
-higher.  Use sv_len() instead.
+whether it called 'get' magic.  It assumes C<sv> is a C<PVMG> or
+higher.  Use C<sv_len()> instead.

 
 =cut
 */
 
 =cut
 */


@@ -352,7 +352,7 @@ Perl_mg_size(pTHX_ SV *sv)
 /*
 =for apidoc mg_clear
 
 /*
 =for apidoc mg_clear
 

-Clear something magical that the SV represents.  See C<sv_magic>.
+Clear something magical that the SV represents.  See C<L</sv_magic>>.

 
 =cut
 */
 
 =cut
 */


@@ -390,8 +390,6 @@ S_mg_findext_flags(const SV *sv, int type, const MGVTBL *vtbl, U32 flags)
     if (sv) {
        MAGIC *mg;
 
     if (sv) {
        MAGIC *mg;
 

-       assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
-

        for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
            if (mg->mg_type == type && (!flags || mg->mg_virtual == vtbl)) {
                return mg;
        for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
            if (mg->mg_type == type && (!flags || mg->mg_virtual == vtbl)) {
                return mg;


@@ -405,7 +403,7 @@ S_mg_findext_flags(const SV *sv, int type, const MGVTBL *vtbl, U32 flags)
 /*
 =for apidoc mg_find
 
 /*
 =for apidoc mg_find
 

-Finds the magic pointer for type matching the SV.  See C<sv_magic>.
+Finds the magic pointer for C<type> matching the SV.  See C<L</sv_magic>>.

 
 =cut
 */
 
 =cut
 */


@@ -420,7 +418,7 @@ Perl_mg_find(const SV *sv, int type)
 =for apidoc mg_findext
 
 Finds the magic pointer of C<type> with the given C<vtbl> for the C<SV>.  See
 =for apidoc mg_findext
 
 Finds the magic pointer of C<type> with the given C<vtbl> for the C<SV>.  See

-C<sv_magicext>.
+C<L</sv_magicext>>.

 
 =cut
 */
 
 =cut
 */


@@ -449,7 +447,7 @@ Perl_mg_find_mglob(pTHX_ SV *sv)
 /*
 =for apidoc mg_copy
 
 /*
 =for apidoc mg_copy
 

-Copies the magic from one SV to another.  See C<sv_magic>.
+Copies the magic from one SV to another.  See C<L</sv_magic>>.

 
 =cut
 */
 
 =cut
 */


@@ -488,12 +486,12 @@ 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
-taint, pos).
+SV.  Container magic (I<e.g.>, C<%ENV>, C<$1>, C<tie>)
+gets copied, value magic doesn't (I<e.g.>,
+C<taint>, C<pos>).

 
 

-If setmagic is false then no set magic will be called on the new (empty) SV.
-This typically means that assignment will soon follow (e.g. 'local $x = $y'),
+If C<setmagic> is false then no set magic will be called on the new (empty) SV.
+This typically means that assignment will soon follow (e.g. S<C<'local $x = $y'>>),

 and that will handle the magic.
 
 =cut
 and that will handle the magic.
 
 =cut


@@ -555,7 +553,7 @@ S_mg_free_struct(pTHX_ SV *sv, MAGIC *mg)
 /*
 =for apidoc mg_free
 
 /*
 =for apidoc mg_free
 

-Free any magic storage used by the SV.  See C<sv_magic>.
+Free any magic storage used by the SV.  See C<L</sv_magic>>.

 
 =cut
 */
 
 =cut
 */


@@ -581,7 +579,7 @@ Perl_mg_free(pTHX_ SV *sv)
 /*
 =for apidoc Am|void|mg_free_type|SV *sv|int how
 
 /*
 =for apidoc Am|void|mg_free_type|SV *sv|int how
 

-Remove any magic of type I<how> from the SV I<sv>.  See L</sv_magic>.
+Remove any magic of type C<how> from the SV C<sv>.  See L</sv_magic>.

 
 =cut
 */
 
 =cut
 */


@@ -751,15 +749,16 @@ S_fixup_errno_string(pTHX_ SV* sv)
          * 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
          * 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) */
+         * an entirely invariant 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' */
         if (! IN_BYTES  /* respect 'use bytes' */

-            && ! is_ascii_string((U8*) SvPVX_const(sv), SvCUR(sv))
+            && ! is_invariant_string((U8*) SvPVX_const(sv), SvCUR(sv))

             && is_utf8_string((U8*) SvPVX_const(sv), SvCUR(sv)))
         {
             SvUTF8_on(sv);
             && is_utf8_string((U8*) SvPVX_const(sv), SvCUR(sv)))
         {
             SvUTF8_on(sv);


@@ -767,6 +766,46 @@ S_fixup_errno_string(pTHX_ SV* sv)
     }
 }
 
     }
 }
 

+SV*
+Perl__get_encoding(pTHX)
+{
+    /* For core Perl use only: Returns the $^ENCODING or 'use encoding' in
+     * effect; NULL if none.
+     *
+     * $^ENCODING maps to PL_encoding, and is the old way to do things, and is
+     * retained for backwards compatibility.  Now, there is a shadow variable
+     * ${^E_NCODING} set only by the encoding pragma, used to give this pragma
+     * lexical scope, unlike the global scope it (shudder) used to have.  This
+     * variable maps to PL_lex_encoding.  Again for backwards compatibility,
+     * PL_encoding has precedence over PL_lex_encoding.  The hints hash is used
+     * to determine if PL_lex_encoding is in scope, and hence valid.  The hints
+     * hash only accepts simple values, so we can't put an Encode object into
+     * it, so we put the object into the global, and put a simple boolean into
+     * the hints hash giving whether the global is valid or not */
+
+    dVAR;
+    SV *is_encoding;
+
+    if (PL_encoding) {
+        return PL_encoding;
+    }
+
+    if (! PL_lex_encoding) {
+        return NULL;
+    }
+
+    is_encoding = cop_hints_fetch_pvs(PL_curcop, "encoding", 0);
+    if (   is_encoding
+        && is_encoding != &PL_sv_placeholder
+        && SvIOK(is_encoding)
+        && SvIV(is_encoding))  /* non-zero mean valid */
+    {
+        return PL_lex_encoding;
+    }
+
+    return NULL;
+}
+

 #ifdef VMS
 #include <descrip.h>
 #include <starlet.h>
 #ifdef VMS
 #include <descrip.h>
 #include <starlet.h>


@@ -817,7 +856,9 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '\005':  /* ^E */
         if (nextchar != '\0') {
             if (strEQ(remaining, "NCODING"))
     case '\005':  /* ^E */
         if (nextchar != '\0') {
             if (strEQ(remaining, "NCODING"))

-                sv_setsv(sv, PL_encoding);
+                sv_setsv(sv, _get_encoding());
+            else if (strEQ(remaining, "_NCODING"))
+                sv_setsv(sv, NULL);

             break;
         }
 
             break;
         }
 


@@ -1000,6 +1041,11 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                          *PL_compiling.cop_warnings);
            }
        }
                          *PL_compiling.cop_warnings);
            }
        }

+#ifdef WIN32
+       else if (strEQ(remaining, "IN32_SLOPPY_STAT")) {
+           sv_setiv(sv, w32_sloppystat);
+       }
+#endif

        break;
     case '+':
        if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
        break;
     case '+':
        if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {


@@ -1062,7 +1108,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
            sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv)));
        break;
     case ':':
            sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv)));
        break;
     case ':':

-       break;

     case '/':
        break;
     case '[':
     case '/':
        break;
     case '[':


@@ -1170,7 +1215,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
     }
 #endif
 
     }
 #endif
 

-#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) && !defined(MSDOS)
+#if !defined(OS2) && !defined(WIN32) && !defined(MSDOS)

                            /* And you'll never guess what the dog had */
                            /*   in its mouth... */
     if (TAINTING_get) {
                            /* And you'll never guess what the dog had */
                            /*   in its mouth... */
     if (TAINTING_get) {


@@ -1230,7 +1275,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
            }
        }
     }
            }
        }
     }

-#endif /* neither OS2 nor AMIGAOS nor WIN32 nor MSDOS */
+#endif /* neither OS2 nor WIN32 nor MSDOS */

 
     return 0;
 }
 
     return 0;
 }


@@ -1348,12 +1393,14 @@ Perl_csighandler(int sig)
 #else
     dTHX;
 #endif
 #else
     dTHX;
 #endif

+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)

 #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
 #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

+#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;


@@ -1740,7 +1787,7 @@ The C<flags> can be:
 
 The arguments themselves are any values following the C<flags> argument.
 
 
 The arguments themselves are any values following the C<flags> argument.
 

-Returns the SV (if any) returned by the method, or NULL on failure.
+Returns the SV (if any) returned by the method, or C<NULL> on failure.

 
 
 =cut
 
 
 =cut


@@ -1760,6 +1807,7 @@ 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;
     }


@@ -1767,7 +1815,9 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
     PUSHSTACKi(PERLSI_MAGIC);
     PUSHMARK(SP);
 
     PUSHSTACKi(PERLSI_MAGIC);
     PUSHMARK(SP);
 

-    EXTEND(SP, argc+1);
+    /* EXTEND() expects a signed argc; don't wrap when casting */
+    assert(argc <= I32_MAX);
+    EXTEND(SP, (I32)argc+1);

     PUSHs(SvTIED_obj(sv, mg));
     if (flags & G_UNDEF_FILL) {
        while (argc--) {
     PUSHs(SvTIED_obj(sv, mg));
     if (flags & G_UNDEF_FILL) {
        while (argc--) {


@@ -2464,15 +2514,57 @@ Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setlvref(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_setlvref(pTHX_ SV *sv, MAGIC *mg)
 {

+    const char *bad = NULL;

     PERL_ARGS_ASSERT_MAGIC_SETLVREF;
     if (!SvROK(sv)) Perl_croak(aTHX_ "Assigned value is not a reference");
     PERL_ARGS_ASSERT_MAGIC_SETLVREF;
     if (!SvROK(sv)) Perl_croak(aTHX_ "Assigned value is not a reference");

-    if (SvTYPE(SvRV(sv)) > SVt_PVLV)
+    switch (mg->mg_private & OPpLVREF_TYPE) {
+    case OPpLVREF_SV:
+       if (SvTYPE(SvRV(sv)) > SVt_PVLV)
+           bad = " SCALAR";
+       break;
+    case OPpLVREF_AV:
+       if (SvTYPE(SvRV(sv)) != SVt_PVAV)
+           bad = "n ARRAY";
+       break;
+    case OPpLVREF_HV:
+       if (SvTYPE(SvRV(sv)) != SVt_PVHV)
+           bad = " HASH";
+       break;
+    case OPpLVREF_CV:
+       if (SvTYPE(SvRV(sv)) != SVt_PVCV)
+           bad = " CODE";
+    }
+    if (bad)

        /* diag_listed_as: Assigned value is not %s reference */
        /* diag_listed_as: Assigned value is not %s reference */

-       Perl_croak(aTHX_ "Assigned value is not a SCALAR reference");
-    assert(isGV(mg->mg_obj));
-    gv_setref(mg->mg_obj, sv);
-    SvSETMAGIC(mg->mg_obj);
-    sv_unmagic(sv, PERL_MAGIC_lvref);
+       Perl_croak(aTHX_ "Assigned value is not a%s reference", bad);
+    switch (mg->mg_obj ? SvTYPE(mg->mg_obj) : 0) {
+    case 0:
+    {
+       SV * const old = PAD_SV(mg->mg_len);
+       PAD_SETSV(mg->mg_len, SvREFCNT_inc_NN(SvRV(sv)));
+       SvREFCNT_dec(old);
+       break;
+    }
+    case SVt_PVGV:
+       gv_setref(mg->mg_obj, sv);
+       SvSETMAGIC(mg->mg_obj);
+       break;
+    case SVt_PVAV:
+       av_store((AV *)mg->mg_obj, SvIV((SV *)mg->mg_ptr),
+                SvREFCNT_inc_simple_NN(SvRV(sv)));
+       break;
+    case SVt_PVHV:
+       (void)hv_store_ent((HV *)mg->mg_obj, (SV *)mg->mg_ptr,
+                           SvREFCNT_inc_simple_NN(SvRV(sv)), 0);
+    }
+    if (mg->mg_flags & MGf_PERSIST)
+       NOOP; /* This sv is in use as an iterator var and will be reused,
+                so we must leave the magic.  */
+    else
+       /* This sv could be returned by the assignment op, so clear the
+          magic, as lvrefs are an implementation detail that must not be
+          leaked to the user.  */
+       sv_unmagic(sv, PERL_MAGIC_lvref);

     return 0;
 }
 
     return 0;
 }
 


@@ -2559,15 +2651,43 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #  endif
 #endif
        }
 #  endif
 #endif
        }

-       else if (strEQ(mg->mg_ptr+1, "NCODING")) {
-           SvREFCNT_dec(PL_encoding);
-           if (SvOK(sv) || SvGMAGICAL(sv)) {
-               PL_encoding = newSVsv(sv);
-           }
-           else {
-               PL_encoding = NULL;
-           }
-       }
+       else {
+            unsigned int offset = 1;
+            bool lex = FALSE;
+
+            /* It may be the shadow variable ${E_NCODING} which has lexical
+             * scope.  See comments at Perl__get_encoding in this file */
+            if (*(mg->mg_ptr + 1) == '_') {
+                if (CopSTASH(PL_curcop) != get_hv("encoding::",0))
+                    Perl_croak_no_modify();
+                lex = TRUE;
+                offset++;
+            }
+            if (strEQ(mg->mg_ptr + offset, "NCODING")) {
+                if (lex) {  /* Use the shadow global */
+                    SvREFCNT_dec(PL_lex_encoding);
+                    if (SvOK(sv) || SvGMAGICAL(sv)) {
+                        PL_lex_encoding = newSVsv(sv);
+                    }
+                    else {
+                        PL_lex_encoding = NULL;
+                    }
+                }
+                else { /* Use the regular global */
+                    SvREFCNT_dec(PL_encoding);
+                    if (SvOK(sv) || SvGMAGICAL(sv)) {
+                        if (PL_localizing != 2) {
+                            Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+                                          "Setting ${^ENCODING} is deprecated");
+                        }
+                        PL_encoding = newSVsv(sv);
+                    }
+                    else {
+                        PL_encoding = NULL;
+                    }
+                }
+            }
+        }

        break;
     case '\006':       /* ^F */
        PL_maxsysfd = SvIV(sv);
        break;
     case '\006':       /* ^F */
        PL_maxsysfd = SvIV(sv);


@@ -2687,6 +2807,11 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
                }
            }
        }
                }
            }
        }

+#ifdef WIN32
+       else if (strEQ(mg->mg_ptr+1, "IN32_SLOPPY_STAT")) {
+           w32_sloppystat = (bool)sv_true(sv);
+       }
+#endif

        break;
     case '.':
        if (PL_localizing) {
        break;
     case '.':
        if (PL_localizing) {


@@ -2749,12 +2874,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
                     IV val= SvIV(referent);
                     if (val <= 0) {
                         tmpsv= &PL_sv_undef;
                     IV val= SvIV(referent);
                     if (val <= 0) {
                         tmpsv= &PL_sv_undef;

-                        Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                        Perl_ck_warner_d(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 {
                             "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 {

+                    sv_setsv(sv, PL_rs);

               /* diag_listed_as: Setting $/ to %s reference is forbidden */
                     Perl_croak(aTHX_ "Setting $/ to a%s %s reference is forbidden",
                                       *reftype == 'A' ? "n" : "", reftype);
               /* diag_listed_as: Setting $/ to %s reference is forbidden */
                     Perl_croak(aTHX_ "Setting $/ to a%s %s reference is forbidden",
                                       *reftype == 'A' ? "n" : "", reftype);


@@ -2900,6 +3026,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        }
     case ')':
        {
        }
     case ')':
        {

+/* (hv) best guess: maybe we'll need configure probes to do a better job,
+ * but you can override it if you need to.
+ */
+#ifndef INVALID_GID
+#define INVALID_GID ((Gid_t)-1)
+#endif

         /* XXX $) currently silently ignores failures */
        Gid_t new_egid;
 #ifdef HAS_SETGROUPS
         /* XXX $) currently silently ignores failures */
        Gid_t new_egid;
 #ifdef HAS_SETGROUPS


@@ -2907,6 +3039,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            const char *p = SvPV_const(sv, len);
             Groups_t *gary = NULL;
             const char* endptr;
            const char *p = SvPV_const(sv, len);
             Groups_t *gary = NULL;
             const char* endptr;

+            UV uv;

 #ifdef _SC_NGROUPS_MAX
            int maxgrp = sysconf(_SC_NGROUPS_MAX);
 
 #ifdef _SC_NGROUPS_MAX
            int maxgrp = sysconf(_SC_NGROUPS_MAX);
 


@@ -2918,7 +3051,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 
             while (isSPACE(*p))
                 ++p;
 
             while (isSPACE(*p))
                 ++p;

-            new_egid = (Gid_t)grok_atou(p, &endptr);
+            if (grok_atoUV(p, &uv, &endptr))
+                new_egid = (Gid_t)uv;
+            else {
+                new_egid = INVALID_GID;
+                endptr = NULL;
+            }

             for (i = 0; i < maxgrp; ++i) {
                 if (endptr == NULL)
                     break;
             for (i = 0; i < maxgrp; ++i) {
                 if (endptr == NULL)
                     break;


@@ -2931,7 +3069,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
                     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)grok_atou(p, &endptr);
+                if (grok_atoUV(p, &uv, &endptr))
+                    gary[i] = (Groups_t)uv;
+                else {
+                    gary[i] = INVALID_GID;
+                    endptr = NULL;
+                }

             }
             if (i)
                 PERL_UNUSED_RESULT(setgroups(i, gary));
             }
             if (i)
                 PERL_UNUSED_RESULT(setgroups(i, gary));


@@ -3148,7 +3291,7 @@ Perl_sighandler(int sig)
        if (hek)
            Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
                                "SIG%s handler \"%"HEKf"\" not defined.\n",
        if (hek)
            Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
                                "SIG%s handler \"%"HEKf"\" not defined.\n",

-                                PL_sig_name[sig], hek);
+                                PL_sig_name[sig], HEKfARG(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",
             /* diag_listed_as: SIG%s handler "%s" not defined */
        else Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
                           "SIG%s handler \"__ANON__\" not defined.\n",


@@ -3239,7 +3382,7 @@ Perl_sighandler(int sig)
        }
     }
 
        }
     }
 

-cleanup:
+  cleanup:

     /* pop any of SAVEFREESV, SAVEDESTRUCTOR_X and "save in progress" */
     PL_savestack_ix = old_ss_ix;
     if (flags & 8)
     /* pop any of SAVEFREESV, SAVEDESTRUCTOR_X and "save in progress" */
     PL_savestack_ix = old_ss_ix;
     if (flags & 8)


@@ -3264,12 +3407,6 @@ S_restore_magic(pTHX_ const void *p)
 
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
        SvTEMP_off(sv); /* if it's still magical, this value isn't temporary */
 
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
        SvTEMP_off(sv); /* if it's still magical, this value isn't temporary */

-#ifdef PERL_OLD_COPY_ON_WRITE
-       /* While magic was saved (and off) sv_setsv may well have seen
-          this SV as a prime candidate for COW.  */
-       if (SvIsCOW(sv))
-           sv_force_normal_flags(sv, 0);
-#endif

        if (mgs->mgs_flags)
            SvFLAGS(sv) |= mgs->mgs_flags;
        else
        if (mgs->mgs_flags)
            SvFLAGS(sv) |= mgs->mgs_flags;
        else


@@ -3326,7 +3463,7 @@ S_unwind_handler_stack(pTHX_ const void *p)
 /*
 =for apidoc magic_sethint
 
 /*
 =for apidoc magic_sethint
 

-Triggered by a store to %^H, records the key/value pair to
+Triggered by a store to C<%^H>, records the key/value pair to

 C<PL_compiling.cop_hints_hash>.  It is assumed that hints aren't storing
 anything that would need a deep copy.  Maybe we should warn if we find a
 reference.
 C<PL_compiling.cop_hints_hash>.  It is assumed that hints aren't storing
 anything that would need a deep copy.  Maybe we should warn if we find a
 reference.


@@ -3358,7 +3495,7 @@ Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
 /*
 =for apidoc magic_clearhint
 
 /*
 =for apidoc magic_clearhint
 

-Triggered by a delete from %^H, records the key to
+Triggered by a delete from C<%^H>, records the key to

 C<PL_compiling.cop_hints_hash>.
 
 =cut
 C<PL_compiling.cop_hints_hash>.
 
 =cut


@@ -3382,7 +3519,7 @@ Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg)
 /*
 =for apidoc magic_clearhints
 
 /*
 =for apidoc magic_clearhints
 

-Triggered by clearing %^H, resets C<PL_compiling.cop_hints_hash>.
+Triggered by clearing C<%^H>, resets C<PL_compiling.cop_hints_hash>.

 
 =cut
 */
 
 =cut
 */


@@ -3422,7 +3559,10 @@ int
 Perl_magic_setdebugvar(pTHX_ SV *sv, MAGIC *mg) {
     PERL_ARGS_ASSERT_MAGIC_SETDEBUGVAR;
 
 Perl_magic_setdebugvar(pTHX_ SV *sv, MAGIC *mg) {
     PERL_ARGS_ASSERT_MAGIC_SETDEBUGVAR;
 

-    assert(mg->mg_private >= DBVARMG_SINGLE && mg->mg_private < DBVARMG_COUNT);
+#if DBVARMG_SINGLE != 0
+    assert(mg->mg_private >= DBVARMG_SINGLE);
+#endif
+    assert(mg->mg_private < DBVARMG_COUNT);

 
     PL_DBcontrol[mg->mg_private] = SvIV_nomg(sv);
 
 
     PL_DBcontrol[mg->mg_private] = SvIV_nomg(sv);
 


@@ -3433,18 +3573,15 @@ int
 Perl_magic_getdebugvar(pTHX_ SV *sv, MAGIC *mg) {
     PERL_ARGS_ASSERT_MAGIC_GETDEBUGVAR;
 
 Perl_magic_getdebugvar(pTHX_ SV *sv, MAGIC *mg) {
     PERL_ARGS_ASSERT_MAGIC_GETDEBUGVAR;
 

-    assert(mg->mg_private >= DBVARMG_SINGLE && mg->mg_private < DBVARMG_COUNT);
+#if DBVARMG_SINGLE != 0
+    assert(mg->mg_private >= DBVARMG_SINGLE);
+#endif
+    assert(mg->mg_private < DBVARMG_COUNT);

     sv_setiv(sv, PL_DBcontrol[mg->mg_private]);
 
     return 0;
 }
 
 /*
     sv_setiv(sv, PL_DBcontrol[mg->mg_private]);
 
     return 0;
 }
 
 /*

- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *

  * ex: set ts=8 sts=4 sw=4 et:
  */
  * ex: set ts=8 sts=4 sw=4 et:
  */