This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
parts/inc/sv_xpvf: Adjust prototype to match blead
[perl5.git] / dist / Devel-PPPort / parts / inc / sv_xpvf
CommitLineData
96ad942f
MHM
1################################################################################
2##
b2049988 3## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
96ad942f
MHM
4## Version 2.x, Copyright (C) 2001, Paul Marquess.
5## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
6##
7## This program is free software; you can redistribute it and/or
8## modify it under the same terms as Perl itself.
9##
10################################################################################
11
12=provides
13
14vnewSVpvf
15sv_vcatpvf
16sv_vsetpvf
17
18sv_catpvf_mg
19sv_catpvf_mg_nocontext
20sv_vcatpvf_mg
21
22sv_setpvf_mg
23sv_setpvf_mg_nocontext
24sv_vsetpvf_mg
25
26=implementation
27
28#if { VERSION >= 5.004 } && !defined(vnewSVpvf)
e2e74bab
P
29#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
30# define vnewSVpvf(pat, args) ({ SV *_sv = newSV(0); sv_vsetpvfn(_sv, (pat), strlen((pat)), (args), Null(SV**), 0, Null(bool*)); _sv; })
31#else
32# define vnewSVpvf(pat, args) ((PL_Sv = newSV(0)), sv_vsetpvfn(PL_Sv, (pat), strlen((pat)), (args), Null(SV**), 0, Null(bool*)), PL_Sv)
96ad942f
MHM
33#endif
34#endif
35
96ad942f
MHM
36#if { VERSION >= 5.004 } && !defined(sv_vcatpvf)
37# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
38#endif
39
96ad942f
MHM
40#if { VERSION >= 5.004 } && !defined(sv_vsetpvf)
41# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
42#endif
43
96ad942f
MHM
44#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg)
45#if { NEED sv_catpvf_mg }
46
47void
6b273def 48sv_catpvf_mg(pTHX_ SV * const sv, const char * const pat, ...)
96ad942f
MHM
49{
50 va_list args;
51 va_start(args, pat);
52 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
53 SvSETMAGIC(sv);
54 va_end(args);
55}
56
57#endif
58#endif
59
96ad942f
MHM
60#ifdef PERL_IMPLICIT_CONTEXT
61#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg_nocontext)
62#if { NEED sv_catpvf_mg_nocontext }
63
64void
6b273def 65sv_catpvf_mg_nocontext(SV * const sv, const char * const pat, ...)
96ad942f
MHM
66{
67 dTHX;
68 va_list args;
69 va_start(args, pat);
70 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
71 SvSETMAGIC(sv);
72 va_end(args);
73}
74
75#endif
76#endif
77#endif
78
679ad62d 79/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
96ad942f
MHM
80#ifndef sv_catpvf_mg
81# ifdef PERL_IMPLICIT_CONTEXT
82# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
83# else
84# define sv_catpvf_mg Perl_sv_catpvf_mg
85# endif
86#endif
87
96ad942f
MHM
88#if { VERSION >= 5.004 } && !defined(sv_vcatpvf_mg)
89# define sv_vcatpvf_mg(sv, pat, args) \
90 STMT_START { \
91 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
92 SvSETMAGIC(sv); \
93 } STMT_END
94#endif
95
96ad942f
MHM
96#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg)
97#if { NEED sv_setpvf_mg }
98
99void
6b273def 100sv_setpvf_mg(pTHX_ SV * const sv, const char * const pat, ...)
96ad942f
MHM
101{
102 va_list args;
103 va_start(args, pat);
104 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
105 SvSETMAGIC(sv);
106 va_end(args);
107}
108
109#endif
110#endif
111
96ad942f
MHM
112#ifdef PERL_IMPLICIT_CONTEXT
113#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg_nocontext)
114#if { NEED sv_setpvf_mg_nocontext }
115
116void
6b273def 117sv_setpvf_mg_nocontext(SV * const sv, const char * const pat, ...)
96ad942f
MHM
118{
119 dTHX;
120 va_list args;
121 va_start(args, pat);
122 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
123 SvSETMAGIC(sv);
124 va_end(args);
125}
126
127#endif
128#endif
129#endif
130
679ad62d 131/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
96ad942f
MHM
132#ifndef sv_setpvf_mg
133# ifdef PERL_IMPLICIT_CONTEXT
134# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
135# else
136# define sv_setpvf_mg Perl_sv_setpvf_mg
137# endif
138#endif
139
96ad942f
MHM
140#if { VERSION >= 5.004 } && !defined(sv_vsetpvf_mg)
141# define sv_vsetpvf_mg(sv, pat, args) \
142 STMT_START { \
143 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
144 SvSETMAGIC(sv); \
145 } STMT_END
146#endif
147
148=xsinit
149
96ad942f
MHM
150#define NEED_sv_catpvf_mg
151#define NEED_sv_catpvf_mg_nocontext
152#define NEED_sv_setpvf_mg
153#define NEED_sv_setpvf_mg_nocontext
154
155=xsmisc
156
157static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
158{
159 SV *sv;
160 va_list args;
161 va_start(args, pat);
162#if { VERSION >= 5.004 }
163 sv = vnewSVpvf(pat, &args);
164#else
aab9a3b6 165 sv = newSVpv((char *) pat, 0);
96ad942f
MHM
166#endif
167 va_end(args);
168 return sv;
169}
170
171static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
172{
173 va_list args;
174 va_start(args, pat);
175#if { VERSION >= 5.004 }
176 sv_vcatpvf(sv, pat, &args);
177#else
aab9a3b6 178 sv_catpv(sv, (char *) pat);
96ad942f
MHM
179#endif
180 va_end(args);
181}
182
183static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
184{
185 va_list args;
186 va_start(args, pat);
187#if { VERSION >= 5.004 }
188 sv_vsetpvf(sv, pat, &args);
189#else
aab9a3b6 190 sv_setpv(sv, (char *) pat);
96ad942f
MHM
191#endif
192 va_end(args);
193}
194
195=xsubs
196
197SV *
198vnewSVpvf()
b2049988
MHM
199 CODE:
200 RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
201 OUTPUT:
202 RETVAL
96ad942f
MHM
203
204SV *
205sv_vcatpvf(sv)
b2049988
MHM
206 SV *sv
207 CODE:
208 RETVAL = newSVsv(sv);
209 test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
210 OUTPUT:
211 RETVAL
96ad942f
MHM
212
213SV *
214sv_vsetpvf(sv)
b2049988
MHM
215 SV *sv
216 CODE:
217 RETVAL = newSVsv(sv);
218 test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
219 OUTPUT:
220 RETVAL
96ad942f
MHM
221
222void
223sv_catpvf_mg(sv)
b2049988
MHM
224 SV *sv
225 CODE:
96ad942f 226#if { VERSION >= 5.004 }
b2049988 227 sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
96ad942f
MHM
228#endif
229
230void
231Perl_sv_catpvf_mg(sv)
b2049988
MHM
232 SV *sv
233 CODE:
96ad942f 234#if { VERSION >= 5.004 }
b2049988 235 Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
96ad942f
MHM
236#endif
237
238void
239sv_catpvf_mg_nocontext(sv)
b2049988
MHM
240 SV *sv
241 CODE:
96ad942f
MHM
242#if { VERSION >= 5.004 }
243#ifdef PERL_IMPLICIT_CONTEXT
b2049988 244 sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
96ad942f 245#else
b2049988 246 sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
96ad942f
MHM
247#endif
248#endif
249
250void
251sv_setpvf_mg(sv)
b2049988
MHM
252 SV *sv
253 CODE:
96ad942f 254#if { VERSION >= 5.004 }
b2049988 255 sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
96ad942f
MHM
256#endif
257
258void
259Perl_sv_setpvf_mg(sv)
b2049988
MHM
260 SV *sv
261 CODE:
96ad942f 262#if { VERSION >= 5.004 }
b2049988 263 Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
96ad942f
MHM
264#endif
265
266void
267sv_setpvf_mg_nocontext(sv)
b2049988
MHM
268 SV *sv
269 CODE:
96ad942f
MHM
270#if { VERSION >= 5.004 }
271#ifdef PERL_IMPLICIT_CONTEXT
b2049988 272 sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
96ad942f 273#else
b2049988 274 sv_setpvf_mg(sv, "%s-%d", "bar", 44);
96ad942f
MHM
275#endif
276#endif
277
278=tests plan => 9
279
280use Tie::Hash;
281my %h;
282tie %h, 'Tie::StdHash';
283$h{foo} = 'foo-';
284$h{bar} = '';
285
f551177d
S
286ok(&Devel::PPPort::vnewSVpvf(), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
287ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), "$]" >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
288ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
96ad942f
MHM
289
290&Devel::PPPort::sv_catpvf_mg($h{foo});
f551177d 291ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42' : 'foo-');
96ad942f
MHM
292
293&Devel::PPPort::Perl_sv_catpvf_mg($h{foo});
f551177d 294ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
96ad942f
MHM
295
296&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo});
f551177d 297ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
96ad942f
MHM
298
299&Devel::PPPort::sv_setpvf_mg($h{bar});
f551177d 300ok($h{bar}, "$]" >= 5.004 ? 'mhx-42' : '');
96ad942f
MHM
301
302&Devel::PPPort::Perl_sv_setpvf_mg($h{bar});
f551177d 303ok($h{bar}, "$]" >= 5.004 ? 'foo-43' : '');
96ad942f
MHM
304
305&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar});
f551177d 306ok($h{bar}, "$]" >= 5.004 ? 'bar-44' : '');