SvGETMAGIC: evaluate its argument just once

This required making it into an inline function.  I tried using
STMT_START{ ... } STMT_END, which should work since it has a void
return, but there were places where it was used in a comma operator, and
those did not compile.

5 files changed, 26 insertions, 6 deletions

diff --git a/embed.fnc b/embed.fnc
index 306b42b43a..43ed0c8eac 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1385,6 +1385,7 @@ EXpR	|MAGIC*	|mg_find_mglob	|NN SV* sv
 Apd	|int	|mg_free	|NN SV* sv
 Apd	|void	|mg_free_type	|NN SV* sv|int how
 Apd	|void	|mg_freeext	|NN SV* sv|int how|NULLOK const MGVTBL *vtbl
+Aipd	|void	|SvGETMAGIC	|NN SV *sv
 Apd	|int	|mg_get		|NN SV* sv
 ApdT	|void	|mg_magical	|NN SV* sv
 Apd	|int	|mg_set		|NN SV* sv
diff --git a/embed.h b/embed.h
index 896685a7cd..a220457298 100644
--- a/embed.h
+++ b/embed.h
@@ -31,6 +31,7 @@
 #define Gv_AMupdate(a,b)	Perl_Gv_AMupdate(aTHX_ a,b)
 #define SvAMAGIC_off		Perl_SvAMAGIC_off
 #define SvAMAGIC_on		Perl_SvAMAGIC_on
+#define SvGETMAGIC(a)		Perl_SvGETMAGIC(aTHX_ a)
 #define SvIV(a)			Perl_SvIV(aTHX_ a)
 #define SvIV_nomg(a)		Perl_SvIV_nomg(aTHX_ a)
 #define SvNV(a)			Perl_SvNV(aTHX_ a)
diff --git a/proto.h b/proto.h
index 050697fff5..7b1ce4da22 100644
--- a/proto.h
+++ b/proto.h
@@ -79,6 +79,11 @@ PERL_STATIC_INLINE void	Perl_SvAMAGIC_on(SV *sv);
 	assert(sv)
 #endif
 #ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE void	Perl_SvGETMAGIC(pTHX_ SV *sv);
+#define PERL_ARGS_ASSERT_SVGETMAGIC	\
+	assert(sv)
+#endif
+#ifndef PERL_NO_INLINE_FUNCTIONS
 PERL_STATIC_INLINE IV	Perl_SvIV(pTHX_ SV *sv);
 #define PERL_ARGS_ASSERT_SVIV	\
 	assert(sv)
diff --git a/sv.h b/sv.h
index 639fb6386e..4a7dbea1d5 100644
--- a/sv.h
+++ b/sv.h
@@ -2224,11 +2224,6 @@ for the original SV is incremented.
 /*
 =for apidoc_section $SV
 
-=for apidoc Am|void|SvGETMAGIC|SV* sv
-Invokes C<L</mg_get>> on an SV if it has 'get' magic.  For example, this
-will call C<FETCH> on a tied variable.  This macro evaluates its
-argument more than once.
-
 =for apidoc Am|void|SvSETMAGIC|SV* sv
 Invokes C<L</mg_set>> on an SV if it has 'set' magic.  This is necessary
 after modifying a scalar, in case it is a magical variable like C<$|>
@@ -2290,7 +2285,6 @@ properly null terminated. Equivalent to sv_setpvs(""), but more efficient.
 #define SvUNLOCK(sv) PL_unlockhook(aTHX_ sv)
 #define SvDESTROYABLE(sv) PL_destroyhook(aTHX_ sv)
 
-#define SvGETMAGIC(x) ((void)(UNLIKELY(SvGMAGICAL(x)) && mg_get(x)))
 #define SvSETMAGIC(x) STMT_START { if (UNLIKELY(SvSMAGICAL(x))) mg_set(x); } STMT_END
 
 #define SvSetSV_and(dst,src,finally) \
diff --git a/sv_inline.h b/sv_inline.h
index c495d3cea0..2c2eff27df 100644
--- a/sv_inline.h
+++ b/sv_inline.h
@@ -565,6 +565,25 @@ Perl_SvPVXtrue(pTHX_ SV *sv)
     return *sv->sv_u.svu_pv != '0';
 }
 
+/*
+=for apidoc SvGETMAGIC
+Invokes C<L</mg_get>> on an SV if it has 'get' magic.  For example, this
+will call C<FETCH> on a tied variable.  As of 5.37.1, this function is
+guaranteed to evaluate its argument exactly once.
+
+=cut
+*/
+
+PERL_STATIC_INLINE void
+Perl_SvGETMAGIC(pTHX_ SV *sv)
+{
+    PERL_ARGS_ASSERT_SVGETMAGIC;
+
+    if (UNLIKELY(SvGMAGICAL(sv))) {
+        mg_get(sv);
+    }
+}
+
 PERL_STATIC_INLINE bool
 Perl_SvTRUE(pTHX_ SV *sv)
 {