Correct version number for Module::CoreList.

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index d2a8db0..cbabcc6 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
 */


@@ -403,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
 */


@@ -418,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
 */


@@ -447,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
 */


@@ -471,9 +471,7 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
                sv_magic(nsv,
                     (type == PERL_MAGIC_tied)
                        ? SvTIED_obj(sv, mg)
                sv_magic(nsv,
                     (type == PERL_MAGIC_tied)
                        ? SvTIED_obj(sv, mg)

-                       : (type == PERL_MAGIC_regdata && mg->mg_obj)
-                           ? sv
-                           : mg->mg_obj,
+                        : mg->mg_obj,

                     toLOWER(type), key, klen);
                count++;
            }
                     toLOWER(type), key, klen);
                count++;
            }


@@ -486,12 +484,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


@@ -553,7 +551,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
 */


@@ -579,7 +577,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
 */


@@ -619,12 +617,13 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_REGDATA_CNT;
 
     if (PL_curpm) {
     PERL_ARGS_ASSERT_MAGIC_REGDATA_CNT;
 
     if (PL_curpm) {

-       const REGEXP * const rx = PM_GETRE(PL_curpm);
+        REGEXP * const rx = PM_GETRE(PL_curpm);

        if (rx) {
        if (rx) {

-           if (mg->mg_obj) {                   /* @+ */
+            UV uv= (UV)mg->mg_obj;
+            if (uv == '+') {          /* @+ */

                /* return the number possible */
                return RX_NPARENS(rx);
                /* return the number possible */
                return RX_NPARENS(rx);

-           } else {                            /* @- */
+            } else {   /* @- @^CAPTURE  @{^CAPTURE} */

                I32 paren = RX_LASTPAREN(rx);
 
                /* return the last filled */
                I32 paren = RX_LASTPAREN(rx);
 
                /* return the last filled */


@@ -632,8 +631,14 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
                        && (RX_OFFS(rx)[paren].start == -1
                            || RX_OFFS(rx)[paren].end == -1) )
                    paren--;
                        && (RX_OFFS(rx)[paren].start == -1
                            || RX_OFFS(rx)[paren].end == -1) )
                    paren--;

-               return (U32)paren;
-           }
+                if (uv == '-') {
+                    /* @- */
+                    return (U32)paren;
+                } else {
+                    /* @^CAPTURE @{^CAPTURE} */
+                    return paren >= 0 ? (U32)(paren-1) : (U32)-1;
+                }
+            }

        }
     }
 
        }
     }
 


