This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove unreferenced local variable (and the warning about it)
[perl5.git] / ext / XS / APItest / APItest.xs
CommitLineData
3e61d65a
JH
1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4
9b5c3821
MHM
5/* from exception.c */
6int exception(int);
0314122a
NC
7
8MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
9
028f8eaa
MHM
10#define UTF8KLEN(sv, len) (SvUTF8(sv) ? -(I32)len : (I32)len)
11
0314122a
NC
12bool
13exists(hash, key_sv)
14 PREINIT:
15 STRLEN len;
16 const char *key;
17 INPUT:
18 HV *hash
19 SV *key_sv
20 CODE:
21 key = SvPV(key_sv, len);
028f8eaa 22 RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
0314122a
NC
23 OUTPUT:
24 RETVAL
25
b60cf05a
NC
26SV *
27delete(hash, key_sv)
28 PREINIT:
29 STRLEN len;
30 const char *key;
31 INPUT:
32 HV *hash
33 SV *key_sv
34 CODE:
35 key = SvPV(key_sv, len);
36 /* It's already mortal, so need to increase reference count. */
028f8eaa 37 RETVAL = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), 0));
b60cf05a
NC
38 OUTPUT:
39 RETVAL
40
41SV *
858117f8
NC
42store_ent(hash, key, value)
43 PREINIT:
44 SV *copy;
45 HE *result;
46 INPUT:
47 HV *hash
48 SV *key
49 SV *value
50 CODE:
51 copy = newSV(0);
52 result = hv_store_ent(hash, key, copy, 0);
53 SvSetMagicSV(copy, value);
54 if (!result) {
55 SvREFCNT_dec(copy);
56 XSRETURN_EMPTY;
57 }
58 /* It's about to become mortal, so need to increase reference count.
59 */
60 RETVAL = SvREFCNT_inc(HeVAL(result));
61 OUTPUT:
62 RETVAL
63
64
65SV *
b60cf05a
NC
66store(hash, key_sv, value)
67 PREINIT:
68 STRLEN len;
69 const char *key;
70 SV *copy;
71 SV **result;
72 INPUT:
73 HV *hash
74 SV *key_sv
75 SV *value
76 CODE:
77 key = SvPV(key_sv, len);
78 copy = newSV(0);
028f8eaa 79 result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
858117f8 80 SvSetMagicSV(copy, value);
b60cf05a
NC
81 if (!result) {
82 SvREFCNT_dec(copy);
83 XSRETURN_EMPTY;
84 }
85 /* It's about to become mortal, so need to increase reference count.
86 */
87 RETVAL = SvREFCNT_inc(*result);
88 OUTPUT:
89 RETVAL
90
91
92SV *
93fetch(hash, key_sv)
94 PREINIT:
95 STRLEN len;
96 const char *key;
97 SV **result;
98 INPUT:
99 HV *hash
100 SV *key_sv
101 CODE:
102 key = SvPV(key_sv, len);
028f8eaa 103 result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
b60cf05a
NC
104 if (!result) {
105 XSRETURN_EMPTY;
106 }
107 /* Force mg_get */
108 RETVAL = newSVsv(*result);
109 OUTPUT:
110 RETVAL
0314122a
NC
111=pod
112
113sub TIEHASH { bless {}, $_[0] }
114sub STORE { $_[0]->{$_[1]} = $_[2] }
115sub FETCH { $_[0]->{$_[1]} }
116sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
117sub NEXTKEY { each %{$_[0]} }
118sub EXISTS { exists $_[0]->{$_[1]} }
119sub DELETE { delete $_[0]->{$_[1]} }
120sub CLEAR { %{$_[0]} = () }
121
122=cut
123
3e61d65a
JH
124MODULE = XS::APItest PACKAGE = XS::APItest
125
126PROTOTYPES: DISABLE
127
128void
129print_double(val)
130 double val
131 CODE:
132 printf("%5.3f\n",val);
133
134int
135have_long_double()
136 CODE:
137#ifdef HAS_LONG_DOUBLE
138 RETVAL = 1;
139#else
140 RETVAL = 0;
141#endif
cabb36f0
CN
142 OUTPUT:
143 RETVAL
3e61d65a
JH
144
145void
146print_long_double()
147 CODE:
148#ifdef HAS_LONG_DOUBLE
fc0bf671 149# if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
3e61d65a
JH
150 long double val = 7.0;
151 printf("%5.3" PERL_PRIfldbl "\n",val);
152# else
153 double val = 7.0;
154 printf("%5.3f\n",val);
155# endif
156#endif
157
158void
3e61d65a
JH
159print_int(val)
160 int val
161 CODE:
162 printf("%d\n",val);
163
164void
165print_long(val)
166 long val
167 CODE:
168 printf("%ld\n",val);
169
170void
171print_float(val)
172 float val
173 CODE:
174 printf("%5.3f\n",val);
9d911683
NIS
175
176void
177print_flush()
178 CODE:
179 fflush(stdout);
d4b90eee
SH
180
181void
182mpushp()
183 PPCODE:
184 EXTEND(SP, 3);
185 mPUSHp("one", 3);
186 mPUSHp("two", 3);
187 mPUSHp("three", 5);
188 XSRETURN(3);
189
190void
191mpushn()
192 PPCODE:
193 EXTEND(SP, 3);
194 mPUSHn(0.5);
195 mPUSHn(-0.25);
196 mPUSHn(0.125);
197 XSRETURN(3);
198
199void
200mpushi()
201 PPCODE:
202 EXTEND(SP, 3);
d75b63cf
MHM
203 mPUSHi(-1);
204 mPUSHi(2);
205 mPUSHi(-3);
d4b90eee
SH
206 XSRETURN(3);
207
208void
209mpushu()
210 PPCODE:
211 EXTEND(SP, 3);
d75b63cf
MHM
212 mPUSHu(1);
213 mPUSHu(2);
214 mPUSHu(3);
d4b90eee
SH
215 XSRETURN(3);
216
217void
218mxpushp()
219 PPCODE:
220 mXPUSHp("one", 3);
221 mXPUSHp("two", 3);
222 mXPUSHp("three", 5);
223 XSRETURN(3);
224
225void
226mxpushn()
227 PPCODE:
228 mXPUSHn(0.5);
229 mXPUSHn(-0.25);
230 mXPUSHn(0.125);
231 XSRETURN(3);
232
233void
234mxpushi()
235 PPCODE:
d75b63cf
MHM
236 mXPUSHi(-1);
237 mXPUSHi(2);
238 mXPUSHi(-3);
d4b90eee
SH
239 XSRETURN(3);
240
241void
242mxpushu()
243 PPCODE:
d75b63cf
MHM
244 mXPUSHu(1);
245 mXPUSHu(2);
246 mXPUSHu(3);
d4b90eee 247 XSRETURN(3);
d1f347d7
DM
248
249
250void
251call_sv(sv, flags, ...)
252 SV* sv
253 I32 flags
254 PREINIT:
255 I32 i;
256 PPCODE:
257 for (i=0; i<items-2; i++)
258 ST(i) = ST(i+2); /* pop first two args */
259 PUSHMARK(SP);
260 SP += items - 2;
261 PUTBACK;
262 i = call_sv(sv, flags);
263 SPAGAIN;
264 EXTEND(SP, 1);
265 PUSHs(sv_2mortal(newSViv(i)));
266
267void
268call_pv(subname, flags, ...)
269 char* subname
270 I32 flags
271 PREINIT:
272 I32 i;
273 PPCODE:
274 for (i=0; i<items-2; i++)
275 ST(i) = ST(i+2); /* pop first two args */
276 PUSHMARK(SP);
277 SP += items - 2;
278 PUTBACK;
279 i = call_pv(subname, flags);
280 SPAGAIN;
281 EXTEND(SP, 1);
282 PUSHs(sv_2mortal(newSViv(i)));
283
284void
285call_method(methname, flags, ...)
286 char* methname
287 I32 flags
288 PREINIT:
289 I32 i;
290 PPCODE:
291 for (i=0; i<items-2; i++)
292 ST(i) = ST(i+2); /* pop first two args */
293 PUSHMARK(SP);
294 SP += items - 2;
295 PUTBACK;
296 i = call_method(methname, flags);
297 SPAGAIN;
298 EXTEND(SP, 1);
299 PUSHs(sv_2mortal(newSViv(i)));
300
301void
302eval_sv(sv, flags)
303 SV* sv
304 I32 flags
305 PREINIT:
306 I32 i;
307 PPCODE:
308 PUTBACK;
309 i = eval_sv(sv, flags);
310 SPAGAIN;
311 EXTEND(SP, 1);
312 PUSHs(sv_2mortal(newSViv(i)));
313
b8e65a9b 314void
d1f347d7
DM
315eval_pv(p, croak_on_error)
316 const char* p
317 I32 croak_on_error
d1f347d7
DM
318 PPCODE:
319 PUTBACK;
320 EXTEND(SP, 1);
321 PUSHs(eval_pv(p, croak_on_error));
322
323void
324require_pv(pv)
325 const char* pv
d1f347d7
DM
326 PPCODE:
327 PUTBACK;
328 require_pv(pv);
329
0ca3a874
MHM
330int
331exception(throw_e)
332 int throw_e
333 OUTPUT:
334 RETVAL
d1f347d7 335
ef469b03
DM
336void
337mycroak(pv)
338 const char* pv
339 CODE:
340 Perl_croak(aTHX_ "%s", pv);
5d2b1485
NC
341
342SV*
343strtab()
344 CODE:
345 RETVAL = newRV_inc((SV*)PL_strtab);
346 OUTPUT:
347 RETVAL