X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/2782061f5102a81e1eae39cce864ce172fbea63d..8f8d807bf58b98d89584dfa59055ff3313e3b961:/mg.c

diff --git a/mg.c b/mg.c
index 064a1ae..0f1c314 100644
--- 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
 
-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
 */
@@ -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
-be >= SVt_PVMG.  See C<sv_magic>.
+be >= C<SVt_PVMG>.  See C<L</sv_magic>>.
 
 =cut
 */
@@ -245,7 +245,7 @@ Perl_mg_get(pTHX_ SV *sv)
 /*
 =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
 */
@@ -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,
-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
-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
 */
@@ -352,7 +352,7 @@ Perl_mg_size(pTHX_ SV *sv)
 /*
 =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
 */
@@ -403,7 +403,7 @@ S_mg_findext_flags(const SV *sv, int type, const MGVTBL *vtbl, U32 flags)
 /*
 =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
 */
@@ -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
-C<sv_magicext>.
+C<L</sv_magicext>>.
 
 =cut
 */
@@ -447,7 +447,7 @@ Perl_mg_find_mglob(pTHX_ SV *sv)
 /*
 =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
 */
@@ -486,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
-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
@@ -553,7 +553,7 @@ S_mg_free_struct(pTHX_ SV *sv, MAGIC *mg)
 /*
 =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
 */
@@ -579,7 +579,7 @@ Perl_mg_free(pTHX_ SV *sv)
 /*
 =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
 */
@@ -1041,6 +1041,11 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 			  *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))) {
@@ -1210,7 +1215,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
     }
 #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) {
@@ -1270,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;
 }
@@ -1782,7 +1787,7 @@ The C<flags> can be:
 
 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
@@ -1810,7 +1815,9 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
     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--) {
@@ -2800,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) {
@@ -3279,7 +3291,7 @@ Perl_sighandler(int sig)
 	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",
@@ -3395,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 */
-#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
@@ -3457,7 +3463,7 @@ S_unwind_handler_stack(pTHX_ const void *p)
 /*
 =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.
@@ -3489,7 +3495,7 @@ Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
 /*
 =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
@@ -3513,7 +3519,7 @@ Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg)
 /*
 =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
 */