@@ -648,9 +653,12 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_REGDATUM_GET;
 
     if (PL_curpm) {
     PERL_ARGS_ASSERT_MAGIC_REGDATUM_GET;
 
     if (PL_curpm) {

-       const REGEXP * const rx = PM_GETRE(PL_curpm);
+        REGEXP * const rx = PM_GETRE(PL_curpm);

        if (rx) {
        if (rx) {

-           const I32 paren = mg->mg_len;
+            const UV uv= (UV)mg->mg_obj;
+            /* @{^CAPTURE} does not contain $&, so we need to increment by 1 */
+            const I32 paren = mg->mg_len
+                            + (uv == '\003' ? 1 : 0);

            SSize_t s;
            SSize_t t;
            if (paren < 0)
            SSize_t s;
            SSize_t t;
            if (paren < 0)


@@ -660,10 +668,15 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
                (t = RX_OFFS(rx)[paren].end) != -1)
                {
                    SSize_t i;
                (t = RX_OFFS(rx)[paren].end) != -1)
                {
                    SSize_t i;

-                   if (mg->mg_obj)             /* @+ */
+
+                    if (uv == '+')                /* @+ */

                        i = t;
                        i = t;

-                   else                        /* @- */
+                    else if (uv == '-')           /* @- */

                        i = s;
                        i = s;

+                    else {                        /* @^CAPTURE @{^CAPTURE} */
+                        CALLREG_NUMBUF_FETCH(rx,paren,sv);
+                        return 0;
+                    }

 
                    if (RX_MATCH_UTF8(rx)) {
                        const char * const b = RX_SUBBEG(rx);
 
                    if (RX_MATCH_UTF8(rx)) {
                        const char * const b = RX_SUBBEG(rx);


@@ -712,9 +725,9 @@ Perl_emulate_cop_io(pTHX_ const COP *const c, SV *const sv)
     PERL_ARGS_ASSERT_EMULATE_COP_IO;
 
     if (!(CopHINTS_get(c) & (HINT_LEXICAL_IO_IN|HINT_LEXICAL_IO_OUT)))
     PERL_ARGS_ASSERT_EMULATE_COP_IO;
 
     if (!(CopHINTS_get(c) & (HINT_LEXICAL_IO_IN|HINT_LEXICAL_IO_OUT)))

-       sv_setsv(sv, &PL_sv_undef);
+       sv_set_undef(sv);

     else {
     else {

-       sv_setpvs(sv, "");
+        SvPVCLEAR(sv);

        SvUTF8_off(sv);
        if ((CopHINTS_get(c) & HINT_LEXICAL_IO_IN)) {
            SV *const value = cop_hints_fetch_pvs(c, "open<", 0);
        SvUTF8_off(sv);
        if ((CopHINTS_get(c) & HINT_LEXICAL_IO_IN)) {
            SV *const value = cop_hints_fetch_pvs(c, "open<", 0);


@@ -758,7 +771,7 @@ S_fixup_errno_string(pTHX_ SV* sv)
          * 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' */
          * 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_invariant_string((U8*) SvPVX_const(sv), SvCUR(sv))
+            && ! is_utf8_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);


@@ -766,46 +779,6 @@ 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>


@@ -827,9 +800,9 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
         if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
           do_numbuf_fetch:
             CALLREG_NUMBUF_FETCH(rx,paren,sv);
         if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
           do_numbuf_fetch:
             CALLREG_NUMBUF_FETCH(rx,paren,sv);

-        } else {
-            sv_setsv(sv,&PL_sv_undef);

         }
         }

+        else
+            goto set_undef;

         return 0;
     }
 
         return 0;
     }
 


@@ -837,7 +810,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     switch (*mg->mg_ptr) {
     case '\001':               /* ^A */
        if (SvOK(PL_bodytarget)) sv_copypv(sv, PL_bodytarget);
     switch (*mg->mg_ptr) {
     case '\001':               /* ^A */
        if (SvOK(PL_bodytarget)) sv_copypv(sv, PL_bodytarget);

-       else sv_setsv(sv, &PL_sv_undef);
+       else
+            sv_set_undef(sv);

        if (SvTAINTED(PL_bodytarget))
            SvTAINTED_on(sv);
        break;
        if (SvTAINTED(PL_bodytarget))
            SvTAINTED_on(sv);
        break;


@@ -856,8 +830,6 @@ 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, _get_encoding());
-            else if (strEQ(remaining, "_NCODING"))

                 sv_setsv(sv, NULL);
             break;
         }
                 sv_setsv(sv, NULL);
             break;
         }


@@ -871,7 +843,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
             if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
                 sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
             else
             if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
                 sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
             else

-                sv_setpvs(sv,"");
+                SvPVCLEAR(sv);

         }
 #elif defined(OS2)
         if (!(_emx_env & 0x200)) {     /* Under DOS */
         }
 #elif defined(OS2)
         if (!(_emx_env & 0x200)) {     /* Under DOS */


@@ -898,7 +870,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                 fixup_errno_string(sv);
             }
             else
                 fixup_errno_string(sv);
             }
             else

-                sv_setpvs(sv, "");
+                SvPVCLEAR(sv);

             SetLastError(dwErr);
         }
 #   else
             SetLastError(dwErr);
         }
 #   else


