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 */
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 */
28typedef int intTINT; /* T_INT */
29typedef int intTLONG; /* T_LONG */
30typedef short shortOPQ;   /* T_OPAQUE */
31typedef int intOpq;   /* T_OPAQUEPTR */
32typedef unsigned intUnsigned; /* T_U_INT */
33typedef PerlIO * inputfh; /* T_IN */
34typedef PerlIO * outputfh; /* T_OUT */
35
36/* A structure to test T_OPAQUEPTR and T_PACKED */
37struct t_opaqueptr {
38  int a;
39  int b;
40  double c;
41};
42
43typedef struct t_opaqueptr astruct;
44typedef struct t_opaqueptr anotherstruct;
45
46/* Some static memory for the tests */
47static I32 xst_anint;
48static intRef xst_anintref;
49static intObj xst_anintobj;
50static intRefIv xst_anintrefiv;
51static intOpq xst_anintopq;
52
53/* A different type to refer to for testing the different
54 * AV*, HV*, etc typemaps */
55typedef AV AV_FIXED;
56typedef HV HV_FIXED;
57typedef CV CV_FIXED;
58typedef SVREF SVREF_FIXED;
59
60/* Helper functions */
61
62/* T_ARRAY - allocate some memory */
63intArray * intArrayPtr( int nelem ) {
64    intArray * array;
65    Newx(array, nelem, intArray);
66    return array;
67}
68
69/* test T_PACKED */
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}
83
84STATIC anotherstruct *
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
120/* test T_PACKEDARRAY */
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}
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)
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 */
203void
204XS_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
213MODULE = XS::Typemap   PACKAGE = XS::Typemap
214
215PROTOTYPES: DISABLE
216
217TYPEMAP: <<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
225svtype           T_ENUM
226intRef *         T_PTRREF
227intRef           T_IV
228intObj *         T_PTROBJ
229intObj           T_IV
230intRefIv *       T_REF_IV_PTR
231intRefIv         T_IV
232intArray *       T_ARRAY
233intOpq           T_IV
234intOpq   *       T_OPAQUEPTR
235intUnsigned      T_U_INT
236intTINT          T_INT
237intTLONG         T_LONG
238shortOPQ         T_OPAQUE
239shortOPQ *       T_OPAQUEPTR
240astruct *        T_OPAQUEPTR
241anotherstruct *  T_PACKED
242anotherstruct ** T_PACKEDARRAY
243AV_FIXED *	 T_AVREF_REFCOUNT_FIXED
244HV_FIXED *	 T_HVREF_REFCOUNT_FIXED
245CV_FIXED *	 T_CVREF_REFCOUNT_FIXED
246SVREF_FIXED	 T_SVREF_REFCOUNT_FIXED
247inputfh          T_IN
248outputfh         T_OUT
249
250END_OF_TYPEMAP
251
252
253## T_SV
254
255SV *
256T_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
270void
271T_SV_output(sv)
272  SV *sv
273 CODE:
274 sv = sv_2mortal(newSVpvn("test", 4));
275 OUTPUT:
276  sv
277
278## T_SVREF
279
280SVREF
281T_SVREF( svref )
282  SVREF svref
283 CODE:
284  RETVAL = svref;
285 OUTPUT:
286  RETVAL
287
288
289## T_SVREF_FIXED
290
291SVREF_FIXED
292T_SVREF_REFCOUNT_FIXED( svref )
293  SVREF_FIXED svref
294 CODE:
295  SvREFCNT_inc(svref);
296  RETVAL = svref;
297 OUTPUT:
298  RETVAL
299
300void
301T_SVREF_REFCOUNT_FIXED_output( OUT svref )
302  SVREF_FIXED svref
303 CODE:
304  svref = newSVpvn("test", 4);
305
306## T_AVREF
307
308AV *
309T_AVREF( av )
310  AV * av
311 CODE:
312  RETVAL = av;
313 OUTPUT:
314  RETVAL
315
316
317## T_AVREF_REFCOUNT_FIXED
318
319AV_FIXED*
320T_AVREF_REFCOUNT_FIXED( av )
321  AV_FIXED * av
322 CODE:
323  SvREFCNT_inc(av);
324  RETVAL = av;
325 OUTPUT:
326  RETVAL
327
328void
329T_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
337HV *
338T_HVREF( hv )
339  HV * hv
340 CODE:
341  RETVAL = hv;
342 OUTPUT:
343  RETVAL
344
345
346## T_HVREF_REFCOUNT_FIXED
347
348HV_FIXED*
349T_HVREF_REFCOUNT_FIXED( hv )
350  HV_FIXED * hv
351 CODE:
352  SvREFCNT_inc(hv);
353  RETVAL = hv;
354 OUTPUT:
355  RETVAL
356
357void
358T_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
366CV *
367T_CVREF( cv )
368  CV * cv
369 CODE:
370  RETVAL = cv;
371 OUTPUT:
372  RETVAL
373
374
375## T_CVREF_REFCOUNT_FIXED
376
377CV_FIXED *
378T_CVREF_REFCOUNT_FIXED( cv )
379  CV_FIXED * cv
380 CODE:
381  SvREFCNT_inc(cv);
382  RETVAL = cv;
383 OUTPUT:
384  RETVAL
385
386void
387T_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
397SysRet
398T_SYSRET_pass()
399 CODE:
400  RETVAL = 0;
401 OUTPUT:
402  RETVAL
403
404# Test failure
405
406SysRet
407T_SYSRET_fail()
408 CODE:
409  RETVAL = -1;
410 OUTPUT:
411  RETVAL
412
413## T_UV
414
415unsigned int
416T_UV( uv )
417  unsigned int uv
418 CODE:
419  RETVAL = uv;
420 OUTPUT:
421  RETVAL
422
423
424## T_IV
425
426long
427T_IV( iv )
428  long iv
429 CODE:
430  RETVAL = iv;
431 OUTPUT:
432  RETVAL
433
434
435## T_INT
436
437intTINT
438T_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
452svtype
453T_ENUM()
454 CODE:
455  RETVAL = SVt_PVHV;
456 OUTPUT:
457  RETVAL
458
459
460## T_BOOL
461
462bool
463T_BOOL( in )
464  bool in
465 CODE:
466  RETVAL = in;
467 OUTPUT:
468  RETVAL
469
470bool
471T_BOOL_2( in )
472  bool in
473 CODE:
474    PERL_UNUSED_VAR(RETVAL);
475 OUTPUT:
476   in
477
478void
479T_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
489intUnsigned
490T_U_INT( uint )
491  intUnsigned uint
492 CODE:
493  RETVAL = uint;
494 OUTPUT:
495  RETVAL
496
497
498## T_SHORT
499
500short
501T_SHORT( s )
502  short s
503 CODE:
504  RETVAL = s;
505 OUTPUT:
506  RETVAL
507
508
509## T_U_SHORT
510
511U16
512T_U_SHORT( in )
513  U16 in
514 CODE:
515  RETVAL = in;
516 OUTPUT:
517  RETVAL
518
519
520## T_LONG
521
522intTLONG
523T_LONG( in )
524  intTLONG in
525 CODE:
526  RETVAL = in;
527 OUTPUT:
528  RETVAL
529
530## T_U_LONG
531
532U32
533T_U_LONG( in )
534  U32 in
535 CODE:
536  RETVAL = in;
537 OUTPUT:
538  RETVAL
539
540
541## T_CHAR
542
543char
544T_CHAR( in );
545  char in
546 CODE:
547  RETVAL = in;
548 OUTPUT:
549  RETVAL
550
551
552## T_U_CHAR
553
554unsigned char
555T_U_CHAR( in );
556  unsigned char in
557 CODE:
558  RETVAL = in;
559 OUTPUT:
560  RETVAL
561
562
563## T_FLOAT
564
565float
566T_FLOAT( in )
567  float in
568 CODE:
569  RETVAL = in;
570 OUTPUT:
571  RETVAL
572
573
574## T_NV
575
576NV
577T_NV( in )
578  NV in
579 CODE:
580  RETVAL = in;
581 OUTPUT:
582  RETVAL
583
584
585## T_DOUBLE
586
587double
588T_DOUBLE( in )
589  double in
590 CODE:
591  RETVAL = in;
592 OUTPUT:
593  RETVAL
594
595
596## T_PV
597
598char *
599T_PV( in )
600  char * in
601 CODE:
602  RETVAL = in;
603 OUTPUT:
604  RETVAL
605
606char *
607T_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
619void *
620T_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
630int
631T_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
645intRef *
646T_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
656intRef
657T_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
671intObj *
672T_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
682MODULE = XS::Typemap  PACKAGE = intObjPtr
683
684intObj
685T_PTROBJ_IN( ptr )
686  intObj * ptr
687 CODE:
688  RETVAL = *ptr;
689 OUTPUT:
690  RETVAL
691
692MODULE = 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
705intRefIv *
706T_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
716MODULE = XS::Typemap  PACKAGE = intRefIvPtr
717
718intRefIv
719T_REF_IV_PTR_IN( ptr )
720  intRefIv * ptr
721 CODE:
722  RETVAL = *ptr;
723 OUTPUT:
724  RETVAL
725
726
727MODULE = 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
743intOpq *
744T_OPAQUEPTR_IN( val )
745  intOpq val
746 CODE:
747  xst_anintopq = val;
748  RETVAL = &xst_anintopq;
749 OUTPUT:
750  RETVAL
751
752intOpq
753T_OPAQUEPTR_OUT( ptr )
754  intOpq * ptr
755 CODE:
756  RETVAL = *ptr;
757 OUTPUT:
758  RETVAL
759
760short
761T_OPAQUEPTR_OUT_short( ptr )
762  shortOPQ * ptr
763 CODE:
764  RETVAL = *ptr;
765 OUTPUT:
766  RETVAL
767
768# Test it with a structure
769astruct *
770T_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
784void
785T_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
795shortOPQ
796T_OPAQUE_IN( val )
797  int val
798 CODE:
799  RETVAL = (shortOPQ)val;
800 OUTPUT:
801  RETVAL
802
803IV
804T_OPAQUE_OUT( val )
805  shortOPQ val
806 CODE:
807  RETVAL = (IV)val;
808 OUTPUT:
809  RETVAL
810
811array(int,3)
812T_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
829void
830T_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
839anotherstruct *
840T_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
855void
856T_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
870anotherstruct **
871T_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
913intArray *
914T_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
932FILE *
933T_STDIO_open( file )
934  const char * file
935 CODE:
936  RETVAL = xsfopen( file );
937 OUTPUT:
938  RETVAL
939
940void
941T_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
949SysRet
950T_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
965int
966T_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
977PerlIO *
978T_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
987inputfh
988T_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
997outputfh
998T_OUT(in)
999  outputfh in;
1000 CODE:
1001  RETVAL = in; /* silly test but better than nothing */
1002 OUTPUT: RETVAL
1003
1004