Perl_sv_can_can_swipe_pv_buf - extracts swipe test from Perl_sv_setsv_flags

Perl_sv_setsv_flags contains the canonical logic for determining the best
method for assigning the string value from a source SV to a destination SV:
  * "Swipe" the string buffer from the source SV
  * COW the source SV's string buffer
  * Do a full copy

This commit extracts the "can the swipe the buffer" tests out into a new
macro (`S_SvPV_can_swipe_buf`) within sv.c. It has two users:
  * Perl_sv_setsv_flags - so that the logic remains inline in this hot code
  * Perl_sv_can_can_swipe_pv_buf - a new function

`pp_reverse` will shortly make use of the new function to avoid unnecessary
string copies when doing a reversal in scalar context.

Author: richardleach

embed.fnc

@@ -3114,6 +3114,8 @@ Adp	|SV *	|sv_bless	|NN SV * const sv			\
 Cdmp	|bool	|sv_2bool	|NN SV * const sv
 Cdp	|bool	|sv_2bool_flags |NN SV *sv				\
 				|I32 flags
+Cp	|bool	|sv_can_swipe_pv_buf					\
+				|NN SV *sv
 Adp	|bool	|sv_cat_decode	|NN SV *dsv				\
 				|NN SV *encoding			\
 				|NN SV *ssv				\

embed.h

@@ -707,6 +707,7 @@
 # define sv_2uv_flags(a,b)                      Perl_sv_2uv_flags(aTHX_ a,b)
 # define sv_backoff                             Perl_sv_backoff
 # define sv_bless(a,b)                          Perl_sv_bless(aTHX_ a,b)
+# define sv_can_swipe_pv_buf(a)                 Perl_sv_can_swipe_pv_buf(aTHX_ a)
 # define sv_cat_decode(a,b,c,d,e,f)             Perl_sv_cat_decode(aTHX_ a,b,c,d,e,f)
 # define sv_catpv(a,b)                          Perl_sv_catpv(aTHX_ a,b)
 # define sv_catpv_flags(a,b,c)                  Perl_sv_catpv_flags(aTHX_ a,b,c)

proto.h

@@ -4187,6 +4187,33 @@ S_sv_buf_to_rw(pTHX_ SV *sv)
 # define sv_buf_to_rw(sv)	NOOP
 #endif
 
+
+/* The test in this macro was extracted from Perl_sv_setsv_flags so that it
+ * could be used elsewhere. */
+#define S_SvPV_can_swipe_buf(ssv, sflags, cur, len)                   \
+    (( /* Either ... */                                                    \
+      /* slated for free anyway (and not COW)? */                          \
+      ((sflags & (SVs_TEMP|SVf_IsCOW)) == SVs_TEMP)                        \
+      /* or a swipable TARG */                                             \
+      || ((sflags &                                                        \
+            (SVs_PADTMP|SVf_READONLY|SVf_PROTECT|SVf_IsCOW))== SVs_PADTMP  \
+            /* whose buffer is worth stealing */                           \
+            && CHECK_COWBUF_THRESHOLD(cur,len)                             \
+         )                                                                 \
+    ) && !(sflags & SVf_OOK)     /* and not involved in OOK hack? */       \
+      && (SvREFCNT(ssv) == 1)      /* and no other references to it? */    \
+      && len                    /* and really is a string */               \
+    )
+
+/* Perl_sv_can_swipe_pv_buf was originally created for pp_reverse. */
+bool
+Perl_sv_can_swipe_pv_buf(pTHX_ SV *sv)
+{
+    PERL_ARGS_ASSERT_SV_CAN_SWIPE_PV_BUF;
+    assert(sv);
+    return S_SvPV_can_swipe_buf(sv, SvFLAGS(sv), SvCUR(sv), SvLEN(sv)) ? true : false;
+}
+
 void
 Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags)
 {
@@ -4593,23 +4620,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags)
            and doing it now facilitates the COW check.  */
         (void)SvPOK_only(dsv);
 
-        if (
-                 (              /* Either ... */
-                                /* slated for free anyway (and not COW)? */
-                    (sflags & (SVs_TEMP|SVf_IsCOW)) == SVs_TEMP
-                                /* or a swipable TARG */
-                 || ((sflags &
-                           (SVs_PADTMP|SVf_READONLY|SVf_PROTECT|SVf_IsCOW))
-                       == SVs_PADTMP
-                                /* whose buffer is worth stealing */
-                     && CHECK_COWBUF_THRESHOLD(cur,len)
-                    )
-                 ) &&
-                 !(sflags & SVf_OOK) &&   /* and not involved in OOK hack? */
-                 (!(flags & SV_NOSTEAL)) &&
-                                        /* and we're allowed to steal temps */
-                 SvREFCNT(ssv) == 1 &&   /* and no other references to it? */
-                 len)             /* and really is a string */
+        if ( !(flags & SV_NOSTEAL) && S_SvPV_can_swipe_buf(ssv, sflags, cur, len) )
         {	/* Passes the swipe test.  */
             if (SvPVX_const(dsv))	/* we know that dtype >= SVt_PV */
                 SvPV_free(dsv);