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