@@ -924,7 +896,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
             else
 #endif
             if (! errno) {
             else
 #endif
             if (! errno) {

-                sv_setpvs(sv, "");
+                SvPVCLEAR(sv);

             }
             else {
 
             }
             else {
 


@@ -1023,8 +995,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
            }
            else if (PL_compiling.cop_warnings == pWARN_STD) {
                sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
            }
            else if (PL_compiling.cop_warnings == pWARN_STD) {

-               sv_setsv(sv, &PL_sv_undef);
-               break;
+                goto set_undef;

            }
             else if (PL_compiling.cop_warnings == pWARN_ALL) {
                /* Get the bit mask for $warnings::Bits{all}, because
            }
             else if (PL_compiling.cop_warnings == pWARN_ALL) {
                /* Get the bit mask for $warnings::Bits{all}, because


@@ -1041,6 +1012,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))) {


@@ -1048,16 +1024,14 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
            if (paren)
                 goto do_numbuf_fetch;
        }
            if (paren)
                 goto do_numbuf_fetch;
        }

-       sv_setsv(sv,&PL_sv_undef);
-       break;
+        goto set_undef;

     case '\016':               /* ^N */
        if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
            paren = RX_LASTCLOSEPAREN(rx);
            if (paren)
                 goto do_numbuf_fetch;
        }
     case '\016':               /* ^N */
        if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
            paren = RX_LASTCLOSEPAREN(rx);
            if (paren)
                 goto do_numbuf_fetch;
        }

-       sv_setsv(sv,&PL_sv_undef);
-       break;
+        goto set_undef;

     case '.':
        if (GvIO(PL_last_in_gv)) {
            sv_setiv(sv, (IV)IoLINES(GvIOp(PL_last_in_gv)));
     case '.':
        if (GvIO(PL_last_in_gv)) {
            sv_setiv(sv, (IV)IoLINES(GvIOp(PL_last_in_gv)));


@@ -1116,7 +1090,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        if (PL_ors_sv)
            sv_copypv(sv, PL_ors_sv);
        else
        if (PL_ors_sv)
            sv_copypv(sv, PL_ors_sv);
        else

-           sv_setsv(sv, &PL_sv_undef);
+            goto set_undef;

        break;
     case '$': /* $$ */
        {
        break;
     case '$': /* $$ */
        {


@@ -1151,7 +1125,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                 Newx(gary, num_groups, Groups_t);
                 num_groups = getgroups(num_groups, gary);
                 for (i = 0; i < num_groups; i++)
                 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]);
+                    Perl_sv_catpvf(aTHX_ sv, " %" IVdf, (IV)gary[i]);

                 Safefree(gary);
             }
        }
                 Safefree(gary);
             }
        }


@@ -1162,6 +1136,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        break;
     }
     return 0;
        break;
     }
     return 0;

+
+  set_undef:
+    sv_set_undef(sv);
+    return 0;

 }
 
 int
 }
 
 int


@@ -1210,13 +1188,13 @@ 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) {
        MgTAINTEDDIR_off(mg);
 #ifdef VMS
                            /* And you'll never guess what the dog had */
                            /*   in its mouth... */
     if (TAINTING_get) {
        MgTAINTEDDIR_off(mg);
 #ifdef VMS

-       if (s && klen == 8 && strEQ(key, "DCL$PATH")) {
+       if (s && memEQs(key, klen, "DCL$PATH")) {

            char pathbuf[256], eltbuf[256], *cp, *elt;
            int i = 0, j = 0;
 
            char pathbuf[256], eltbuf[256], *cp, *elt;
            int i = 0, j = 0;
 


@@ -1242,24 +1220,29 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
            } while (my_trnlnm(s, pathbuf, i++) && (elt = pathbuf));
        }
 #endif /* VMS */
            } while (my_trnlnm(s, pathbuf, i++) && (elt = pathbuf));
        }
 #endif /* VMS */

