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