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