add my_[l]stat_flags(); make my_[l]stat() mathoms

my_stat() and my_lstat() call get magic on the stack arg, so create _flags()
variants that allow us to control this. (I can't just change the signature
or the mg_get() behaviour since my_[l]stat() are listed as being in the
public API, even though they're undocumented.)

8 files changed, 48 insertions, 16 deletions

diff --git a/doio.c b/doio.c
index 06f2d3d4c3..5f57b38fb0 100644
--- a/doio.c
+++ b/doio.c
@@ -1258,7 +1258,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
 }
 
 I32
-Perl_my_stat(pTHX)
+Perl_my_stat_flags(pTHX_ const U32 flags)
 {
     dVAR;
     dSP;
@@ -1314,7 +1314,7 @@ Perl_my_stat(pTHX)
             goto do_fstat_have_io;
         }
 
-	s = SvPV_const(sv, len);
+	s = SvPV_flags_const(sv, len, flags);
 	PL_statgv = NULL;
 	sv_setpvn(PL_statname, s, len);
 	s = SvPVX_const(PL_statname);		/* s now NUL-terminated */
@@ -1328,7 +1328,7 @@ Perl_my_stat(pTHX)
 
 
 I32
-Perl_my_lstat(pTHX)
+Perl_my_lstat_flags(pTHX_ const U32 flags)
 {
     dVAR;
     static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
@@ -1361,7 +1361,7 @@ Perl_my_lstat(pTHX)
 		GvENAME((const GV *)SvRV(sv)));
 	return (PL_laststatval = -1);
     }
-    file = SvPV_nolen_const(sv);
+    file = SvPV_flags_const_nolen(sv, flags);
     sv_setpv(PL_statname,file);
     PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
     if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n'))
diff --git a/embed.fnc b/embed.fnc
index 81427fd399..09922164cb 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -738,7 +738,8 @@ Ap	|I32	|my_fflush_all
 Anp	|Pid_t	|my_fork
 Anp	|void	|atfork_lock
 Anp	|void	|atfork_unlock
-Ap	|I32	|my_lstat
+Apmb	|I32	|my_lstat
+pX	|I32	|my_lstat_flags	|NULLOK const U32 flags
 #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP)
 AnpP	|I32	|my_memcmp	|NN const char* s1|NN const char* s2|I32 len
 #endif
@@ -749,7 +750,8 @@ Ap	|I32	|my_pclose	|NULLOK PerlIO* ptr
 Ap	|PerlIO*|my_popen	|NN const char* cmd|NN const char* mode
 Ap	|PerlIO*|my_popen_list	|NN const char* mode|int n|NN SV ** args
 Ap	|void	|my_setenv	|NULLOK const char* nam|NULLOK const char* val
-Ap	|I32	|my_stat
+Apmb	|I32	|my_stat
+pX	|I32	|my_stat_flags	|NULLOK const U32 flags
 Ap	|char *	|my_strftime	|NN const char *fmt|int sec|int min|int hour|int mday|int mon|int year|int wday|int yday|int isdst
 #if defined(MYSWAP)
 ApPa	|short	|my_swap	|short s
diff --git a/embed.h b/embed.h
index 56ac2cf632..82b83e228d 100644
--- a/embed.h
+++ b/embed.h
@@ -561,7 +561,9 @@
 #define my_fork			Perl_my_fork
 #define atfork_lock		Perl_atfork_lock
 #define atfork_unlock		Perl_atfork_unlock
-#define my_lstat		Perl_my_lstat
+#ifdef PERL_CORE
+#define my_lstat_flags		Perl_my_lstat_flags
+#endif
 #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP)
 #define my_memcmp		Perl_my_memcmp
 #endif
@@ -572,7 +574,9 @@
 #define my_popen		Perl_my_popen
 #define my_popen_list		Perl_my_popen_list
 #define my_setenv		Perl_my_setenv
-#define my_stat			Perl_my_stat
+#ifdef PERL_CORE
+#define my_stat_flags		Perl_my_stat_flags
+#endif
 #define my_strftime		Perl_my_strftime
 #if defined(MYSWAP)
 #define my_swap			Perl_my_swap
@@ -2997,7 +3001,9 @@
 #define my_fork			Perl_my_fork
 #define atfork_lock		Perl_atfork_lock
 #define atfork_unlock		Perl_atfork_unlock
-#define my_lstat()		Perl_my_lstat(aTHX)
+#ifdef PERL_CORE
+#define my_lstat_flags(a)	Perl_my_lstat_flags(aTHX_ a)
+#endif
 #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP)
 #define my_memcmp		Perl_my_memcmp
 #endif
@@ -3008,7 +3014,9 @@
 #define my_popen(a,b)		Perl_my_popen(aTHX_ a,b)
 #define my_popen_list(a,b,c)	Perl_my_popen_list(aTHX_ a,b,c)
 #define my_setenv(a,b)		Perl_my_setenv(aTHX_ a,b)
-#define my_stat()		Perl_my_stat(aTHX)
+#ifdef PERL_CORE
+#define my_stat_flags(a)	Perl_my_stat_flags(aTHX_ a)
+#endif
 #define my_strftime(a,b,c,d,e,f,g,h,i,j)	Perl_my_strftime(aTHX_ a,b,c,d,e,f,g,h,i,j)
 #if defined(MYSWAP)
 #define my_swap(a)		Perl_my_swap(aTHX_ a)
