Commit | Line | Data |
---|---|---|
ea035a69 JH |
1 | /* |
2 | XS code to test the typemap entries | |
3 | ||
4 | Copyright (C) 2001 Tim Jenness. | |
5 | All Rights Reserved | |
6 | ||
7 | */ | |
8 | ||
3c53ff3f NC |
9 | #define PERL_NO_GET_CONTEXT |
10 | ||
ea035a69 JH |
11 | #include "EXTERN.h" /* std perl include */ |
12 | #include "perl.h" /* std perl include */ | |
13 | #include "XSUB.h" /* XSUB include */ | |
14 | ||
15 | /* Prototypes for external functions */ | |
16 | FILE * xsfopen( const char * ); | |
17 | int xsfclose( FILE * ); | |
18 | int xsfprintf( FILE *, const char *); | |
19 | ||
20 | /* Type definitions required for the XS typemaps */ | |
21 | typedef SV * SVREF; /* T_SVREF */ | |
22 | typedef int SysRet; /* T_SYSRET */ | |
23 | typedef int Int; /* T_INT */ | |
24 | typedef int intRef; /* T_PTRREF */ | |
25 | typedef int intObj; /* T_PTROBJ */ | |
26 | typedef int intRefIv; /* T_REF_IV_PTR */ | |
27 | typedef int intArray; /* T_ARRAY */ | |
604db645 S |
28 | typedef int intTINT; /* T_INT */ |
29 | typedef int intTLONG; /* T_LONG */ | |
ea035a69 JH |
30 | typedef short shortOPQ; /* T_OPAQUE */ |
31 | typedef int intOpq; /* T_OPAQUEPTR */ | |
604db645 | 32 | typedef unsigned intUnsigned; /* T_U_INT */ |
08d5d1db CB |
33 | typedef PerlIO * inputfh; /* T_IN */ |
34 | typedef PerlIO * outputfh; /* T_OUT */ | |
ea035a69 | 35 | |
2465d83f | 36 | /* A structure to test T_OPAQUEPTR and T_PACKED */ |
5abff6f9 TJ |
37 | struct t_opaqueptr { |
38 | int a; | |
39 | int b; | |
40 | double c; | |
41 | }; | |
42 | ||
43 | typedef struct t_opaqueptr astruct; | |
2465d83f | 44 | typedef struct t_opaqueptr anotherstruct; |
5abff6f9 | 45 | |
ea035a69 | 46 | /* Some static memory for the tests */ |
052980ee TJ |
47 | static I32 xst_anint; |
48 | static intRef xst_anintref; | |
49 | static intObj xst_anintobj; | |
50 | static intRefIv xst_anintrefiv; | |
51 | static intOpq xst_anintopq; | |
ea035a69 | 52 | |
b64f48ff | 53 | /* A different type to refer to for testing the different |
1d2615b4 | 54 | * AV*, HV*, etc typemaps */ |
b64f48ff S |
55 | typedef AV AV_FIXED; |
56 | typedef HV HV_FIXED; | |
1d2615b4 S |
57 | typedef CV CV_FIXED; |
58 | typedef SVREF SVREF_FIXED; | |
b64f48ff | 59 | |
ea035a69 JH |
60 | /* Helper functions */ |
61 | ||
62 | /* T_ARRAY - allocate some memory */ | |
63 | intArray * intArrayPtr( int nelem ) { | |
64 | intArray * array; | |
a02a5408 | 65 | Newx(array, nelem, intArray); |
ea035a69 JH |
66 | return array; |
67 | } | |
68 | ||
2465d83f | 69 | /* test T_PACKED */ |
62e90759 S |
70 | STATIC void |
71 | XS_pack_anotherstructPtr(SV *out, anotherstruct *in) | |
72 | { | |
73 | dTHX; | |
74 | HV *hash = newHV(); | |
75 | if (NULL == hv_stores(hash, "a", newSViv(in->a))) | |
76 | croak("Failed to store data in hash"); | |
77 | if (NULL == hv_stores(hash, "b", newSViv(in->b))) | |
78 | croak("Failed to store data in hash"); | |
79 | if (NULL == hv_stores(hash, "c", newSVnv(in->c))) | |
80 | croak("Failed to store data in hash"); | |
81 | sv_setsv(out, sv_2mortal(newRV_noinc((SV*)hash))); | |
82 | } | |
2465d83f | 83 | |
ea0d3d8e | 84 | STATIC anotherstruct * |
2465d83f S |
85 | XS_unpack_anotherstructPtr(SV *in) |
86 | { | |
87 | dTHX; /* rats, this is expensive */ | |
88 | /* this is similar to T_HVREF since we chose to use a hash */ | |
89 | HV *inhash; | |
90 | SV **elem; | |
91 | anotherstruct *out; | |
92 | SV *const tmp = in; | |
93 | SvGETMAGIC(tmp); | |
94 | if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVHV) | |
95 | inhash = (HV*)SvRV(tmp); | |
96 | else | |
97 | Perl_croak(aTHX_ "Argument is not a HASH reference"); | |
98 | ||
99 | /* FIXME dunno if supposed to use perl mallocs here */ | |
100 | Newxz(out, 1, anotherstruct); | |
101 | ||
102 | elem = hv_fetchs(inhash, "a", 0); | |
103 | if (elem == NULL) | |
104 | Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL"); | |
105 | out->a = SvIV(*elem); | |
106 | ||
107 | elem = hv_fetchs(inhash, "b", 0); | |
108 | if (elem == NULL) | |
109 | Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL"); | |
110 | out->b = SvIV(*elem); | |
111 | ||
112 | elem = hv_fetchs(inhash, "c", 0); | |
113 | if (elem == NULL) | |
114 | Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL"); | |
115 | out->c = SvNV(*elem); | |
116 | ||
117 | return out; | |
118 | } | |
119 | ||
ea0d3d8e | 120 | /* test T_PACKEDARRAY */ |
62e90759 S |
121 | STATIC void |
122 | XS_pack_anotherstructPtrPtr(SV *out, anotherstruct **in, UV cnt) | |
123 | { | |
124 | dTHX; | |
125 | UV i; | |
126 | AV *ary = newAV(); | |
127 | for (i = 0; i < cnt; ++i) { | |
128 | HV *hash = newHV(); | |
129 | if (NULL == hv_stores(hash, "a", newSViv(in[i]->a))) | |
130 | croak("Failed to store data in hash"); | |
131 | if (NULL == hv_stores(hash, "b", newSViv(in[i]->b))) | |
132 | croak("Failed to store data in hash"); | |
133 | if (NULL == hv_stores(hash, "c", newSVnv(in[i]->c))) | |
134 | croak("Failed to store data in hash"); | |
135 | av_push(ary, newRV_noinc((SV*)hash)); | |
136 | } | |
137 | sv_setsv(out, sv_2mortal(newRV_noinc((SV*)ary))); | |
138 | } | |
ea0d3d8e S |
139 | |
140 | STATIC anotherstruct ** | |
141 | XS_unpack_anotherstructPtrPtr(SV *in) | |
142 | { | |
143 | dTHX; /* rats, this is expensive */ | |
144 | /* this is similar to T_HVREF since we chose to use a hash */ | |
145 | HV *inhash; | |
146 | AV *inary; | |
147 | SV **elem; | |
148 | anotherstruct **out; | |
149 | UV nitems, i; | |
150 | SV *tmp; | |
151 | ||
152 | /* safely deref the input array ref */ | |
153 | tmp = in; | |
154 | SvGETMAGIC(tmp); | |
155 | if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVAV) | |
d28d0f86 | 156 | inary = (AV*)SvRV(tmp); |
ea0d3d8e S |
157 | else |
158 | Perl_croak(aTHX_ "Argument is not an ARRAY reference"); | |
159 | ||
160 | nitems = av_len(inary) + 1; | |
161 | ||
162 | /* FIXME dunno if supposed to use perl mallocs here */ | |
163 | /* N+1 elements so we know the last one is NULL */ | |
164 | Newxz(out, nitems+1, anotherstruct*); | |
165 | ||
166 | /* WARNING: in real code, we'd have to Safefree() on exception, but | |
167 | * since we're testing perl, if we croak() here, stuff is | |
168 | * rotten anyway! */ | |
169 | for (i = 0; i < nitems; ++i) { | |
d28d0f86 S |
170 | Newxz(out[i], 1, anotherstruct); |
171 | elem = av_fetch(inary, i, 0); | |
172 | if (elem == NULL) | |
173 | Perl_croak(aTHX_ "Shouldn't happen: av_fetch returns NULL"); | |
174 | tmp = *elem; | |
175 | SvGETMAGIC(tmp); | |
176 | if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVHV) | |
177 | inhash = (HV*)SvRV(tmp); | |
178 | else | |
7acd0eed | 179 | Perl_croak(aTHX_ "Array element %"UVuf" is not a HASH reference", i); |
d28d0f86 S |
180 | |
181 | elem = hv_fetchs(inhash, "a", 0); | |
182 | if (elem == NULL) | |
183 | Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL"); | |
184 | out[i]->a = SvIV(*elem); | |
185 | ||
186 | elem = hv_fetchs(inhash, "b", 0); | |
187 | if (elem == NULL) | |
188 | Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL"); | |
189 | out[i]->b = SvIV(*elem); | |
190 | ||
191 | elem = hv_fetchs(inhash, "c", 0); | |
192 | if (elem == NULL) | |
193 | Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL"); | |
194 | out[i]->c = SvNV(*elem); | |
ea0d3d8e S |
195 | } |
196 | ||
197 | return out; | |
198 | } | |
199 | ||
200 | /* no special meaning as far as typemaps are concerned, | |
201 | * just for convenience */ | |
202 | void | |
203 | XS_release_anotherstructPtrPtr(anotherstruct **in) | |
204 | { | |
d28d0f86 S |
205 | unsigned int i = 0; |
206 | while (in[i] != NULL) | |
207 | Safefree(in[i++]); | |
208 | Safefree(in); | |
ea0d3d8e S |
209 | } |
210 | ||
ea035a69 JH |
211 | |
212 | MODULE = XS::Typemap PACKAGE = XS::Typemap | |
213 | ||
214 | PROTOTYPES: DISABLE | |
215 | ||
09186e9e S |
216 | TYPEMAP: <<END_OF_TYPEMAP |
217 | ||
218 | # Typemap file for typemap testing | |
219 | # includes bonus typemap entries | |
220 | # Mainly so that all the standard typemaps can be exercised even when | |
221 | # there is not a corresponding type explicitly identified in the standard | |
222 | # typemap | |
223 | ||
ea0d3d8e S |
224 | svtype T_ENUM |
225 | intRef * T_PTRREF | |
226 | intRef T_IV | |
227 | intObj * T_PTROBJ | |
228 | intObj T_IV | |
229 | intRefIv * T_REF_IV_PTR | |
230 | intRefIv T_IV | |
231 | intArray * T_ARRAY | |
232 | intOpq T_IV | |
233 | intOpq * T_OPAQUEPTR | |
234 | intUnsigned T_U_INT | |
235 | intTINT T_INT | |
236 | intTLONG T_LONG | |
237 | shortOPQ T_OPAQUE | |
238 | shortOPQ * T_OPAQUEPTR | |
239 | astruct * T_OPAQUEPTR | |
240 | anotherstruct * T_PACKED | |
241 | anotherstruct ** T_PACKEDARRAY | |
242 | AV_FIXED * T_AVREF_REFCOUNT_FIXED | |
243 | HV_FIXED * T_HVREF_REFCOUNT_FIXED | |
244 | CV_FIXED * T_CVREF_REFCOUNT_FIXED | |
245 | SVREF_FIXED T_SVREF_REFCOUNT_FIXED | |
60a929b5 CB |
246 | inputfh T_IN |
247 | outputfh T_OUT | |
09186e9e S |
248 | |
249 | END_OF_TYPEMAP | |
250 | ||
ea035a69 | 251 | |
0eb29def | 252 | ## T_SV |
ea035a69 JH |
253 | |
254 | SV * | |
255 | T_SV( sv ) | |
256 | SV * sv | |
257 | CODE: | |
258 | /* create a new sv for return that is a copy of the input | |
259 | do not simply copy the pointer since the SV will be marked | |
260 | mortal by the INPUT typemap when it is pushed back onto the stack */ | |
261 | RETVAL = sv_mortalcopy( sv ); | |
262 | /* increment the refcount since the default INPUT typemap mortalizes | |
263 | by default and we don't want to decrement the ref count twice | |
264 | by mistake */ | |
265 | SvREFCNT_inc(RETVAL); | |
266 | OUTPUT: | |
267 | RETVAL | |
268 | ||
1d2615b4 | 269 | |
0eb29def | 270 | ## T_SVREF |
ea035a69 JH |
271 | |
272 | SVREF | |
273 | T_SVREF( svref ) | |
274 | SVREF svref | |
275 | CODE: | |
276 | RETVAL = svref; | |
277 | OUTPUT: | |
278 | RETVAL | |
279 | ||
1d2615b4 | 280 | |
0eb29def | 281 | ## T_SVREF_FIXED |
1d2615b4 S |
282 | |
283 | SVREF_FIXED | |
284 | T_SVREF_REFCOUNT_FIXED( svref ) | |
285 | SVREF_FIXED svref | |
286 | CODE: | |
287 | SvREFCNT_inc(svref); | |
288 | RETVAL = svref; | |
289 | OUTPUT: | |
290 | RETVAL | |
291 | ||
b64f48ff | 292 | |
0eb29def | 293 | ## T_AVREF |
ea035a69 JH |
294 | |
295 | AV * | |
296 | T_AVREF( av ) | |
297 | AV * av | |
298 | CODE: | |
299 | RETVAL = av; | |
300 | OUTPUT: | |
301 | RETVAL | |
302 | ||
b64f48ff | 303 | |
0eb29def | 304 | ## T_AVREF_REFCOUNT_FIXED |
b64f48ff S |
305 | |
306 | AV_FIXED* | |
307 | T_AVREF_REFCOUNT_FIXED( av ) | |
308 | AV_FIXED * av | |
309 | CODE: | |
310 | SvREFCNT_inc(av); | |
311 | RETVAL = av; | |
312 | OUTPUT: | |
313 | RETVAL | |
314 | ||
b64f48ff | 315 | |
0eb29def | 316 | ## T_HVREF |
ea035a69 JH |
317 | |
318 | HV * | |
319 | T_HVREF( hv ) | |
320 | HV * hv | |
321 | CODE: | |
322 | RETVAL = hv; | |
323 | OUTPUT: | |
324 | RETVAL | |
325 | ||
b64f48ff | 326 | |
0eb29def | 327 | ## T_HVREF_REFCOUNT_FIXED |
b64f48ff S |
328 | |
329 | HV_FIXED* | |
330 | T_HVREF_REFCOUNT_FIXED( hv ) | |
331 | HV_FIXED * hv | |
332 | CODE: | |
333 | SvREFCNT_inc(hv); | |
334 | RETVAL = hv; | |
335 | OUTPUT: | |
336 | RETVAL | |
337 | ||
338 | ||
0eb29def | 339 | ## T_CVREF |
ea035a69 JH |
340 | |
341 | CV * | |
342 | T_CVREF( cv ) | |
343 | CV * cv | |
344 | CODE: | |
345 | RETVAL = cv; | |
346 | OUTPUT: | |
347 | RETVAL | |
348 | ||
1d2615b4 | 349 | |
0eb29def | 350 | ## T_CVREF_REFCOUNT_FIXED |
1d2615b4 S |
351 | |
352 | CV_FIXED * | |
353 | T_CVREF_REFCOUNT_FIXED( cv ) | |
354 | CV_FIXED * cv | |
355 | CODE: | |
356 | SvREFCNT_inc(cv); | |
357 | RETVAL = cv; | |
358 | OUTPUT: | |
359 | RETVAL | |
ea035a69 | 360 | |
ea035a69 | 361 | |
0eb29def | 362 | ## T_SYSRET |
ea035a69 JH |
363 | |
364 | # Test a successful return | |
365 | ||
366 | SysRet | |
367 | T_SYSRET_pass() | |
368 | CODE: | |
369 | RETVAL = 0; | |
370 | OUTPUT: | |
371 | RETVAL | |
372 | ||
373 | # Test failure | |
374 | ||
375 | SysRet | |
376 | T_SYSRET_fail() | |
377 | CODE: | |
378 | RETVAL = -1; | |
379 | OUTPUT: | |
380 | RETVAL | |
381 | ||
0eb29def | 382 | ## T_UV |
ea035a69 JH |
383 | |
384 | unsigned int | |
385 | T_UV( uv ) | |
386 | unsigned int uv | |
387 | CODE: | |
388 | RETVAL = uv; | |
389 | OUTPUT: | |
390 | RETVAL | |
391 | ||
ea035a69 | 392 | |
0eb29def | 393 | ## T_IV |
ea035a69 JH |
394 | |
395 | long | |
396 | T_IV( iv ) | |
397 | long iv | |
398 | CODE: | |
399 | RETVAL = iv; | |
400 | OUTPUT: | |
401 | RETVAL | |
402 | ||
ea035a69 | 403 | |
0eb29def | 404 | ## T_INT |
604db645 S |
405 | |
406 | intTINT | |
407 | T_INT( i ) | |
408 | intTINT i | |
409 | CODE: | |
410 | RETVAL = i; | |
411 | OUTPUT: | |
412 | RETVAL | |
413 | ||
ea035a69 | 414 | |
0eb29def | 415 | ## T_ENUM |
ea035a69 JH |
416 | |
417 | # The test should return the value for SVt_PVHV. | |
418 | # 11 at the present time but we can't not rely on this | |
419 | # for testing purposes. | |
420 | ||
421 | svtype | |
422 | T_ENUM() | |
423 | CODE: | |
424 | RETVAL = SVt_PVHV; | |
425 | OUTPUT: | |
426 | RETVAL | |
427 | ||
ea035a69 | 428 | |
0eb29def | 429 | ## T_BOOL |
ea035a69 JH |
430 | |
431 | bool | |
432 | T_BOOL( in ) | |
433 | bool in | |
434 | CODE: | |
435 | RETVAL = in; | |
436 | OUTPUT: | |
437 | RETVAL | |
438 | ||
742aa4c0 S |
439 | bool |
440 | T_BOOL_2( in ) | |
441 | bool in | |
442 | CODE: | |
443 | OUTPUT: | |
444 | in | |
445 | ||
b0bbf760 DD |
446 | void |
447 | T_BOOL_OUT( out, in ) | |
448 | bool out | |
449 | bool in | |
450 | CODE: | |
451 | out = in; | |
452 | OUTPUT: | |
453 | out | |
ea035a69 | 454 | |
0eb29def | 455 | ## T_U_INT |
604db645 S |
456 | |
457 | intUnsigned | |
458 | T_U_INT( uint ) | |
459 | intUnsigned uint | |
460 | CODE: | |
461 | RETVAL = uint; | |
462 | OUTPUT: | |
463 | RETVAL | |
464 | ||
ea035a69 | 465 | |
0eb29def | 466 | ## T_SHORT |
604db645 S |
467 | |
468 | short | |
469 | T_SHORT( s ) | |
470 | short s | |
471 | CODE: | |
472 | RETVAL = s; | |
473 | OUTPUT: | |
474 | RETVAL | |
475 | ||
ea035a69 | 476 | |
0eb29def | 477 | ## T_U_SHORT |
ea035a69 JH |
478 | |
479 | U16 | |
480 | T_U_SHORT( in ) | |
481 | U16 in | |
482 | CODE: | |
483 | RETVAL = in; | |
484 | OUTPUT: | |
485 | RETVAL | |
486 | ||
487 | ||
0eb29def | 488 | ## T_LONG |
604db645 S |
489 | |
490 | intTLONG | |
491 | T_LONG( in ) | |
492 | intTLONG in | |
493 | CODE: | |
494 | RETVAL = in; | |
495 | OUTPUT: | |
496 | RETVAL | |
497 | ||
0eb29def | 498 | ## T_U_LONG |
ea035a69 JH |
499 | |
500 | U32 | |
501 | T_U_LONG( in ) | |
502 | U32 in | |
503 | CODE: | |
504 | RETVAL = in; | |
505 | OUTPUT: | |
506 | RETVAL | |
507 | ||
ea035a69 | 508 | |
0eb29def | 509 | ## T_CHAR |
ea035a69 JH |
510 | |
511 | char | |
512 | T_CHAR( in ); | |
513 | char in | |
514 | CODE: | |
515 | RETVAL = in; | |
516 | OUTPUT: | |
517 | RETVAL | |
518 | ||
519 | ||
0eb29def | 520 | ## T_U_CHAR |
ea035a69 JH |
521 | |
522 | unsigned char | |
523 | T_U_CHAR( in ); | |
524 | unsigned char in | |
525 | CODE: | |
526 | RETVAL = in; | |
527 | OUTPUT: | |
528 | RETVAL | |
529 | ||
530 | ||
0eb29def | 531 | ## T_FLOAT |
ea035a69 JH |
532 | |
533 | float | |
534 | T_FLOAT( in ) | |
535 | float in | |
536 | CODE: | |
537 | RETVAL = in; | |
538 | OUTPUT: | |
539 | RETVAL | |
540 | ||
ea035a69 | 541 | |
0eb29def | 542 | ## T_NV |
ea035a69 JH |
543 | |
544 | NV | |
545 | T_NV( in ) | |
546 | NV in | |
547 | CODE: | |
548 | RETVAL = in; | |
549 | OUTPUT: | |
550 | RETVAL | |
551 | ||
ea035a69 | 552 | |
0eb29def | 553 | ## T_DOUBLE |
ea035a69 JH |
554 | |
555 | double | |
556 | T_DOUBLE( in ) | |
557 | double in | |
558 | CODE: | |
559 | RETVAL = in; | |
560 | OUTPUT: | |
561 | RETVAL | |
562 | ||
ea035a69 | 563 | |
0eb29def | 564 | ## T_PV |
ea035a69 JH |
565 | |
566 | char * | |
567 | T_PV( in ) | |
568 | char * in | |
569 | CODE: | |
570 | RETVAL = in; | |
571 | OUTPUT: | |
572 | RETVAL | |
573 | ||
ea035a69 | 574 | |
0eb29def | 575 | ## T_PTR |
ea035a69 JH |
576 | |
577 | # Pass in a value. Store the value in some static memory and | |
578 | # then return the pointer | |
579 | ||
580 | void * | |
581 | T_PTR_OUT( in ) | |
582 | int in; | |
583 | CODE: | |
052980ee TJ |
584 | xst_anint = in; |
585 | RETVAL = &xst_anint; | |
ea035a69 JH |
586 | OUTPUT: |
587 | RETVAL | |
588 | ||
589 | # pass in the pointer and return the value | |
590 | ||
591 | int | |
592 | T_PTR_IN( ptr ) | |
593 | void * ptr | |
594 | CODE: | |
595 | RETVAL = *(int *)ptr; | |
596 | OUTPUT: | |
597 | RETVAL | |
598 | ||
ea035a69 | 599 | |
0eb29def | 600 | ## T_PTRREF |
ea035a69 JH |
601 | |
602 | # Similar test to T_PTR | |
603 | # Pass in a value. Store the value in some static memory and | |
604 | # then return the pointer | |
605 | ||
606 | intRef * | |
607 | T_PTRREF_OUT( in ) | |
608 | intRef in; | |
609 | CODE: | |
052980ee TJ |
610 | xst_anintref = in; |
611 | RETVAL = &xst_anintref; | |
ea035a69 JH |
612 | OUTPUT: |
613 | RETVAL | |
614 | ||
615 | # pass in the pointer and return the value | |
616 | ||
617 | intRef | |
618 | T_PTRREF_IN( ptr ) | |
619 | intRef * ptr | |
620 | CODE: | |
621 | RETVAL = *ptr; | |
622 | OUTPUT: | |
623 | RETVAL | |
624 | ||
625 | ||
0eb29def | 626 | ## T_PTROBJ |
ea035a69 JH |
627 | |
628 | # Similar test to T_PTRREF | |
629 | # Pass in a value. Store the value in some static memory and | |
630 | # then return the pointer | |
631 | ||
632 | intObj * | |
633 | T_PTROBJ_OUT( in ) | |
634 | intObj in; | |
635 | CODE: | |
052980ee TJ |
636 | xst_anintobj = in; |
637 | RETVAL = &xst_anintobj; | |
ea035a69 JH |
638 | OUTPUT: |
639 | RETVAL | |
640 | ||
641 | # pass in the pointer and return the value | |
642 | ||
643 | MODULE = XS::Typemap PACKAGE = intObjPtr | |
644 | ||
645 | intObj | |
646 | T_PTROBJ_IN( ptr ) | |
647 | intObj * ptr | |
648 | CODE: | |
649 | RETVAL = *ptr; | |
650 | OUTPUT: | |
651 | RETVAL | |
652 | ||
653 | MODULE = XS::Typemap PACKAGE = XS::Typemap | |
654 | ||
ea035a69 | 655 | |
0eb29def S |
656 | ## T_REF_IV_REF |
657 | ## NOT YET | |
ea035a69 | 658 | |
ea035a69 | 659 | |
0eb29def | 660 | ## T_REF_IV_PTR |
ea035a69 JH |
661 | |
662 | # Similar test to T_PTROBJ | |
663 | # Pass in a value. Store the value in some static memory and | |
664 | # then return the pointer | |
665 | ||
666 | intRefIv * | |
667 | T_REF_IV_PTR_OUT( in ) | |
668 | intRefIv in; | |
669 | CODE: | |
052980ee TJ |
670 | xst_anintrefiv = in; |
671 | RETVAL = &xst_anintrefiv; | |
ea035a69 JH |
672 | OUTPUT: |
673 | RETVAL | |
674 | ||
675 | # pass in the pointer and return the value | |
676 | ||
677 | MODULE = XS::Typemap PACKAGE = intRefIvPtr | |
678 | ||
679 | intRefIv | |
680 | T_REF_IV_PTR_IN( ptr ) | |
681 | intRefIv * ptr | |
682 | CODE: | |
683 | RETVAL = *ptr; | |
684 | OUTPUT: | |
685 | RETVAL | |
686 | ||
687 | ||
688 | MODULE = XS::Typemap PACKAGE = XS::Typemap | |
689 | ||
0eb29def S |
690 | ## T_PTRDESC |
691 | ## NOT YET | |
ea035a69 | 692 | |
ea035a69 | 693 | |
0eb29def S |
694 | ## T_REFREF |
695 | ## NOT YET | |
ea035a69 | 696 | |
ea035a69 | 697 | |
0eb29def S |
698 | ## T_REFOBJ |
699 | ## NOT YET | |
ea035a69 | 700 | |
5abff6f9 | 701 | |
0eb29def | 702 | ## T_OPAQUEPTR |
ea035a69 JH |
703 | |
704 | intOpq * | |
705 | T_OPAQUEPTR_IN( val ) | |
706 | intOpq val | |
707 | CODE: | |
052980ee TJ |
708 | xst_anintopq = val; |
709 | RETVAL = &xst_anintopq; | |
ea035a69 JH |
710 | OUTPUT: |
711 | RETVAL | |
712 | ||
713 | intOpq | |
714 | T_OPAQUEPTR_OUT( ptr ) | |
715 | intOpq * ptr | |
716 | CODE: | |
717 | RETVAL = *ptr; | |
718 | OUTPUT: | |
719 | RETVAL | |
720 | ||
aa921f48 TJ |
721 | short |
722 | T_OPAQUEPTR_OUT_short( ptr ) | |
723 | shortOPQ * ptr | |
724 | CODE: | |
725 | RETVAL = *ptr; | |
726 | OUTPUT: | |
727 | RETVAL | |
728 | ||
5abff6f9 TJ |
729 | # Test it with a structure |
730 | astruct * | |
731 | T_OPAQUEPTR_IN_struct( a,b,c ) | |
732 | int a | |
733 | int b | |
734 | double c | |
735 | PREINIT: | |
736 | struct t_opaqueptr test; | |
737 | CODE: | |
738 | test.a = a; | |
739 | test.b = b; | |
740 | test.c = c; | |
741 | RETVAL = &test; | |
742 | OUTPUT: | |
743 | RETVAL | |
744 | ||
745 | void | |
746 | T_OPAQUEPTR_OUT_struct( test ) | |
747 | astruct * test | |
748 | PPCODE: | |
749 | XPUSHs(sv_2mortal(newSViv(test->a))); | |
750 | XPUSHs(sv_2mortal(newSViv(test->b))); | |
751 | XPUSHs(sv_2mortal(newSVnv(test->c))); | |
752 | ||
753 | ||
0eb29def | 754 | ## T_OPAQUE |
ea035a69 JH |
755 | |
756 | shortOPQ | |
757 | T_OPAQUE_IN( val ) | |
758 | int val | |
759 | CODE: | |
760 | RETVAL = (shortOPQ)val; | |
761 | OUTPUT: | |
762 | RETVAL | |
763 | ||
5abff6f9 TJ |
764 | IV |
765 | T_OPAQUE_OUT( val ) | |
766 | shortOPQ val | |
767 | CODE: | |
768 | RETVAL = (IV)val; | |
769 | OUTPUT: | |
770 | RETVAL | |
771 | ||
ea035a69 JH |
772 | array(int,3) |
773 | T_OPAQUE_array( a,b,c) | |
774 | int a | |
775 | int b | |
776 | int c | |
777 | PREINIT: | |
3d5d53b8 | 778 | int array[3]; |
ea035a69 JH |
779 | CODE: |
780 | array[0] = a; | |
781 | array[1] = b; | |
782 | array[2] = c; | |
783 | RETVAL = array; | |
784 | OUTPUT: | |
785 | RETVAL | |
786 | ||
787 | ||
0eb29def | 788 | ## T_PACKED |
2465d83f S |
789 | |
790 | void | |
791 | T_PACKED_in(in) | |
792 | anotherstruct *in; | |
793 | PPCODE: | |
794 | mXPUSHi(in->a); | |
795 | mXPUSHi(in->b); | |
796 | mXPUSHn(in->c); | |
797 | Safefree(in); | |
798 | XSRETURN(3); | |
799 | ||
800 | anotherstruct * | |
801 | T_PACKED_out(a, b ,c) | |
802 | int a; | |
803 | int b; | |
804 | double c; | |
805 | CODE: | |
806 | Newxz(RETVAL, 1, anotherstruct); | |
807 | RETVAL->a = a; | |
808 | RETVAL->b = b; | |
809 | RETVAL->c = c; | |
810 | OUTPUT: RETVAL | |
811 | CLEANUP: | |
812 | Safefree(RETVAL); | |
813 | ||
0eb29def | 814 | ## T_PACKEDARRAY |
ea0d3d8e S |
815 | |
816 | void | |
817 | T_PACKEDARRAY_in(in) | |
818 | anotherstruct **in; | |
819 | PREINIT: | |
820 | unsigned int i = 0; | |
821 | PPCODE: | |
822 | while (in[i] != NULL) { | |
823 | mXPUSHi(in[i]->a); | |
824 | mXPUSHi(in[i]->b); | |
825 | mXPUSHn(in[i]->c); | |
826 | ++i; | |
827 | } | |
828 | XS_release_anotherstructPtrPtr(in); | |
829 | XSRETURN(3*i); | |
830 | ||
831 | anotherstruct ** | |
832 | T_PACKEDARRAY_out(...) | |
833 | PREINIT: | |
834 | unsigned int i, nstructs, count_anotherstructPtrPtr; | |
835 | CODE: | |
836 | if ((items % 3) != 0) | |
837 | croak("Need nitems divisible by 3"); | |
838 | nstructs = (unsigned int)(items / 3); | |
839 | count_anotherstructPtrPtr = nstructs; | |
840 | Newxz(RETVAL, nstructs+1, anotherstruct *); | |
841 | for (i = 0; i < nstructs; ++i) { | |
842 | Newxz(RETVAL[i], 1, anotherstruct); | |
843 | RETVAL[i]->a = SvIV(ST(3*i)); | |
844 | RETVAL[i]->b = SvIV(ST(3*i+1)); | |
845 | RETVAL[i]->c = SvNV(ST(3*i+2)); | |
846 | } | |
847 | OUTPUT: RETVAL | |
848 | CLEANUP: | |
849 | XS_release_anotherstructPtrPtr(RETVAL); | |
850 | ||
ea035a69 | 851 | |
0eb29def S |
852 | ## T_DATAUNIT |
853 | ## NOT YET | |
ea035a69 | 854 | |
ea035a69 | 855 | |
0eb29def S |
856 | ## T_CALLBACK |
857 | ## NOT YET | |
ea035a69 | 858 | |
ea035a69 | 859 | |
0eb29def | 860 | ## T_ARRAY |
ea035a69 JH |
861 | |
862 | # Test passes in an integer array and returns it along with | |
863 | # the number of elements | |
864 | # Pass in a dummy value to test offsetting | |
865 | ||
866 | # Problem is that xsubpp does XSRETURN(1) because we arent | |
867 | # using PPCODE. This means that only the first element | |
868 | # is returned. KLUGE this by using CLEANUP to return before the | |
869 | # end. | |
ac23f157 S |
870 | # Note: I read this as: The "T_ARRAY" typemap is really rather broken, |
871 | # at least for OUTPUT. That is apart from the general design | |
872 | # weaknesses. --Steffen | |
ea035a69 JH |
873 | |
874 | intArray * | |
875 | T_ARRAY( dummy, array, ... ) | |
4d0439ce | 876 | int dummy = 0; |
ea035a69 JH |
877 | intArray * array |
878 | PREINIT: | |
879 | U32 size_RETVAL; | |
880 | CODE: | |
8876ff82 | 881 | dummy += 0; /* Fix -Wall */ |
ea035a69 JH |
882 | size_RETVAL = ix_array; |
883 | RETVAL = array; | |
884 | OUTPUT: | |
885 | RETVAL | |
886 | CLEANUP: | |
887 | Safefree(array); | |
888 | XSRETURN(size_RETVAL); | |
889 | ||
890 | ||
0eb29def | 891 | ## T_STDIO |
ea035a69 JH |
892 | |
893 | FILE * | |
894 | T_STDIO_open( file ) | |
895 | const char * file | |
896 | CODE: | |
897 | RETVAL = xsfopen( file ); | |
898 | OUTPUT: | |
899 | RETVAL | |
900 | ||
901 | SysRet | |
c72de6e4 TJ |
902 | T_STDIO_close( f ) |
903 | PerlIO * f | |
904 | PREINIT: | |
905 | FILE * stream; | |
ea035a69 | 906 | CODE: |
c72de6e4 TJ |
907 | /* Get the FILE* */ |
908 | stream = PerlIO_findFILE( f ); | |
c72de6e4 TJ |
909 | /* Release the FILE* from the PerlIO system so that we do |
910 | not close the file twice */ | |
911 | PerlIO_releaseFILE(f,stream); | |
6b54a403 NC |
912 | /* Must release the file before closing it */ |
913 | RETVAL = xsfclose( stream ); | |
ea035a69 JH |
914 | OUTPUT: |
915 | RETVAL | |
916 | ||
917 | int | |
918 | T_STDIO_print( stream, string ) | |
919 | FILE * stream | |
920 | const char * string | |
921 | CODE: | |
922 | RETVAL = xsfprintf( stream, string ); | |
923 | OUTPUT: | |
924 | RETVAL | |
925 | ||
926 | ||
0eb29def | 927 | ## T_INOUT |
0a442273 | 928 | |
60a929b5 CB |
929 | PerlIO * |
930 | T_INOUT(in) | |
931 | PerlIO *in; | |
932 | CODE: | |
933 | RETVAL = in; /* silly test but better than nothing */ | |
934 | OUTPUT: RETVAL | |
0a442273 | 935 | |
21b5216d | 936 | |
0eb29def | 937 | ## T_IN |
21b5216d | 938 | |
60a929b5 CB |
939 | inputfh |
940 | T_IN(in) | |
941 | inputfh in; | |
942 | CODE: | |
943 | RETVAL = in; /* silly test but better than nothing */ | |
944 | OUTPUT: RETVAL | |
21b5216d | 945 | |
ea035a69 | 946 | |
0eb29def | 947 | ## T_OUT |
ea035a69 | 948 | |
60a929b5 CB |
949 | outputfh |
950 | T_OUT(in) | |
951 | outputfh in; | |
952 | CODE: | |
953 | RETVAL = in; /* silly test but better than nothing */ | |
954 | OUTPUT: RETVAL | |
21b5216d | 955 |