Commit | Line | Data |
3e61d65a |
1 | #include "EXTERN.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
4 | |
9b5c3821 |
5 | /* from exception.c */ |
6 | int exception(int); |
0314122a |
7 | |
8 | MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash |
9 | |
028f8eaa |
10 | #define UTF8KLEN(sv, len) (SvUTF8(sv) ? -(I32)len : (I32)len) |
11 | |
0314122a |
12 | bool |
13 | exists(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 |
23 | OUTPUT: |
24 | RETVAL |
25 | |
b60cf05a |
26 | SV * |
27 | delete(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 |
38 | OUTPUT: |
39 | RETVAL |
40 | |
41 | SV * |
858117f8 |
42 | store_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 | |
65 | SV * |
b60cf05a |
66 | store(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 |
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 | |
92 | SV * |
93 | fetch(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 |
104 | if (!result) { |
105 | XSRETURN_EMPTY; |
106 | } |
107 | /* Force mg_get */ |
108 | RETVAL = newSVsv(*result); |
109 | OUTPUT: |
110 | RETVAL |
0314122a |
111 | =pod |
112 | |
113 | sub TIEHASH { bless {}, $_[0] } |
114 | sub STORE { $_[0]->{$_[1]} = $_[2] } |
115 | sub FETCH { $_[0]->{$_[1]} } |
116 | sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} } |
117 | sub NEXTKEY { each %{$_[0]} } |
118 | sub EXISTS { exists $_[0]->{$_[1]} } |
119 | sub DELETE { delete $_[0]->{$_[1]} } |
120 | sub CLEAR { %{$_[0]} = () } |
121 | |
122 | =cut |
123 | |
3e61d65a |
124 | MODULE = XS::APItest PACKAGE = XS::APItest |
125 | |
126 | PROTOTYPES: DISABLE |
127 | |
128 | void |
129 | print_double(val) |
130 | double val |
131 | CODE: |
132 | printf("%5.3f\n",val); |
133 | |
134 | int |
135 | have_long_double() |
136 | CODE: |
137 | #ifdef HAS_LONG_DOUBLE |
138 | RETVAL = 1; |
139 | #else |
140 | RETVAL = 0; |
141 | #endif |
cabb36f0 |
142 | OUTPUT: |
143 | RETVAL |
3e61d65a |
144 | |
145 | void |
146 | print_long_double() |
147 | CODE: |
148 | #ifdef HAS_LONG_DOUBLE |
fc0bf671 |
149 | # if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE) |
3e61d65a |
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 | |
158 | void |
3e61d65a |
159 | print_int(val) |
160 | int val |
161 | CODE: |
162 | printf("%d\n",val); |
163 | |
164 | void |
165 | print_long(val) |
166 | long val |
167 | CODE: |
168 | printf("%ld\n",val); |
169 | |
170 | void |
171 | print_float(val) |
172 | float val |
173 | CODE: |
174 | printf("%5.3f\n",val); |
9d911683 |
175 | |
176 | void |
177 | print_flush() |
178 | CODE: |
179 | fflush(stdout); |
d4b90eee |
180 | |
181 | void |
182 | mpushp() |
183 | PPCODE: |
184 | EXTEND(SP, 3); |
185 | mPUSHp("one", 3); |
186 | mPUSHp("two", 3); |
187 | mPUSHp("three", 5); |
188 | XSRETURN(3); |
189 | |
190 | void |
191 | mpushn() |
192 | PPCODE: |
193 | EXTEND(SP, 3); |
194 | mPUSHn(0.5); |
195 | mPUSHn(-0.25); |
196 | mPUSHn(0.125); |
197 | XSRETURN(3); |
198 | |
199 | void |
200 | mpushi() |
201 | PPCODE: |
202 | EXTEND(SP, 3); |
d75b63cf |
203 | mPUSHi(-1); |
204 | mPUSHi(2); |
205 | mPUSHi(-3); |
d4b90eee |
206 | XSRETURN(3); |
207 | |
208 | void |
209 | mpushu() |
210 | PPCODE: |
211 | EXTEND(SP, 3); |
d75b63cf |
212 | mPUSHu(1); |
213 | mPUSHu(2); |
214 | mPUSHu(3); |
d4b90eee |
215 | XSRETURN(3); |
216 | |
217 | void |
218 | mxpushp() |
219 | PPCODE: |
220 | mXPUSHp("one", 3); |
221 | mXPUSHp("two", 3); |
222 | mXPUSHp("three", 5); |
223 | XSRETURN(3); |
224 | |
225 | void |
226 | mxpushn() |
227 | PPCODE: |
228 | mXPUSHn(0.5); |
229 | mXPUSHn(-0.25); |
230 | mXPUSHn(0.125); |
231 | XSRETURN(3); |
232 | |
233 | void |
234 | mxpushi() |
235 | PPCODE: |
d75b63cf |
236 | mXPUSHi(-1); |
237 | mXPUSHi(2); |
238 | mXPUSHi(-3); |
d4b90eee |
239 | XSRETURN(3); |
240 | |
241 | void |
242 | mxpushu() |
243 | PPCODE: |
d75b63cf |
244 | mXPUSHu(1); |
245 | mXPUSHu(2); |
246 | mXPUSHu(3); |
d4b90eee |
247 | XSRETURN(3); |
d1f347d7 |
248 | |
249 | |
250 | void |
251 | call_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 | |
267 | void |
268 | call_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 | |
284 | void |
285 | call_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 | |
301 | void |
302 | eval_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 | |
314 | SV* |
315 | eval_pv(p, croak_on_error) |
316 | const char* p |
317 | I32 croak_on_error |
d1f347d7 |
318 | PPCODE: |
319 | PUTBACK; |
320 | EXTEND(SP, 1); |
321 | PUSHs(eval_pv(p, croak_on_error)); |
322 | |
323 | void |
324 | require_pv(pv) |
325 | const char* pv |
d1f347d7 |
326 | PPCODE: |
327 | PUTBACK; |
328 | require_pv(pv); |
329 | |
0ca3a874 |
330 | int |
331 | exception(throw_e) |
332 | int throw_e |
333 | OUTPUT: |
334 | RETVAL |
d1f347d7 |
335 | |
ef469b03 |
336 | void |
337 | mycroak(pv) |
338 | const char* pv |
339 | CODE: |
340 | Perl_croak(aTHX_ "%s", pv); |