vnewSVpvf sv_vcatpvf sv_vsetpvf

sv_catpvf_mg sv_catpvf_mg_nocontext sv_vcatpvf_mg

sv_setpvf_mg sv_setpvf_mg_nocontext sv_vsetpvf_mg

#if { VERSION >= 5.004 } && !defined(vnewSVpvf) #if { NEED vnewSVpvf }

SV * vnewSVpvf(pTHX_ const char *pat, va_list *args) { register SV *sv = newSV(0); sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); return sv; }

#endif #endif

#if { VERSION >= 5.004 } && !defined(sv_vcatpvf) # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) #endif

#if { VERSION >= 5.004 } && !defined(sv_vsetpvf) # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) #endif

#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg) #if { NEED sv_catpvf_mg }

void sv_catpvf_mg(pTHX_ SV *sv, const char *pat, ...) { va_list args; va_start(args, pat); sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); SvSETMAGIC(sv); va_end(args); }

#endif #endif

#ifdef PERL_IMPLICIT_CONTEXT #if { VERSION >= 5.004 } && !defined(sv_catpvf_mg_nocontext) #if { NEED sv_catpvf_mg_nocontext }

void sv_catpvf_mg_nocontext(SV *sv, const char *pat, ...) { dTHX; va_list args; va_start(args, pat); sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); SvSETMAGIC(sv); va_end(args); }

#endif #endif #endif

/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */ #ifndef sv_catpvf_mg # ifdef PERL_IMPLICIT_CONTEXT # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext # else # define sv_catpvf_mg Perl_sv_catpvf_mg # endif #endif

#if { VERSION >= 5.004 } && !defined(sv_vcatpvf_mg) # define sv_vcatpvf_mg(sv, pat, args) \ STMT_START { \ sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ SvSETMAGIC(sv); \ } STMT_END #endif

#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg) #if { NEED sv_setpvf_mg }

void sv_setpvf_mg(pTHX_ SV *sv, const char *pat, ...) { va_list args; va_start(args, pat); sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); SvSETMAGIC(sv); va_end(args); }

#endif #endif

#ifdef PERL_IMPLICIT_CONTEXT #if { VERSION >= 5.004 } && !defined(sv_setpvf_mg_nocontext) #if { NEED sv_setpvf_mg_nocontext }

void sv_setpvf_mg_nocontext(SV *sv, const char *pat, ...) { dTHX; va_list args; va_start(args, pat); sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); SvSETMAGIC(sv); va_end(args); }

#endif #endif #endif

/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */ #ifndef sv_setpvf_mg # ifdef PERL_IMPLICIT_CONTEXT # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext # else # define sv_setpvf_mg Perl_sv_setpvf_mg # endif #endif

#if { VERSION >= 5.004 } && !defined(sv_vsetpvf_mg) # define sv_vsetpvf_mg(sv, pat, args) \ STMT_START { \ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ SvSETMAGIC(sv); \ } STMT_END #endif

#define NEED_vnewSVpvf #define NEED_sv_catpvf_mg #define NEED_sv_catpvf_mg_nocontext #define NEED_sv_setpvf_mg #define NEED_sv_setpvf_mg_nocontext

static SV * test_vnewSVpvf(pTHX_ const char *pat, ...) { SV *sv; va_list args; va_start(args, pat); #if { VERSION >= 5.004 } sv = vnewSVpvf(pat, &args); #else sv = newSVpv((char *) pat, 0); #endif va_end(args); return sv; }

static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...) { va_list args; va_start(args, pat); #if { VERSION >= 5.004 } sv_vcatpvf(sv, pat, &args); #else sv_catpv(sv, (char *) pat); #endif va_end(args); }

static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...) { va_list args; va_start(args, pat); #if { VERSION >= 5.004 } sv_vsetpvf(sv, pat, &args); #else sv_setpv(sv, (char *) pat); #endif va_end(args); }

SV * vnewSVpvf() CODE: RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42); OUTPUT: RETVAL

SV * sv_vcatpvf(sv) SV *sv CODE: RETVAL = newSVsv(sv); test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42); OUTPUT: RETVAL

SV * sv_vsetpvf(sv) SV *sv CODE: RETVAL = newSVsv(sv); test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42); OUTPUT: RETVAL

void sv_catpvf_mg(sv) SV *sv CODE: #if { VERSION >= 5.004 } sv_catpvf_mg(sv, "%s-%d", "Perl", 42); #endif

void Perl_sv_catpvf_mg(sv) SV *sv CODE: #if { VERSION >= 5.004 } Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43); #endif

void sv_catpvf_mg_nocontext(sv) SV *sv CODE: #if { VERSION >= 5.004 } #ifdef PERL_IMPLICIT_CONTEXT sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44); #else sv_catpvf_mg(sv, "%s-%d", "-Perl", 44); #endif #endif

void sv_setpvf_mg(sv) SV *sv CODE: #if { VERSION >= 5.004 } sv_setpvf_mg(sv, "%s-%d", "mhx", 42); #endif

void Perl_sv_setpvf_mg(sv) SV *sv CODE: #if { VERSION >= 5.004 } Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43); #endif

void sv_setpvf_mg_nocontext(sv) SV *sv CODE: #if { VERSION >= 5.004 } #ifdef PERL_IMPLICIT_CONTEXT sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44); #else sv_setpvf_mg(sv, "%s-%d", "bar", 44); #endif #endif

use Tie::Hash; my %h; tie %h, 'Tie::StdHash'; $h{foo} = 'foo-'; $h{bar} = '';

ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d'); ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d'); ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d');

&Devel::PPPort::sv_catpvf_mg($h{foo}); ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-');

&Devel::PPPort::Perl_sv_catpvf_mg($h{foo}); ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');

&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo}); ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');

&Devel::PPPort::sv_setpvf_mg($h{bar}); ok($h{bar}, $] >= 5.004 ? 'mhx-42' : '');

&Devel::PPPort::Perl_sv_setpvf_mg($h{bar}); ok($h{bar}, $] >= 5.004 ? 'foo-43' : '');

&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar}); ok($h{bar}, $] >= 5.004 ? 'bar-44' : '');

cpanm Devel::PPPort

perl -MCPAN -e shell
install Devel::PPPort