diff --git a/parts/inc/SvPV b/parts/inc/SvPV index 1d54c0f8..08239136 100644 --- a/parts/inc/SvPV +++ b/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");