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