-       if (s && klen == 4 && strEQ(key,"PATH")) {
+       if (s && memEQs(key, klen, "PATH")) {

            const char * const strend = s + len;
 
            const char * const strend = s + len;
 

+            /* set MGf_TAINTEDDIR if any component of the new path is
+             * relative or world-writeable */

            while (s < strend) {
                char tmpbuf[256];
                Stat_t st;
                I32 i;
            while (s < strend) {
                char tmpbuf[256];
                Stat_t st;
                I32 i;

-#ifdef VMS  /* Hmm.  How do we get $Config{path_sep} from C? */
-               const char path_sep = '|';
+#ifdef __VMS  /* Hmm.  How do we get $Config{path_sep} from C? */
+               const char path_sep = PL_perllib_sep;

 #else
                const char path_sep = ':';
 #endif
 #else
                const char path_sep = ':';
 #endif

-               s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
+               s = delimcpy_no_escape(tmpbuf, tmpbuf + sizeof tmpbuf,

                             s, strend, path_sep, &i);
                s++;
                if (i >= (I32)sizeof tmpbuf   /* too long -- assume the worst */
                             s, strend, path_sep, &i);
                s++;
                if (i >= (I32)sizeof tmpbuf   /* too long -- assume the worst */

-#ifdef VMS
-                     || !strchr(tmpbuf, ':') /* no colon thus no device name -- assume relative path */
+#ifdef __VMS
+                     /* no colon thus no device name -- assume relative path */
+                     || (PL_perllib_sep != ':' && !strchr(tmpbuf, ':'))
+                     /* Using Unix separator, e.g. under bash, so act line Unix */
+                     || (PL_perllib_sep == ':' && *tmpbuf != '/')

 #else
                      || *tmpbuf != '/'       /* no starting slash -- assume relative path */
 #endif
 #else
                      || *tmpbuf != '/'       /* no starting slash -- assume relative path */
 #endif


@@ -1270,7 +1253,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;
 }


@@ -1360,7 +1343,7 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
            if(sigstate == (Sighandler_t) SIG_IGN)
                sv_setpvs(sv,"IGNORE");
            else
            if(sigstate == (Sighandler_t) SIG_IGN)
                sv_setpvs(sv,"IGNORE");
            else

-               sv_setsv(sv,&PL_sv_undef);
+                sv_set_undef(sv);

            PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv);
            SvTEMP_off(sv);
        }
            PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv);
            SvTEMP_off(sv);
        }


@@ -1782,7 +1765,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


@@ -1802,6 +1785,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;
     }


@@ -1809,7 +1793,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--) {


@@ -2018,7 +2004,7 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
 
     /* The magic ptr/len for the debugger's hash should always be an SV.  */
     if (UNLIKELY(mg->mg_len != HEf_SVKEY)) {
 
     /* The magic ptr/len for the debugger's hash should always be an SV.  */
     if (UNLIKELY(mg->mg_len != HEf_SVKEY)) {

-        Perl_croak(aTHX_ "panic: magic_setdbline len=%"IVdf", ptr='%s'",
+        Perl_croak(aTHX_ "panic: magic_setdbline len=%" IVdf ", ptr='%s'",

                    (IV)mg->mg_len, mg->mg_ptr);
     }
 
                    (IV)mg->mg_len, mg->mg_ptr);
     }
 


@@ -2205,7 +2191,7 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
            negrem ? -(IV)rem  : (IV)rem,  !negrem, &offs, &rem
     )) {
        Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
            negrem ? -(IV)rem  : (IV)rem,  !negrem, &offs, &rem
     )) {
        Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");

-       sv_setsv_nomg(sv, &PL_sv_undef);
+        sv_set_undef(sv);

        return 0;
     }
 
        return 0;
     }
 


@@ -2459,13 +2445,9 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
 
     PERL_ARGS_ASSERT_MAGIC_SETREGEXP;
 
 
     PERL_ARGS_ASSERT_MAGIC_SETREGEXP;
 

-    if (type == PERL_MAGIC_qr) {
-    } else if (type == PERL_MAGIC_bm) {
-       SvTAIL_off(sv);
-       SvVALID_off(sv);
-    } else {
-       assert(type == PERL_MAGIC_fm);
-    }
+    assert(    type == PERL_MAGIC_fm
+            || type == PERL_MAGIC_qr
+            || type == PERL_MAGIC_bm);

     return sv_unmagic(sv, type);
 }
 
     return sv_unmagic(sv, type);
 }
 


@@ -2560,13 +2542,92 @@ Perl_magic_setlvref(pTHX_ SV *sv, MAGIC *mg)
     return 0;
 }
 
     return 0;
 }
 

