1 ################################################################################
5 ## $Date: 2006/01/14 18:07:59 +0100 $
7 ################################################################################
9 ## Version 3.x, Copyright (C) 2004-2006, 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 /* sv_vcatpvf depends on sv_vcatpvfn */
49 #if { VERSION >= 5.004 } && !defined(sv_vcatpvf)
50 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
53 /* sv_vsetpvf depends on sv_vsetpvfn */
54 #if { VERSION >= 5.004 } && !defined(sv_vsetpvf)
55 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
58 /* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
59 #if { VERSION >= 5.004 } && !defined(sv_catpvf_mg)
60 #if { NEED sv_catpvf_mg }
63 sv_catpvf_mg(pTHX_ SV *sv, const char *pat, ...)
67 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
75 /* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
76 #ifdef PERL_IMPLICIT_CONTEXT
77 #if { VERSION >= 5.004 } && !defined(sv_catpvf_mg_nocontext)
78 #if { NEED sv_catpvf_mg_nocontext }
81 sv_catpvf_mg_nocontext(SV *sv, const char *pat, ...)
86 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
96 # ifdef PERL_IMPLICIT_CONTEXT
97 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
99 # define sv_catpvf_mg Perl_sv_catpvf_mg
103 /* sv_vcatpvf_mg depends on sv_vcatpvfn */
104 #if { VERSION >= 5.004 } && !defined(sv_vcatpvf_mg)
105 # define sv_vcatpvf_mg(sv, pat, args) \
107 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
112 /* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
113 #if { VERSION >= 5.004 } && !defined(sv_setpvf_mg)
114 #if { NEED sv_setpvf_mg }
117 sv_setpvf_mg(pTHX_ SV *sv, const char *pat, ...)
121 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
129 /* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
130 #ifdef PERL_IMPLICIT_CONTEXT
131 #if { VERSION >= 5.004 } && !defined(sv_setpvf_mg_nocontext)
132 #if { NEED sv_setpvf_mg_nocontext }
135 sv_setpvf_mg_nocontext(SV *sv, const char *pat, ...)
140 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
150 # ifdef PERL_IMPLICIT_CONTEXT
151 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
153 # define sv_setpvf_mg Perl_sv_setpvf_mg
157 /* sv_vsetpvf_mg depends on sv_vsetpvfn */
158 #if { VERSION >= 5.004 } && !defined(sv_vsetpvf_mg)
159 # define sv_vsetpvf_mg(sv, pat, args) \
161 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
168 #define NEED_vnewSVpvf
169 #define NEED_sv_catpvf_mg
170 #define NEED_sv_catpvf_mg_nocontext
171 #define NEED_sv_setpvf_mg
172 #define NEED_sv_setpvf_mg_nocontext
176 static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
181 #if { VERSION >= 5.004 }
182 sv = vnewSVpvf(pat, &args);
184 sv = newSVpv(pat, 0);
190 static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
194 #if { VERSION >= 5.004 }
195 sv_vcatpvf(sv, pat, &args);
202 static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
206 #if { VERSION >= 5.004 }
207 sv_vsetpvf(sv, pat, &args);
219 RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
227 RETVAL = newSVsv(sv);
228 test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
236 RETVAL = newSVsv(sv);
237 test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
245 #if { VERSION >= 5.004 }
246 sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
250 Perl_sv_catpvf_mg(sv)
253 #if { VERSION >= 5.004 }
254 Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
258 sv_catpvf_mg_nocontext(sv)
261 #if { VERSION >= 5.004 }
262 #ifdef PERL_IMPLICIT_CONTEXT
263 sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
265 sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
273 #if { VERSION >= 5.004 }
274 sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
278 Perl_sv_setpvf_mg(sv)
281 #if { VERSION >= 5.004 }
282 Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
286 sv_setpvf_mg_nocontext(sv)
289 #if { VERSION >= 5.004 }
290 #ifdef PERL_IMPLICIT_CONTEXT
291 sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
293 sv_setpvf_mg(sv, "%s-%d", "bar", 44);
301 tie %h, 'Tie::StdHash';
305 ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d');
306 ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
307 ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d');
309 &Devel::PPPort::sv_catpvf_mg($h{foo});
310 ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-');
312 &Devel::PPPort::Perl_sv_catpvf_mg($h{foo});
313 ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
315 &Devel::PPPort::sv_catpvf_mg_nocontext($h{foo});
316 ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
318 &Devel::PPPort::sv_setpvf_mg($h{bar});
319 ok($h{bar}, $] >= 5.004 ? 'mhx-42' : '');
321 &Devel::PPPort::Perl_sv_setpvf_mg($h{bar});
322 ok($h{bar}, $] >= 5.004 ? 'foo-43' : '');
324 &Devel::PPPort::sv_setpvf_mg_nocontext($h{bar});
325 ok($h{bar}, $] >= 5.004 ? 'bar-44' : '');