1 /*
2 XS code to test the typemap entries
3
4 Copyright (C) 2001 Tim Jenness.
5 All Rights Reserved
6
7 */
8
9 #define PERL_NO_GET_CONTEXT
10
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 */
16 FILE * xsfopen( const char * );
17 int xsfclose( FILE * );
18 int xsfprintf( FILE *, const char *);
19
20 /* Type definitions required for the XS typemaps */
21 typedef SV * SVREF; /* T_SVREF */
22 typedef int SysRet; /* T_SYSRET */
23 typedef int Int; /* T_INT */
24 typedef int intRef; /* T_PTRREF */
25 typedef int intObj; /* T_PTROBJ */
26 typedef int intRefIv; /* T_REF_IV_PTR */
27 typedef int intArray; /* T_ARRAY */
28 typedef int intTINT; /* T_INT */
29 typedef int intTLONG; /* T_LONG */
30 typedef short shortOPQ; /* T_OPAQUE */
31 typedef int intOpq; /* T_OPAQUEPTR */
32 typedef unsigned intUnsigned; /* T_U_INT */
33 typedef PerlIO * inputfh; /* T_IN */
34 typedef PerlIO * outputfh; /* T_OUT */
35
36 /* A structure to test T_OPAQUEPTR and T_PACKED */
37 struct t_opaqueptr {
38 int a;
39 int b;
40 double c;
41 };
42
43 typedef struct t_opaqueptr astruct;
44 typedef struct t_opaqueptr anotherstruct;
45
46 /* Some static memory for the tests */
47 static I32 xst_anint;
48 static intRef xst_anintref;
49 static intObj xst_anintobj;
50 static intRefIv xst_anintrefiv;
51 static intOpq xst_anintopq;
52
53 /* A different type to refer to for testing the different
54 * AV*, HV*, etc typemaps */
55 typedef AV AV_FIXED;
56 typedef HV HV_FIXED;
57 typedef CV CV_FIXED;
58 typedef SVREF SVREF_FIXED;
59
60 /* Helper functions */
61
62 /* T_ARRAY - allocate some memory */
intArrayPtr(int nelem)63 intArray * intArrayPtr( int nelem ) {
64 intArray * array;
65 Newx(array, nelem, intArray);
66 return array;
67 }
68
69 /* test T_PACKED */
70 STATIC void
XS_pack_anotherstructPtr(SV * out,anotherstruct * in)71 XS_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 }
83
84 STATIC anotherstruct *
XS_unpack_anotherstructPtr(SV * in)85 XS_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
120 /* test T_PACKEDARRAY */
121 STATIC void
XS_pack_anotherstructPtrPtr(SV * out,anotherstruct ** in,UV cnt)122 XS_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 }
139
140 STATIC anotherstruct **
XS_unpack_anotherstructPtrPtr(SV * in)141 XS_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)
156 inary = (AV*)SvRV(tmp);
157 else
158 Perl_croak(aTHX_ "Argument is not an ARRAY reference");
159
160 nitems = av_count(inary);
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) {
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
179 Perl_croak(aTHX_ "Array element %" UVuf
180 " is not a HASH reference", i);
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);
196 }
197
198 return out;
199 }
200
201 /* no special meaning as far as typemaps are concerned,
202 * just for convenience */
203 void
XS_release_anotherstructPtrPtr(anotherstruct ** in)204 XS_release_anotherstructPtrPtr(anotherstruct **in)
205 {
206 unsigned int i;
207 for (i = 0; in[i] != NULL; i++)
208 Safefree(in[i]);
209 Safefree(in);
210 }
211
212
213 MODULE = XS::Typemap PACKAGE = XS::Typemap
214
215 PROTOTYPES: DISABLE
216
217 TYPEMAP: <<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
225 svtype T_ENUM
226 intRef * T_PTRREF
227 intRef T_IV
228 intObj * T_PTROBJ
229 intObj T_IV
230 intRefIv * T_REF_IV_PTR
231 intRefIv T_IV
232 intArray * T_ARRAY
233 intOpq T_IV
234 intOpq * T_OPAQUEPTR
235 intUnsigned T_U_INT
236 intTINT T_INT
237 intTLONG T_LONG
238 shortOPQ T_OPAQUE
239 shortOPQ * T_OPAQUEPTR
240 astruct * T_OPAQUEPTR
241 anotherstruct * T_PACKED
242 anotherstruct ** T_PACKEDARRAY
243 AV_FIXED * T_AVREF_REFCOUNT_FIXED
244 HV_FIXED * T_HVREF_REFCOUNT_FIXED
245 CV_FIXED * T_CVREF_REFCOUNT_FIXED
246 SVREF_FIXED T_SVREF_REFCOUNT_FIXED
247 inputfh T_IN
248 outputfh T_OUT
249
250 END_OF_TYPEMAP
251
252
253 ## T_SV
254
255 SV *
256 T_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
270 void
271 T_SV_output(sv)
272 SV *sv
273 CODE:
274 sv = sv_2mortal(newSVpvn("test", 4));
275 OUTPUT:
276 sv
277
278 ## T_SVREF
279
280 SVREF
281 T_SVREF( svref )
282 SVREF svref
283 CODE:
284 RETVAL = svref;
285 OUTPUT:
286 RETVAL
287
288
289 ## T_SVREF_FIXED
290
291 SVREF_FIXED
292 T_SVREF_REFCOUNT_FIXED( svref )
293 SVREF_FIXED svref
294 CODE:
295 SvREFCNT_inc(svref);
296 RETVAL = svref;
297 OUTPUT:
298 RETVAL
299
300 void
301 T_SVREF_REFCOUNT_FIXED_output( OUT svref )
302 SVREF_FIXED svref
303 CODE:
304 svref = newSVpvn("test", 4);
305
306 ## T_AVREF
307
308 AV *
309 T_AVREF( av )
310 AV * av
311 CODE:
312 RETVAL = av;
313 OUTPUT:
314 RETVAL
315
316
317 ## T_AVREF_REFCOUNT_FIXED
318
319 AV_FIXED*
320 T_AVREF_REFCOUNT_FIXED( av )
321 AV_FIXED * av
322 CODE:
323 SvREFCNT_inc(av);
324 RETVAL = av;
325 OUTPUT:
326 RETVAL
327
328 void
329 T_AVREF_REFCOUNT_FIXED_output( OUT avref)
330 AV_FIXED *avref;
331 CODE:
332 avref = newAV();
333 av_push(avref, newSVpvs("test"));
334
335 ## T_HVREF
336
337 HV *
338 T_HVREF( hv )
339 HV * hv
340 CODE:
341 RETVAL = hv;
342 OUTPUT:
343 RETVAL
344
345
346 ## T_HVREF_REFCOUNT_FIXED
347
348 HV_FIXED*
349 T_HVREF_REFCOUNT_FIXED( hv )
350 HV_FIXED * hv
351 CODE:
352 SvREFCNT_inc(hv);
353 RETVAL = hv;
354 OUTPUT:
355 RETVAL
356
357 void
358 T_HVREF_REFCOUNT_FIXED_output( OUT hvref)
359 HV_FIXED *hvref;
360 CODE:
361 hvref = newHV();
362 hv_stores(hvref, "test", newSVpvs("value"));
363
364 ## T_CVREF
365
366 CV *
367 T_CVREF( cv )
368 CV * cv
369 CODE:
370 RETVAL = cv;
371 OUTPUT:
372 RETVAL
373
374
375 ## T_CVREF_REFCOUNT_FIXED
376
377 CV_FIXED *
378 T_CVREF_REFCOUNT_FIXED( cv )
379 CV_FIXED * cv
380 CODE:
381 SvREFCNT_inc(cv);
382 RETVAL = cv;
383 OUTPUT:
384 RETVAL
385
386 void
387 T_CVREF_REFCOUNT_FIXED_output( OUT cvref)
388 CV_FIXED *cvref;
389 CODE:
390 cvref = get_cv("XSLoader::load", 0);
391 SvREFCNT_inc(cvref);
392
393 ## T_SYSRET
394
395 # Test a successful return
396
397 SysRet
398 T_SYSRET_pass()
399 CODE:
400 RETVAL = 0;
401 OUTPUT:
402 RETVAL
403
404 # Test failure
405
406 SysRet
407 T_SYSRET_fail()
408 CODE:
409 RETVAL = -1;
410 OUTPUT:
411 RETVAL
412
413 ## T_UV
414
415 unsigned int
416 T_UV( uv )
417 unsigned int uv
418 CODE:
419 RETVAL = uv;
420 OUTPUT:
421 RETVAL
422
423
424 ## T_IV
425
426 long
427 T_IV( iv )
428 long iv
429 CODE:
430 RETVAL = iv;
431 OUTPUT:
432 RETVAL
433
434
435 ## T_INT
436
437 intTINT
438 T_INT( i )
439 intTINT i
440 CODE:
441 RETVAL = i;
442 OUTPUT:
443 RETVAL
444
445
446 ## T_ENUM
447
448 # The test should return the value for SVt_PVHV.
449 # 11 at the present time but we can't not rely on this
450 # for testing purposes.
451
452 svtype
453 T_ENUM()
454 CODE:
455 RETVAL = SVt_PVHV;
456 OUTPUT:
457 RETVAL
458
459
460 ## T_BOOL
461
462 bool
463 T_BOOL( in )
464 bool in
465 CODE:
466 RETVAL = in;
467 OUTPUT:
468 RETVAL
469
470 bool
471 T_BOOL_2( in )
472 bool in
473 CODE:
474 PERL_UNUSED_VAR(RETVAL);
475 OUTPUT:
476 in
477
478 void
479 T_BOOL_OUT( out, in )
480 bool out
481 bool in
482 CODE:
483 out = in;
484 OUTPUT:
485 out
486
487 ## T_U_INT
488
489 intUnsigned
490 T_U_INT( uint )
491 intUnsigned uint
492 CODE:
493 RETVAL = uint;
494 OUTPUT:
495 RETVAL
496
497
498 ## T_SHORT
499
500 short
501 T_SHORT( s )
502 short s
503 CODE:
504 RETVAL = s;
505 OUTPUT:
506 RETVAL
507
508
509 ## T_U_SHORT
510
511 U16
512 T_U_SHORT( in )
513 U16 in
514 CODE:
515 RETVAL = in;
516 OUTPUT:
517 RETVAL
518
519
520 ## T_LONG
521
522 intTLONG
523 T_LONG( in )
524 intTLONG in
525 CODE:
526 RETVAL = in;
527 OUTPUT:
528 RETVAL
529
530 ## T_U_LONG
531
532 U32
533 T_U_LONG( in )
534 U32 in
535 CODE:
536 RETVAL = in;
537 OUTPUT:
538 RETVAL
539
540
541 ## T_CHAR
542
543 char
544 T_CHAR( in );
545 char in
546 CODE:
547 RETVAL = in;
548 OUTPUT:
549 RETVAL
550
551
552 ## T_U_CHAR
553
554 unsigned char
555 T_U_CHAR( in );
556 unsigned char in
557 CODE:
558 RETVAL = in;
559 OUTPUT:
560 RETVAL
561
562
563 ## T_FLOAT
564
565 float
566 T_FLOAT( in )
567 float in
568 CODE:
569 RETVAL = in;
570 OUTPUT:
571 RETVAL
572
573
574 ## T_NV
575
576 NV
577 T_NV( in )
578 NV in
579 CODE:
580 RETVAL = in;
581 OUTPUT:
582 RETVAL
583
584
585 ## T_DOUBLE
586
587 double
588 T_DOUBLE( in )
589 double in
590 CODE:
591 RETVAL = in;
592 OUTPUT:
593 RETVAL
594
595
596 ## T_PV
597
598 char *
599 T_PV( in )
600 char * in
601 CODE:
602 RETVAL = in;
603 OUTPUT:
604 RETVAL
605
606 char *
607 T_PV_null()
608 CODE:
609 RETVAL = NULL;
610 OUTPUT:
611 RETVAL
612
613
614 ## T_PTR
615
616 # Pass in a value. Store the value in some static memory and
617 # then return the pointer
618
619 void *
620 T_PTR_OUT( in )
621 int in;
622 CODE:
623 xst_anint = in;
624 RETVAL = &xst_anint;
625 OUTPUT:
626 RETVAL
627
628 # pass in the pointer and return the value
629
630 int
631 T_PTR_IN( ptr )
632 void * ptr
633 CODE:
634 RETVAL = *(int *)ptr;
635 OUTPUT:
636 RETVAL
637
638
639 ## T_PTRREF
640
641 # Similar test to T_PTR
642 # Pass in a value. Store the value in some static memory and
643 # then return the pointer
644
645 intRef *
646 T_PTRREF_OUT( in )
647 intRef in;
648 CODE:
649 xst_anintref = in;
650 RETVAL = &xst_anintref;
651 OUTPUT:
652 RETVAL
653
654 # pass in the pointer and return the value
655
656 intRef
657 T_PTRREF_IN( ptr )
658 intRef * ptr
659 CODE:
660 RETVAL = *ptr;
661 OUTPUT:
662 RETVAL
663
664
665 ## T_PTROBJ
666
667 # Similar test to T_PTRREF
668 # Pass in a value. Store the value in some static memory and
669 # then return the pointer
670
671 intObj *
672 T_PTROBJ_OUT( in )
673 intObj in;
674 CODE:
675 xst_anintobj = in;
676 RETVAL = &xst_anintobj;
677 OUTPUT:
678 RETVAL
679
680 # pass in the pointer and return the value
681
682 MODULE = XS::Typemap PACKAGE = intObjPtr
683
684 intObj
685 T_PTROBJ_IN( ptr )
686 intObj * ptr
687 CODE:
688 RETVAL = *ptr;
689 OUTPUT:
690 RETVAL
691
692 MODULE = XS::Typemap PACKAGE = XS::Typemap
693
694
695 ## T_REF_IV_REF
696 ## NOT YET
697
698
699 ## T_REF_IV_PTR
700
701 # Similar test to T_PTROBJ
702 # Pass in a value. Store the value in some static memory and
703 # then return the pointer
704
705 intRefIv *
706 T_REF_IV_PTR_OUT( in )
707 intRefIv in;
708 CODE:
709 xst_anintrefiv = in;
710 RETVAL = &xst_anintrefiv;
711 OUTPUT:
712 RETVAL
713
714 # pass in the pointer and return the value
715
716 MODULE = XS::Typemap PACKAGE = intRefIvPtr
717
718 intRefIv
719 T_REF_IV_PTR_IN( ptr )
720 intRefIv * ptr
721 CODE:
722 RETVAL = *ptr;
723 OUTPUT:
724 RETVAL
725
726
727 MODULE = XS::Typemap PACKAGE = XS::Typemap
728
729 ## T_PTRDESC
730 ## NOT YET
731
732
733 ## T_REFREF
734 ## NOT YET
735
736
737 ## T_REFOBJ
738 ## NOT YET
739
740
741 ## T_OPAQUEPTR
742
743 intOpq *
744 T_OPAQUEPTR_IN( val )
745 intOpq val
746 CODE:
747 xst_anintopq = val;
748 RETVAL = &xst_anintopq;
749 OUTPUT:
750 RETVAL
751
752 intOpq
753 T_OPAQUEPTR_OUT( ptr )
754 intOpq * ptr
755 CODE:
756 RETVAL = *ptr;
757 OUTPUT:
758 RETVAL
759
760 short
761 T_OPAQUEPTR_OUT_short( ptr )
762 shortOPQ * ptr
763 CODE:
764 RETVAL = *ptr;
765 OUTPUT:
766 RETVAL
767
768 # Test it with a structure
769 astruct *
770 T_OPAQUEPTR_IN_struct( a,b,c )
771 int a
772 int b
773 double c
774 PREINIT:
775 struct t_opaqueptr test;
776 CODE:
777 test.a = a;
778 test.b = b;
779 test.c = c;
780 RETVAL = &test;
781 OUTPUT:
782 RETVAL
783
784 void
785 T_OPAQUEPTR_OUT_struct( test )
786 astruct * test
787 PPCODE:
788 XPUSHs(sv_2mortal(newSViv(test->a)));
789 XPUSHs(sv_2mortal(newSViv(test->b)));
790 XPUSHs(sv_2mortal(newSVnv(test->c)));
791
792
793 ## T_OPAQUE
794
795 shortOPQ
796 T_OPAQUE_IN( val )
797 int val
798 CODE:
799 RETVAL = (shortOPQ)val;
800 OUTPUT:
801 RETVAL
802
803 IV
804 T_OPAQUE_OUT( val )
805 shortOPQ val
806 CODE:
807 RETVAL = (IV)val;
808 OUTPUT:
809 RETVAL
810
811 array(int,3)
812 T_OPAQUE_array( a,b,c)
813 int a
814 int b
815 int c
816 PREINIT:
817 int array[3];
818 CODE:
819 array[0] = a;
820 array[1] = b;
821 array[2] = c;
822 RETVAL = array;
823 OUTPUT:
824 RETVAL
825
826
827 ## T_PACKED
828
829 void
830 T_PACKED_in(in)
831 anotherstruct *in;
832 PPCODE:
833 mXPUSHi(in->a);
834 mXPUSHi(in->b);
835 mXPUSHn(in->c);
836 Safefree(in);
837 XSRETURN(3);
838
839 anotherstruct *
840 T_PACKED_out(a, b ,c)
841 int a;
842 int b;
843 double c;
844 CODE:
845 Newxz(RETVAL, 1, anotherstruct);
846 RETVAL->a = a;
847 RETVAL->b = b;
848 RETVAL->c = c;
849 OUTPUT: RETVAL
850 CLEANUP:
851 Safefree(RETVAL);
852
853 ## T_PACKEDARRAY
854
855 void
856 T_PACKEDARRAY_in(in)
857 anotherstruct **in;
858 PREINIT:
859 unsigned int i = 0;
860 PPCODE:
861 while (in[i] != NULL) {
862 mXPUSHi(in[i]->a);
863 mXPUSHi(in[i]->b);
864 mXPUSHn(in[i]->c);
865 ++i;
866 }
867 XS_release_anotherstructPtrPtr(in);
868 XSRETURN(3*i);
869
870 anotherstruct **
871 T_PACKEDARRAY_out(...)
872 PREINIT:
873 unsigned int i, nstructs, count_anotherstructPtrPtr;
874 CODE:
875 if ((items % 3) != 0)
876 croak("Need nitems divisible by 3");
877 nstructs = (unsigned int)(items / 3);
878 count_anotherstructPtrPtr = nstructs;
879 Newxz(RETVAL, nstructs+1, anotherstruct *);
880 for (i = 0; i < nstructs; ++i) {
881 Newxz(RETVAL[i], 1, anotherstruct);
882 RETVAL[i]->a = SvIV(ST(3*i));
883 RETVAL[i]->b = SvIV(ST(3*i+1));
884 RETVAL[i]->c = SvNV(ST(3*i+2));
885 }
886 OUTPUT: RETVAL
887 CLEANUP:
888 XS_release_anotherstructPtrPtr(RETVAL);
889
890
891 ## T_DATAUNIT
892 ## NOT YET
893
894
895 ## T_CALLBACK
896 ## NOT YET
897
898
899 ## T_ARRAY
900
901 # Test passes in an integer array and returns it along with
902 # the number of elements
903 # Pass in a dummy value to test offsetting
904
905 # Problem is that xsubpp does XSRETURN(1) because we arent
906 # using PPCODE. This means that only the first element
907 # is returned. KLUGE this by using CLEANUP to return before the
908 # end.
909 # Note: I read this as: The "T_ARRAY" typemap is really rather broken,
910 # at least for OUTPUT. That is apart from the general design
911 # weaknesses. --Steffen
912
913 intArray *
914 T_ARRAY( dummy, array, ... )
915 int dummy = 0;
916 intArray * array
917 PREINIT:
918 U32 size_RETVAL;
919 CODE:
920 dummy += 0; /* Fix -Wall */
921 size_RETVAL = ix_array;
922 RETVAL = array;
923 OUTPUT:
924 RETVAL
925 CLEANUP:
926 Safefree(array);
927 XSRETURN(size_RETVAL);
928
929
930 ## T_STDIO
931
932 FILE *
933 T_STDIO_open( file )
934 const char * file
935 CODE:
936 RETVAL = xsfopen( file );
937 OUTPUT:
938 RETVAL
939
940 void
941 T_STDIO_open_ret_in_arg( file, io)
942 const char * file
943 FILE * io = NO_INIT
944 CODE:
945 io = xsfopen( file );
946 OUTPUT:
947 io
948
949 SysRet
950 T_STDIO_close( f )
951 PerlIO * f
952 PREINIT:
953 FILE * stream;
954 CODE:
955 /* Get the FILE* */
956 stream = PerlIO_findFILE( f );
957 /* Release the FILE* from the PerlIO system so that we do
958 not close the file twice */
959 PerlIO_releaseFILE(f,stream);
960 /* Must release the file before closing it */
961 RETVAL = xsfclose( stream );
962 OUTPUT:
963 RETVAL
964
965 int
966 T_STDIO_print( stream, string )
967 FILE * stream
968 const char * string
969 CODE:
970 RETVAL = xsfprintf( stream, string );
971 OUTPUT:
972 RETVAL
973
974
975 ## T_INOUT
976
977 PerlIO *
978 T_INOUT(in)
979 PerlIO *in;
980 CODE:
981 RETVAL = in; /* silly test but better than nothing */
982 OUTPUT: RETVAL
983
984
985 ## T_IN
986
987 inputfh
988 T_IN(in)
989 inputfh in;
990 CODE:
991 RETVAL = in; /* silly test but better than nothing */
992 OUTPUT: RETVAL
993
994
995 ## T_OUT
996
997 outputfh
998 T_OUT(in)
999 outputfh in;
1000 CODE:
1001 RETVAL = in; /* silly test but better than nothing */
1002 OUTPUT: RETVAL
1003
1004