+static void
+S_set_dollarzero(pTHX_ SV *sv)
+    PERL_TSA_REQUIRES(PL_dollarzero_mutex)
+{
+#ifdef USE_ITHREADS
+    dVAR;
+#endif
+    const char *s;
+    STRLEN len;
+#ifdef HAS_SETPROCTITLE
+    /* The BSDs don't show the argv[] in ps(1) output, they
+     * show a string from the process struct and provide
+     * the setproctitle() routine to manipulate that. */
+    if (PL_origalen != 1) {
+        s = SvPV_const(sv, len);
+#   if __FreeBSD_version > 410001
+        /* The leading "-" removes the "perl: " prefix,
+         * but not the "(perl) suffix from the ps(1)
+         * output, because that's what ps(1) shows if the
+         * argv[] is modified. */
+        setproctitle("-%s", s);
+#   else       /* old FreeBSDs, NetBSD, OpenBSD, anyBSD */
+        /* This doesn't really work if you assume that
+         * $0 = 'foobar'; will wipe out 'perl' from the $0
+         * because in ps(1) output the result will be like
+         * sprintf("perl: %s (perl)", s)
+         * I guess this is a security feature:
+         * one (a user process) cannot get rid of the original name.
+         * --jhi */
+        setproctitle("%s", s);
+#   endif
+    }
+#elif defined(__hpux) && defined(PSTAT_SETCMD)
+    if (PL_origalen != 1) {
+        union pstun un;
+        s = SvPV_const(sv, len);
+        un.pst_command = (char *)s;
+        pstat(PSTAT_SETCMD, un, len, 0, 0);
+    }
+#else
+    if (PL_origalen > 1) {
+        I32 i;
+        /* PL_origalen is set in perl_parse(). */
+        s = SvPV_force(sv,len);
+        if (len >= (STRLEN)PL_origalen-1) {
+            /* Longer than original, will be truncated. We assume that
+             * PL_origalen bytes are available. */
+            Copy(s, PL_origargv[0], PL_origalen-1, char);
+        }
+        else {
+            /* Shorter than original, will be padded. */
+#ifdef PERL_DARWIN
+            /* Special case for Mac OS X: see [perl #38868] */
+            const int pad = 0;
+#else
+            /* Is the space counterintuitive?  Yes.
+             * (You were expecting \0?)
+             * Does it work?  Seems to.  (In Linux 2.4.20 at least.)
+             * --jhi */
+            const int pad = ' ';
+#endif
+            Copy(s, PL_origargv[0], len, char);
+            PL_origargv[0][len] = 0;
+            memset(PL_origargv[0] + len + 1,
+                   pad,  PL_origalen - len - 1);
+        }
+        PL_origargv[0][PL_origalen-1] = 0;
+        for (i = 1; i < PL_origargc; i++)
+            PL_origargv[i] = 0;
+#ifdef HAS_PRCTL_SET_NAME
+        /* Set the legacy process name in addition to the POSIX name on Linux */
+        if (prctl(PR_SET_NAME, (unsigned long)s, 0, 0, 0) != 0) {
+            /* diag_listed_as: SKIPME */
+            Perl_croak(aTHX_ "Can't set $0 with prctl(): %s", Strerror(errno));
+        }
+#endif
+    }
+#endif
+}
+

 int
 Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 {
 #ifdef USE_ITHREADS
     dVAR;
 #endif
 int
 Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 {
 #ifdef USE_ITHREADS
     dVAR;
 #endif

-    const char *s;

     I32 paren;
     const REGEXP * rx;
     I32 i;
     I32 paren;
     const REGEXP * rx;
     I32 i;


@@ -2618,10 +2679,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 
     case '\004':       /* ^D */
 #ifdef DEBUGGING
 
     case '\004':       /* ^D */
 #ifdef DEBUGGING

-       s = SvPV_nolen_const(sv);
-       PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;
-       if (DEBUG_x_TEST || DEBUG_B_TEST)
-           dump_all_perl(!DEBUG_B_TEST);
+        {
+            const char *s = SvPV_nolen_const(sv);
+            PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;
+            if (DEBUG_x_TEST || DEBUG_B_TEST)
+                dump_all_perl(!DEBUG_B_TEST);
+        }

 #else
        PL_debug = (SvIV(sv)) | DEBUG_TOP_FLAG;
 #endif
 #else
        PL_debug = (SvIV(sv)) | DEBUG_TOP_FLAG;
 #endif


@@ -2644,41 +2707,11 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #endif
        }
        else {
 #endif
        }
        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 (strEQ(mg->mg_ptr + 1, "NCODING") && SvOK(sv))

                         if (PL_localizing != 2) {
                             Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
                         if (PL_localizing != 2) {
                             Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),

-                                          "Setting ${^ENCODING} is deprecated");
+                                    "${^ENCODING} is no longer supported");

                         }
                         }

