This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlre: fix typo
[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
S
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
S
55typedef AV AV_FIXED;
56typedef HV HV_FIXED;
1d2615b4
S
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
S
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
S
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
S
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
S
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
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 */
202void
203XS_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
212MODULE = XS::Typemap PACKAGE = XS::Typemap
213
214PROTOTYPES: DISABLE
215
09186e9e
S
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
S
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
S
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
S
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
S
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
S
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
S
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
S
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
S
439bool
440T_BOOL_2( in )
441 bool in
442 CODE:
443 OUTPUT:
444 in
445
b0bbf760
DD
446void
447T_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
457intUnsigned
458T_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
468short
469T_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
479U16
480T_U_SHORT( in )
481 U16 in
482 CODE:
483 RETVAL = in;
484 OUTPUT:
485 RETVAL
486
487
0eb29def 488## T_LONG
604db645
S
489
490intTLONG
491T_LONG( in )
492 intTLONG in
493 CODE:
494 RETVAL = in;
495 OUTPUT:
496 RETVAL
497
0eb29def 498## T_U_LONG
ea035a69
JH
499
500U32
501T_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
511char
512T_CHAR( in );
513 char in
514 CODE:
515 RETVAL = in;
516 OUTPUT:
517 RETVAL
518
519
0eb29def 520## T_U_CHAR
ea035a69
JH
521
522unsigned char
523T_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
533float
534T_FLOAT( in )
535 float in
536 CODE:
537 RETVAL = in;
538 OUTPUT:
539 RETVAL
540
ea035a69 541
0eb29def 542## T_NV
ea035a69
JH
543
544NV
545T_NV( in )
546 NV in
547 CODE:
548 RETVAL = in;
549 OUTPUT:
550 RETVAL
551
ea035a69 552
0eb29def 553## T_DOUBLE
ea035a69
JH
554
555double
556T_DOUBLE( in )
557 double in
558 CODE:
559 RETVAL = in;
560 OUTPUT:
561 RETVAL
562
ea035a69 563
0eb29def 564## T_PV
ea035a69
JH
565
566char *
567T_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
580void *
581T_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
591int
592T_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
606intRef *
607T_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
617intRef
618T_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
632intObj *
633T_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
643MODULE = XS::Typemap PACKAGE = intObjPtr
644
645intObj
646T_PTROBJ_IN( ptr )
647 intObj * ptr
648 CODE:
649 RETVAL = *ptr;
650 OUTPUT:
651 RETVAL
652
653MODULE = 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
666intRefIv *
667T_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
677MODULE = XS::Typemap PACKAGE = intRefIvPtr
678
679intRefIv
680T_REF_IV_PTR_IN( ptr )
681 intRefIv * ptr
682 CODE:
683 RETVAL = *ptr;
684 OUTPUT:
685 RETVAL
686
687
688MODULE = 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
704intOpq *
705T_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
713intOpq
714T_OPAQUEPTR_OUT( ptr )
715 intOpq * ptr
716 CODE:
717 RETVAL = *ptr;
718 OUTPUT:
719 RETVAL
720
aa921f48
TJ
721short
722T_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
730astruct *
731T_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
745void
746T_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
756shortOPQ
757T_OPAQUE_IN( val )
758 int val
759 CODE:
760 RETVAL = (shortOPQ)val;
761 OUTPUT:
762 RETVAL
763
5abff6f9
TJ
764IV
765T_OPAQUE_OUT( val )
766 shortOPQ val
767 CODE:
768 RETVAL = (IV)val;
769 OUTPUT:
770 RETVAL
771
ea035a69
JH
772array(int,3)
773T_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
790void
791T_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
800anotherstruct *
801T_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
816void
817T_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
831anotherstruct **
832T_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
874intArray *
875T_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
893FILE *
894T_STDIO_open( file )
895 const char * file
896 CODE:
897 RETVAL = xsfopen( file );
898 OUTPUT:
899 RETVAL
900
901SysRet
c72de6e4
TJ
902T_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
917int
918T_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
929PerlIO *
930T_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
939inputfh
940T_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
949outputfh
950T_OUT(in)
951 outputfh in;
952 CODE:
953 RETVAL = in; /* silly test but better than nothing */
954 OUTPUT: RETVAL
21b5216d 955