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
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 */
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
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 *
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
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 **
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_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) {
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" is not a HASH reference", i);
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);
195     }
196
197     return out;
198 }
199
200 /* no special meaning as far as typemaps are concerned,
201  * just for convenience */
202 void
203 XS_release_anotherstructPtrPtr(anotherstruct **in)
204 {
205     unsigned int i = 0;
206     while (in[i] != NULL)
207         Safefree(in[i++]);
208     Safefree(in);
209 }
210
211
212 MODULE = XS::Typemap   PACKAGE = XS::Typemap
213
214 PROTOTYPES: DISABLE
215
216 TYPEMAP: <<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
224 svtype           T_ENUM
225 intRef *         T_PTRREF
226 intRef           T_IV
227 intObj *         T_PTROBJ
228 intObj           T_IV
229 intRefIv *       T_REF_IV_PTR
230 intRefIv         T_IV
231 intArray *       T_ARRAY
232 intOpq           T_IV
233 intOpq   *       T_OPAQUEPTR
234 intUnsigned      T_U_INT
235 intTINT          T_INT
236 intTLONG         T_LONG
237 shortOPQ         T_OPAQUE
238 shortOPQ *       T_OPAQUEPTR
239 astruct *        T_OPAQUEPTR
240 anotherstruct *  T_PACKED
241 anotherstruct ** T_PACKEDARRAY
242 AV_FIXED *       T_AVREF_REFCOUNT_FIXED
243 HV_FIXED *       T_HVREF_REFCOUNT_FIXED
244 CV_FIXED *       T_CVREF_REFCOUNT_FIXED
245 SVREF_FIXED      T_SVREF_REFCOUNT_FIXED
246 inputfh          T_IN
247 outputfh         T_OUT
248
249 END_OF_TYPEMAP
250
251
252 ## T_SV
253
254 SV *
255 T_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
269
270 ## T_SVREF
271
272 SVREF
273 T_SVREF( svref )
274   SVREF svref
275  CODE:
276   RETVAL = svref;
277  OUTPUT:
278   RETVAL
279
280
281 ## T_SVREF_FIXED
282
283 SVREF_FIXED
284 T_SVREF_REFCOUNT_FIXED( svref )
285   SVREF_FIXED svref
286  CODE:
287   SvREFCNT_inc(svref);
288   RETVAL = svref;
289  OUTPUT:
290   RETVAL
291
292
293 ## T_AVREF
294
295 AV *
296 T_AVREF( av )
297   AV * av
298  CODE:
299   RETVAL = av;
300  OUTPUT:
301   RETVAL
302
303
304 ## T_AVREF_REFCOUNT_FIXED
305
306 AV_FIXED*
307 T_AVREF_REFCOUNT_FIXED( av )
308   AV_FIXED * av
309  CODE:
310   SvREFCNT_inc(av);
311   RETVAL = av;
312  OUTPUT:
313   RETVAL
314
315
316 ## T_HVREF
317
318 HV *
319 T_HVREF( hv )
320   HV * hv
321  CODE:
322   RETVAL = hv;
323  OUTPUT:
324   RETVAL
325
326
327 ## T_HVREF_REFCOUNT_FIXED
328
329 HV_FIXED*
330 T_HVREF_REFCOUNT_FIXED( hv )
331   HV_FIXED * hv
332  CODE:
333   SvREFCNT_inc(hv);
334   RETVAL = hv;
335  OUTPUT:
336   RETVAL
337
338
339 ## T_CVREF
340
341 CV *
342 T_CVREF( cv )
343   CV * cv
344  CODE:
345   RETVAL = cv;
346  OUTPUT:
347   RETVAL
348
349
350 ## T_CVREF_REFCOUNT_FIXED
351
352 CV_FIXED *
353 T_CVREF_REFCOUNT_FIXED( cv )
354   CV_FIXED * cv
355  CODE:
356   SvREFCNT_inc(cv);
357   RETVAL = cv;
358  OUTPUT:
359   RETVAL
360
361
362 ## T_SYSRET
363
364 # Test a successful return
365
366 SysRet
367 T_SYSRET_pass()
368  CODE:
369   RETVAL = 0;
370  OUTPUT:
371   RETVAL
372
373 # Test failure
374
375 SysRet
376 T_SYSRET_fail()
377  CODE:
378   RETVAL = -1;
379  OUTPUT:
380   RETVAL
381
382 ## T_UV
383
384 unsigned int
385 T_UV( uv )
386   unsigned int uv
387  CODE:
388   RETVAL = uv;
389  OUTPUT:
390   RETVAL
391
392
393 ## T_IV
394
395 long
396 T_IV( iv )
397   long iv
398  CODE:
399   RETVAL = iv;
400  OUTPUT:
401   RETVAL
402
403
404 ## T_INT
405
406 intTINT
407 T_INT( i )
408   intTINT i
409  CODE:
410   RETVAL = i;
411  OUTPUT:
412   RETVAL
413
414
415 ## T_ENUM
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
421 svtype
422 T_ENUM()
423  CODE:
424   RETVAL = SVt_PVHV;
425  OUTPUT:
426   RETVAL
427
428
429 ## T_BOOL
430
431 bool
432 T_BOOL( in )
433   bool in
434  CODE:
435   RETVAL = in;
436  OUTPUT:
437   RETVAL
438
439 bool
440 T_BOOL_2( in )
441   bool in
442  CODE:
443     PERL_UNUSED_VAR(RETVAL);
444  OUTPUT:
445    in
446
447 void
448 T_BOOL_OUT( out, in )
449   bool out
450   bool in
451  CODE:
452  out = in;
453  OUTPUT:
454    out
455
456 ## T_U_INT
457
458 intUnsigned
459 T_U_INT( uint )
460   intUnsigned uint
461  CODE:
462   RETVAL = uint;
463  OUTPUT:
464   RETVAL
465
466
467 ## T_SHORT
468
469 short
470 T_SHORT( s )
471   short s
472  CODE:
473   RETVAL = s;
474  OUTPUT:
475   RETVAL
476
477
478 ## T_U_SHORT
479
480 U16
481 T_U_SHORT( in )
482   U16 in
483  CODE:
484   RETVAL = in;
485  OUTPUT:
486   RETVAL
487
488
489 ## T_LONG
490
491 intTLONG
492 T_LONG( in )
493   intTLONG in
494  CODE:
495   RETVAL = in;
496  OUTPUT:
497   RETVAL
498
499 ## T_U_LONG
500
501 U32
502 T_U_LONG( in )
503   U32 in
504  CODE:
505   RETVAL = in;
506  OUTPUT:
507   RETVAL
508
509
510 ## T_CHAR
511
512 char
513 T_CHAR( in );
514   char in
515  CODE:
516   RETVAL = in;
517  OUTPUT:
518   RETVAL
519
520
521 ## T_U_CHAR
522
523 unsigned char
524 T_U_CHAR( in );
525   unsigned char in
526  CODE:
527   RETVAL = in;
528  OUTPUT:
529   RETVAL
530
531
532 ## T_FLOAT
533
534 float
535 T_FLOAT( in )
536   float in
537  CODE:
538   RETVAL = in;
539  OUTPUT:
540   RETVAL
541
542
543 ## T_NV
544
545 NV
546 T_NV( in )
547   NV in
548  CODE:
549   RETVAL = in;
550  OUTPUT:
551   RETVAL
552
553
554 ## T_DOUBLE
555
556 double
557 T_DOUBLE( in )
558   double in
559  CODE:
560   RETVAL = in;
561  OUTPUT:
562   RETVAL
563
564
565 ## T_PV
566
567 char *
568 T_PV( in )
569   char * in
570  CODE:
571   RETVAL = in;
572  OUTPUT:
573   RETVAL
574
575 char *
576 T_PV_null()
577  CODE:
578   RETVAL = NULL;
579  OUTPUT:
580   RETVAL
581
582
583 ## T_PTR
584
585 # Pass in a value. Store the value in some static memory and
586 # then return the pointer
587
588 void *
589 T_PTR_OUT( in )
590   int in;
591  CODE:
592   xst_anint = in;
593   RETVAL = &xst_anint;
594  OUTPUT:
595   RETVAL
596
597 # pass in the pointer and return the value
598
599 int
600 T_PTR_IN( ptr )
601   void * ptr
602  CODE:
603   RETVAL = *(int *)ptr;
604  OUTPUT:
605   RETVAL
606
607
608 ## T_PTRREF
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
614 intRef *
615 T_PTRREF_OUT( in )
616   intRef in;
617  CODE:
618   xst_anintref = in;
619   RETVAL = &xst_anintref;
620  OUTPUT:
621   RETVAL
622
623 # pass in the pointer and return the value
624
625 intRef
626 T_PTRREF_IN( ptr )
627   intRef * ptr
628  CODE:
629   RETVAL = *ptr;
630  OUTPUT:
631   RETVAL
632
633
634 ## T_PTROBJ
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
640 intObj *
641 T_PTROBJ_OUT( in )
642   intObj in;
643  CODE:
644   xst_anintobj = in;
645   RETVAL = &xst_anintobj;
646  OUTPUT:
647   RETVAL
648
649 # pass in the pointer and return the value
650
651 MODULE = XS::Typemap  PACKAGE = intObjPtr
652
653 intObj
654 T_PTROBJ_IN( ptr )
655   intObj * ptr
656  CODE:
657   RETVAL = *ptr;
658  OUTPUT:
659   RETVAL
660
661 MODULE = XS::Typemap PACKAGE = XS::Typemap
662
663
664 ## T_REF_IV_REF
665 ## NOT YET
666
667
668 ## T_REF_IV_PTR
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
674 intRefIv *
675 T_REF_IV_PTR_OUT( in )
676   intRefIv in;
677  CODE:
678   xst_anintrefiv = in;
679   RETVAL = &xst_anintrefiv;
680  OUTPUT:
681   RETVAL
682
683 # pass in the pointer and return the value
684
685 MODULE = XS::Typemap  PACKAGE = intRefIvPtr
686
687 intRefIv
688 T_REF_IV_PTR_IN( ptr )
689   intRefIv * ptr
690  CODE:
691   RETVAL = *ptr;
692  OUTPUT:
693   RETVAL
694
695
696 MODULE = XS::Typemap PACKAGE = XS::Typemap
697
698 ## T_PTRDESC
699 ## NOT YET
700
701
702 ## T_REFREF
703 ## NOT YET
704
705
706 ## T_REFOBJ
707 ## NOT YET
708
709
710 ## T_OPAQUEPTR
711
712 intOpq *
713 T_OPAQUEPTR_IN( val )
714   intOpq val
715  CODE:
716   xst_anintopq = val;
717   RETVAL = &xst_anintopq;
718  OUTPUT:
719   RETVAL
720
721 intOpq
722 T_OPAQUEPTR_OUT( ptr )
723   intOpq * ptr
724  CODE:
725   RETVAL = *ptr;
726  OUTPUT:
727   RETVAL
728
729 short
730 T_OPAQUEPTR_OUT_short( ptr )
731   shortOPQ * ptr
732  CODE:
733   RETVAL = *ptr;
734  OUTPUT:
735   RETVAL
736
737 # Test it with a structure
738 astruct *
739 T_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
753 void
754 T_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
762 ## T_OPAQUE
763
764 shortOPQ
765 T_OPAQUE_IN( val )
766   int val
767  CODE:
768   RETVAL = (shortOPQ)val;
769  OUTPUT:
770   RETVAL
771
772 IV
773 T_OPAQUE_OUT( val )
774   shortOPQ val
775  CODE:
776   RETVAL = (IV)val;
777  OUTPUT:
778   RETVAL
779
780 array(int,3)
781 T_OPAQUE_array( a,b,c)
782   int a
783   int b
784   int c
785  PREINIT:
786   int array[3];
787  CODE:
788   array[0] = a;
789   array[1] = b;
790   array[2] = c;
791   RETVAL = array;
792  OUTPUT:
793   RETVAL
794
795
796 ## T_PACKED
797
798 void
799 T_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
808 anotherstruct *
809 T_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
822 ## T_PACKEDARRAY
823
824 void
825 T_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
839 anotherstruct **
840 T_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
859
860 ## T_DATAUNIT
861 ## NOT YET
862
863
864 ## T_CALLBACK
865 ## NOT YET
866
867
868 ## T_ARRAY
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.
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
881
882 intArray *
883 T_ARRAY( dummy, array, ... )
884   int dummy = 0;
885   intArray * array
886  PREINIT:
887   U32 size_RETVAL;
888  CODE:
889   dummy += 0; /* Fix -Wall */
890   size_RETVAL = ix_array;
891   RETVAL = array;
892  OUTPUT:
893   RETVAL
894  CLEANUP:
895   Safefree(array);
896   XSRETURN(size_RETVAL);
897
898
899 ## T_STDIO
900
901 FILE *
902 T_STDIO_open( file )
903   const char * file
904  CODE:
905   RETVAL = xsfopen( file );
906  OUTPUT:
907   RETVAL
908
909 SysRet
910 T_STDIO_close( f )
911   PerlIO * f
912  PREINIT:
913   FILE * stream;
914  CODE:
915   /* Get the FILE* */
916   stream = PerlIO_findFILE( f );  
917   /* Release the FILE* from the PerlIO system so that we do
918      not close the file twice */
919   PerlIO_releaseFILE(f,stream);
920   /* Must release the file before closing it */
921   RETVAL = xsfclose( stream );
922  OUTPUT:
923   RETVAL
924
925 int
926 T_STDIO_print( stream, string )
927   FILE * stream
928   const char * string
929  CODE:
930   RETVAL = xsfprintf( stream, string );
931  OUTPUT:
932   RETVAL
933
934
935 ## T_INOUT
936
937 PerlIO *
938 T_INOUT(in)
939   PerlIO *in;
940  CODE:
941   RETVAL = in; /* silly test but better than nothing */
942  OUTPUT: RETVAL
943
944
945 ## T_IN
946
947 inputfh
948 T_IN(in)
949   inputfh in;
950  CODE:
951   RETVAL = in; /* silly test but better than nothing */
952  OUTPUT: RETVAL
953
954
955 ## T_OUT
956
957 outputfh
958 T_OUT(in)
959   outputfh in;
960  CODE:
961   RETVAL = in; /* silly test but better than nothing */
962  OUTPUT: RETVAL
963