-                        PL_encoding = newSVsv(sv);
-                    }
-                    else {
-                        PL_encoding = NULL;
-                    }
-                }
-            }

         }
        break;
     case '\006':       /* ^F */
         }
        break;
     case '\006':       /* ^F */


@@ -2799,6 +2832,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) {


@@ -2810,12 +2848,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        break;
     case '^':
        Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
        break;
     case '^':
        Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));

-       s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
+       IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);

        IoTOP_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
        break;
     case '~':
        Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
        IoTOP_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
        break;
     case '~':
        Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));

-       s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
+       IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);

        IoFMT_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
        break;
     case '=':
        IoFMT_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
        break;
     case '=':


@@ -3013,6 +3051,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


@@ -3020,6 +3064,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);
 


@@ -3031,7 +3076,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;


@@ -3044,7 +3094,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));


@@ -3093,74 +3148,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        break;
     case '0':
        LOCK_DOLLARZERO_MUTEX;
        break;
     case '0':
        LOCK_DOLLARZERO_MUTEX;

-#ifdef HAS_SETPROCTITLE
-       /* The BSDs don't show the argv[] in ps(1) output, they
-        * show a string from the process struct and provide
-        * the setproctitle() routine to manipulate that. */
-       if (PL_origalen != 1) {
-           s = SvPV_const(sv, len);
-#   if __FreeBSD_version > 410001
-           /* The leading "-" removes the "perl: " prefix,
-            * but not the "(perl) suffix from the ps(1)
-            * output, because that's what ps(1) shows if the
-            * argv[] is modified. */
-           setproctitle("-%s", s);
-#   else       /* old FreeBSDs, NetBSD, OpenBSD, anyBSD */
-           /* This doesn't really work if you assume that
-            * $0 = 'foobar'; will wipe out 'perl' from the $0
-            * because in ps(1) output the result will be like
-            * sprintf("perl: %s (perl)", s)
-            * I guess this is a security feature:
-            * one (a user process) cannot get rid of the original name.
-            * --jhi */
-           setproctitle("%s", s);
-#   endif
-       }
-#elif defined(__hpux) && defined(PSTAT_SETCMD)
-       if (PL_origalen != 1) {
-            union pstun un;
-            s = SvPV_const(sv, len);
-            un.pst_command = (char *)s;
-            pstat(PSTAT_SETCMD, un, len, 0, 0);
-       }
-#else
-       if (PL_origalen > 1) {
-           /* PL_origalen is set in perl_parse(). */
-           s = SvPV_force(sv,len);
-           if (len >= (STRLEN)PL_origalen-1) {
-               /* Longer than original, will be truncated. We assume that
-                * PL_origalen bytes are available. */
-               Copy(s, PL_origargv[0], PL_origalen-1, char);
-           }
-           else {
-               /* Shorter than original, will be padded. */
-#ifdef PERL_DARWIN
-               /* Special case for Mac OS X: see [perl #38868] */
-               const int pad = 0;
-#else
-               /* Is the space counterintuitive?  Yes.
-                * (You were expecting \0?)
-                * Does it work?  Seems to.  (In Linux 2.4.20 at least.)
-                * --jhi */
-               const int pad = ' ';
-#endif
-               Copy(s, PL_origargv[0], len, char);
-               PL_origargv[0][len] = 0;
-               memset(PL_origargv[0] + len + 1,
-                      pad,  PL_origalen - len - 1);
-           }
-           PL_origargv[0][PL_origalen-1] = 0;
-           for (i = 1; i < PL_origargc; i++)
-               PL_origargv[i] = 0;
-#ifdef HAS_PRCTL_SET_NAME
-           /* Set the legacy process name in addition to the POSIX name on Linux */
-           if (prctl(PR_SET_NAME, (unsigned long)s, 0, 0, 0) != 0) {
-               /* diag_listed_as: SKIPME */
-               Perl_croak(aTHX_ "Can't set $0 with prctl(): %s", Strerror(errno));
-           }
-#endif
-       }
-#endif
+        S_set_dollarzero(aTHX_ sv);

        UNLOCK_DOLLARZERO_MUTEX;
        break;
     }
        UNLOCK_DOLLARZERO_MUTEX;
        break;
     }


