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