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