@@ -3260,8 +3248,8 @@ Perl_sighandler(int sig)
                           : cv && CvGV(cv) ? GvENAME_HEK(CvGV(cv)) : NULL;
        if (hek)
            Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
                           : 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);
+                               "SIG%s handler \"%" HEKf "\" not defined.\n",
+                                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",


@@ -3296,13 +3284,27 @@ Perl_sighandler(int sig)
                    * addr, status, and band are defined by POSIX/SUSv3. */
                   (void)hv_stores(sih, "signo", newSViv(sip->si_signo));
                   (void)hv_stores(sih, "code", newSViv(sip->si_code));
                    * addr, status, and band are defined by POSIX/SUSv3. */
                   (void)hv_stores(sih, "signo", newSViv(sip->si_signo));
                   (void)hv_stores(sih, "code", newSViv(sip->si_code));

-#if 0 /* XXX TODO: Configure scan for the existence of these, but even that does not help if the SA_SIGINFO is not implemented according to the spec. */
-                  hv_stores(sih, "errno",      newSViv(sip->si_errno));
-                  hv_stores(sih, "status",     newSViv(sip->si_status));
-                  hv_stores(sih, "uid",        newSViv(sip->si_uid));
-                  hv_stores(sih, "pid",        newSViv(sip->si_pid));
-                  hv_stores(sih, "addr",       newSVuv(PTR2UV(sip->si_addr)));
-                  hv_stores(sih, "band",       newSViv(sip->si_band));
+#ifdef HAS_SIGINFO_SI_ERRNO
+                  (void)hv_stores(sih, "errno",      newSViv(sip->si_errno));
+#endif
+#ifdef HAS_SIGINFO_SI_STATUS
+                  (void)hv_stores(sih, "status",     newSViv(sip->si_status));
+#endif
+#ifdef HAS_SIGINFO_SI_UID
+                  {
+                       SV *uid = newSV(0);
+                       sv_setuid(uid, sip->si_uid);
+                       (void)hv_stores(sih, "uid", uid);
+                  }
+#endif
+#ifdef HAS_SIGINFO_SI_PID
+                  (void)hv_stores(sih, "pid",        newSViv(sip->si_pid));
+#endif
+#ifdef HAS_SIGINFO_SI_ADDR
+                  (void)hv_stores(sih, "addr",       newSVuv(PTR2UV(sip->si_addr)));
+#endif
+#ifdef HAS_SIGINFO_SI_BAND
+                  (void)hv_stores(sih, "band",       newSViv(sip->si_band));

 #endif
                   EXTEND(SP, 2);
                   PUSHs(rv);
 #endif
                   EXTEND(SP, 2);
                   PUSHs(rv);


@@ -3377,12 +3379,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


@@ -3439,7 +3435,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.


@@ -3471,7 +3467,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


@@ -3495,7 +3491,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
 */


@@ -3559,11 +3555,5 @@ Perl_magic_getdebugvar(pTHX_ SV *sv, MAGIC *mg) {
 }
 
 /*
 }
 
 /*

- * 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:
  */