diff --git a/global.sym b/global.sym
index 30d89f7106..f7fb28df10 100644
--- a/global.sym
+++ b/global.sym
@@ -314,6 +314,7 @@ Perl_my_fork
 Perl_atfork_lock
 Perl_atfork_unlock
 Perl_my_lstat
+Perl_my_lstat_flags
 Perl_my_memcmp
 Perl_my_memset
 Perl_my_pclose
@@ -321,6 +322,7 @@ Perl_my_popen
 Perl_my_popen_list
 Perl_my_setenv
 Perl_my_stat
+Perl_my_stat_flags
 Perl_my_strftime
 Perl_my_swap
 Perl_my_htonl
diff --git a/mathoms.c b/mathoms.c
index 058d76d568..1bb33d395b 100644
--- a/mathoms.c
+++ b/mathoms.c
@@ -78,6 +78,8 @@ PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
 PERL_CALLCONV AV * Perl_newAV(pTHX);
 PERL_CALLCONV HV * Perl_newHV(pTHX);
 PERL_CALLCONV IO * Perl_newIO(pTHX);
+PERL_CALLCONV I32 Perl_my_stat(pTHX);
+PERL_CALLCONV I32 Perl_my_lstat(pTHX);
 
 /* ref() is now a macro using Perl_doref;
  * this version provided for binary compatibility only.
@@ -1519,6 +1521,18 @@ Perl_newIO(pTHX)
     return MUTABLE_IO(newSV_type(SVt_PVIO));
 }
 
+I32
+Perl_my_stat(pTHX)
+{
+    return my_stat_flags(SV_GMAGIC);
+}
+
+I32
+Perl_my_lstat(pTHX)
+{
+    return my_lstat_flags(SV_GMAGIC);
+}
+
 #endif /* NO_MATHOMS */
 
 /*
diff --git a/perl.h b/perl.h
index b551f4bca4..3d60a33076 100644
--- a/perl.h
+++ b/perl.h
@@ -3425,6 +3425,10 @@ struct nexttoken {
 #include "warnings.h"
 #include "utf8.h"
 
+/* these would be in doio.h if there was such a file */
+#define my_stat()  my_stat_flags(SV_GMAGIC)
+#define my_lstat() my_lstat_flags(SV_GMAGIC)
+
 /* defined in sv.c, but also used in [ach]v.c */
 #undef _XPV_HEAD
 #undef _XPVMG_HEAD
diff --git a/pp_sys.c b/pp_sys.c
index d0b0423d69..8af9799b00 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3133,7 +3133,7 @@ PP(pp_ftrread)
 #endif
     }
 
-    result = my_stat();
+    result = my_stat_flags(SV_GMAGIC);
     SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
@@ -3161,7 +3161,7 @@ PP(pp_ftis)
 
     STACKED_FTEST_CHECK;
 
-    result = my_stat();
+    result = my_stat_flags(SV_GMAGIC);
     SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
@@ -3233,7 +3233,7 @@ PP(pp_ftrowned)
 
     STACKED_FTEST_CHECK;
 
-    result = my_stat();
+    result = my_stat_flags(SV_GMAGIC);
     SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
@@ -3303,7 +3303,7 @@ PP(pp_ftlink)
     I32 result;
 
     tryAMAGICftest_MG('l');
-    result = my_lstat();
+    result = my_lstat_flags(SV_GMAGIC);
     SPAGAIN;
 
     if (result < 0)
diff --git a/proto.h b/proto.h
index 03148fa82c..b1239b882e 100644
--- a/proto.h
+++ b/proto.h
@@ -2082,7 +2082,8 @@ PERL_CALLCONV I32	Perl_my_fflush_all(pTHX);
 PERL_CALLCONV Pid_t	Perl_my_fork(void);
 PERL_CALLCONV void	Perl_atfork_lock(void);
 PERL_CALLCONV void	Perl_atfork_unlock(void);
-PERL_CALLCONV I32	Perl_my_lstat(pTHX);
+/* PERL_CALLCONV I32	Perl_my_lstat(pTHX); */
+PERL_CALLCONV I32	Perl_my_lstat_flags(pTHX_ const U32 flags);
 #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP)
 PERL_CALLCONV I32	Perl_my_memcmp(const char* s1, const char* s2, I32 len)
 			__attribute__pure__
@@ -2113,7 +2114,8 @@ PERL_CALLCONV PerlIO*	Perl_my_popen_list(pTHX_ const char* mode, int n, SV ** ar
 	assert(mode); assert(args)
 
 PERL_CALLCONV void	Perl_my_setenv(pTHX_ const char* nam, const char* val);
-PERL_CALLCONV I32	Perl_my_stat(pTHX);
+/* PERL_CALLCONV I32	Perl_my_stat(pTHX); */
+PERL_CALLCONV I32	Perl_my_stat_flags(pTHX_ const U32 flags);
 PERL_CALLCONV char *	Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, int hour, int mday, int mon, int year, int wday, int yday, int isdst)
 			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_MY_STRFTIME	\