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