Merge pull request #232 from pali/sv_2pv

Fix sv_2pv and sv_2pv_flags for Perl < 5.17.2

parts/inc/SvPV

@@ -14,6 +14,7 @@
 __UNDEFINED__
 SvPVbyte
 sv_2pvbyte
+sv_2pv
 sv_2pv_flags
 sv_pvn_force_flags
 
@@ -82,6 +83,26 @@ __UNDEFINED__  SV_SMAGIC                0
 __UNDEFINED__  SV_HAS_TRAILING_NUL      0
 __UNDEFINED__  SV_COW_SHARED_HASH_KEYS  0
 
+#if { VERSION < 5.7.2 }
+#
+/* Fix sv_2pv for Perl < 5.7.2 */
+
+# ifdef sv_2pv
+#  undef sv_2pv
+# endif
+
+# if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+  __UNDEFINED__ sv_2pv(sv, lp) ({ SV *_sv_2pv = (sv); STRLEN *_lp_2pv = (lp); _lp_2pv = _lp_2pv ? : &PL_na; SvPOKp(_sv_2pv) ? ((*(_lp_2pv) = SvCUR(_sv_2pv)), SvPVX(_sv_2pv)) : Perl_sv_2pv(aTHX_ _sv_2pv, (_lp_2pv)); })
+# else
+  __UNDEFINED__ sv_2pv(sv, lp) (SvPOKp(sv) ? ((*((lp) ? (lp) : &PL_na) = SvCUR(sv)), SvPVX(sv)) : Perl_sv_2pv(aTHX_ (sv), (lp)))
+# endif
+
+#endif
+
+#if { VERSION < 5.7.2 }
+
+/* Define sv_2pv_flags for Perl < 5.7.2 which does not have it at all */
+
 #if defined(PERL_USE_GCC_BRACE_GROUPS)
   __UNDEFINED__ sv_2pv_flags(sv, lp, flags) ({ SV *_sv = (sv); const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &PL_na; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_2pv(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_2pv(_sv, _lp); })
   __UNDEFINED__ sv_pvn_force_flags(sv, lp, flags) ({ SV *_sv = (sv); const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &PL_na; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_pvn_force(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_pvn_force(_sv, _lp); })
@@ -90,6 +111,22 @@ __UNDEFINED__  SV_COW_SHARED_HASH_KEYS  0
   __UNDEFINED__ sv_pvn_force_flags(sv, lp, flags) ((PL_Sv = (sv)), (!((flags) & SV_GMAGIC) && SvGMAGICAL(PL_Sv)) ? (SvGMAGICAL_off(PL_Sv), (PL_Xpv = (XPV *)sv_pvn_force(PL_Sv, (lp) ? (lp) : &PL_na)), SvGMAGICAL_on(PL_Sv), (char *)PL_Xpv) : sv_pvn_force(PL_Sv, (lp) ? (lp) : &PL_na))
 #endif
 
+#elif { VERSION < 5.17.2 }
+
+/* Fix sv_2pv_flags for Perl < 5.17.2 */
+
+# ifdef sv_2pv_flags
+#  undef sv_2pv_flags
+# endif
+
+# if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+  __UNDEFINED__ sv_2pv_flags(sv, lp, flags) ({ SV *_sv_2pv = (sv); const I32 _flags_2pv = (flags); STRLEN *_lp_2pv = (lp); _lp_2pv = _lp_2pv ? : &PL_na; ((!(_flags_2pv & SV_GMAGIC) || !SvGMAGICAL(_sv_2pv)) && SvPOKp(_sv_2pv)) ? ((*(_lp_2pv) = SvCUR(_sv_2pv)), SvPVX(_sv_2pv)) : Perl_sv_2pv_flags(aTHX_ _sv_2pv, (_lp_2pv), (_flags_2pv)); })
+# else
+  __UNDEFINED__ sv_2pv_flags(sv, lp, flags) (((!((flags) & SV_GMAGIC) || !SvGMAGICAL(sv)) && SvPOKp(sv)) ? ((*((lp) ? (lp) : &PL_na) = SvCUR(sv)), SvPVX(sv)) : Perl_sv_2pv_flags(aTHX_ (sv), (lp), (flags)))
+# endif
+
+#endif
+
 #if { VERSION < 5.8.8 } || ( { VERSION >= 5.9.0 } && { VERSION < 5.9.3 } )
 # define D_PPP_SVPV_NOLEN_LP_ARG &PL_na
 #else
@@ -433,7 +470,20 @@ SvPVCLEAR(sv)
                 SvPVCLEAR(sv);
 
 
-=tests plan => 50
+SV *
+sv_2pv(sv)
+        SV *sv
+        PREINIT:
+                STRLEN len;
+                const char *str;
+        CODE:
+                str = sv_2pv(sv, &len);
+                RETVAL = newSVpvn(str, len);
+        OUTPUT:
+                RETVAL
+
+
+=tests plan => 53
 
 my $mhx = "mhx";
 
@@ -507,3 +557,7 @@ is($str, "x"x40);
 is($s2, "x"x40);
 ok($before > 41);
 is($after, 41);
+
+is(&Devel::PPPort::sv_2pv(42), "42");
+is(&Devel::PPPort::sv_2pv(0.15), "0.15");
+is(&Devel::PPPort::sv_2pv("string"), "string");