1 ################################################################################
5 ## $Date: 2010/03/07 13:15:46 +0100 $
7 ################################################################################
9 ## Version 3.x, Copyright (C) 2004-2010, Marcus Holland-Moritz.
10 ## Version 2.x, Copyright (C) 2001, Paul Marquess.
11 ## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
13 ## This program is free software; you can redistribute it and/or
14 ## modify it under the same terms as Perl itself.
16 ################################################################################
25 sv_catpvf_mg_nocontext
29 sv_setpvf_mg_nocontext
34 #if { VERSION >= 5.004 } && !defined(vnewSVpvf)
35 #if { NEED vnewSVpvf }
38 vnewSVpvf(pTHX_ const char *pat, va_list *args)
40 register SV *sv = newSV(0);
41 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
48 #if { VERSION >= 5.004 } && !defined(sv_vcatpvf)
49 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
52 #if { VERSION >= 5.004 } && !defined(sv_vsetpvf)
53 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
56 #if { VERSION >= 5.004 } && !defined(sv_catpvf_mg)
57 #if { NEED sv_catpvf_mg }
60 sv_catpvf_mg(pTHX_ SV *sv, const char *pat, ...)
64 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
72 #ifdef PERL_IMPLICIT_CONTEXT
73 #if { VERSION >= 5.004 } && !defined(sv_catpvf_mg_nocontext)
74 #if { NEED sv_catpvf_mg_nocontext }
77 sv_catpvf_mg_nocontext(SV *sv, const char *pat, ...)
82 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
91 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
93 # ifdef PERL_IMPLICIT_CONTEXT
94 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
96 # define sv_catpvf_mg Perl_sv_catpvf_mg
100 #if { VERSION >= 5.004 } && !defined(sv_vcatpvf_mg)
101 # define sv_vcatpvf_mg(sv, pat, args) \
103 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
108 #if { VERSION >= 5.004 } && !defined(sv_setpvf_mg)
109 #if { NEED sv_setpvf_mg }
112 sv_setpvf_mg(pTHX_ SV *sv, const char *pat, ...)
116 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
124 #ifdef PERL_IMPLICIT_CONTEXT
125 #if { VERSION >= 5.004 } && !defined(sv_setpvf_mg_nocontext)
126 #if { NEED sv_setpvf_mg_nocontext }
129 sv_setpvf_mg_nocontext(SV *sv, const char *pat, ...)
134 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
143 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
145 # ifdef PERL_IMPLICIT_CONTEXT
146 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
148 # define sv_setpvf_mg Perl_sv_setpvf_mg
152 #if { VERSION >= 5.004 } && !defined(sv_vsetpvf_mg)
153 # define sv_vsetpvf_mg(sv, pat, args) \
155 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
162 #define NEED_vnewSVpvf
163 #define NEED_sv_catpvf_mg
164 #define NEED_sv_catpvf_mg_nocontext
165 #define NEED_sv_setpvf_mg
166 #define NEED_sv_setpvf_mg_nocontext
170 static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
175 #if { VERSION >= 5.004 }
176 sv = vnewSVpvf(pat, &args);
178 sv = newSVpv((char *) pat, 0);
184 static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
188 #if { VERSION >= 5.004 }
189 sv_vcatpvf(sv, pat, &args);
191 sv_catpv(sv, (char *) pat);
196 static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
200 #if { VERSION >= 5.004 }
201 sv_vsetpvf(sv, pat, &args);
203 sv_setpv(sv, (char *) pat);
213 RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
221 RETVAL = newSVsv(sv);
222 test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
230 RETVAL = newSVsv(sv);
231 test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
239 #if { VERSION >= 5.004 }
240 sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
244 Perl_sv_catpvf_mg(sv)
247 #if { VERSION >= 5.004 }
248 Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
252 sv_catpvf_mg_nocontext(sv)
255 #if { VERSION >= 5.004 }
256 #ifdef PERL_IMPLICIT_CONTEXT
257 sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
259 sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
267 #if { VERSION >= 5.004 }
268 sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
272 Perl_sv_setpvf_mg(sv)
275 #if { VERSION >= 5.004 }
276 Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
280 sv_setpvf_mg_nocontext(sv)
283 #if { VERSION >= 5.004 }
284 #ifdef PERL_IMPLICIT_CONTEXT
285 sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
287 sv_setpvf_mg(sv, "%s-%d", "bar", 44);
295 tie %h, 'Tie::StdHash';
299 ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d');
300 ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
301 ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d');
303 &Devel::PPPort::sv_catpvf_mg($h{foo});
304 ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-');
306 &Devel::PPPort::Perl_sv_catpvf_mg($h{foo});
307 ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
309 &Devel::PPPort::sv_catpvf_mg_nocontext($h{foo});
310 ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
312 &Devel::PPPort::sv_setpvf_mg($h{bar});
313 ok($h{bar}, $] >= 5.004 ? 'mhx-42' : '');
315 &Devel::PPPort::Perl_sv_setpvf_mg($h{bar});
316 ok($h{bar}, $] >= 5.004 ? 'foo-43' : '');
318 &Devel::PPPort::sv_setpvf_mg_nocontext($h{bar});
319 ok($h{bar}, $] >= 5.004 ? 'bar-44' : '');