[perl5.git] / ext / XS-Typemap / Typemap.xs

/*
   XS code to test the typemap entries

   Copyright (C) 2001 Tim Jenness.
   All Rights Reserved

*/

#define PERL_NO_GET_CONTEXT

#include "EXTERN.h"   /* std perl include */
#include "perl.h"     /* std perl include */
#include "XSUB.h"     /* XSUB include */

/* Prototypes for external functions */
FILE * xsfopen( const char * );
int xsfclose( FILE * );
int xsfprintf( FILE *, const char *);

/* Type definitions required for the XS typemaps */
typedef SV * SVREF; /* T_SVREF */
typedef int SysRet; /* T_SYSRET */
typedef int Int;    /* T_INT */
typedef int intRef; /* T_PTRREF */
typedef int intObj; /* T_PTROBJ */
typedef int intRefIv; /* T_REF_IV_PTR */
typedef int intArray; /* T_ARRAY */
typedef int intTINT; /* T_INT */
typedef int intTLONG; /* T_LONG */
typedef short shortOPQ;   /* T_OPAQUE */
typedef int intOpq;   /* T_OPAQUEPTR */
typedef unsigned intUnsigned; /* T_U_INT */
typedef PerlIO * inputfh; /* T_IN */
typedef PerlIO * outputfh; /* T_OUT */

/* A structure to test T_OPAQUEPTR and T_PACKED */
struct t_opaqueptr {
  int a;
  int b;
  double c;
};

typedef struct t_opaqueptr astruct;
typedef struct t_opaqueptr anotherstruct;

/* Some static memory for the tests */
static I32 xst_anint;
static intRef xst_anintref;
static intObj xst_anintobj;
static intRefIv xst_anintrefiv;
static intOpq xst_anintopq;

/* A different type to refer to for testing the different
 * AV*, HV*, etc typemaps */
typedef AV AV_FIXED;
typedef HV HV_FIXED;
typedef CV CV_FIXED;
typedef SVREF SVREF_FIXED;

/* Helper functions */

/* T_ARRAY - allocate some memory */
intArray * intArrayPtr( int nelem ) {
    intArray * array;
    Newx(array, nelem, intArray);
    return array;
}

/* test T_PACKED */
STATIC void
XS_pack_anotherstructPtr(SV *out, anotherstruct *in)
{
    dTHX;
    HV *hash = newHV();
    if (NULL == hv_stores(hash, "a", newSViv(in->a)))
      croak("Failed to store data in hash");
    if (NULL == hv_stores(hash, "b", newSViv(in->b)))
      croak("Failed to store data in hash");
    if (NULL == hv_stores(hash, "c", newSVnv(in->c)))
      croak("Failed to store data in hash");
    sv_setsv(out, sv_2mortal(newRV_noinc((SV*)hash)));
}

STATIC anotherstruct *
XS_unpack_anotherstructPtr(SV *in)
{
    dTHX; /* rats, this is expensive */
    /* this is similar to T_HVREF since we chose to use a hash */
    HV *inhash;
    SV **elem;
    anotherstruct *out;
    SV *const tmp = in;
    SvGETMAGIC(tmp);
    if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVHV)
       inhash = (HV*)SvRV(tmp);
    else
        Perl_croak(aTHX_ "Argument is not a HASH reference");

    /* FIXME dunno if supposed to use perl mallocs here */
    Newxz(out, 1, anotherstruct);

    elem = hv_fetchs(inhash, "a", 0);
    if (elem == NULL)
      Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
    out->a = SvIV(*elem);

    elem = hv_fetchs(inhash, "b", 0);
    if (elem == NULL)
      Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
    out->b = SvIV(*elem);

    elem = hv_fetchs(inhash, "c", 0);
    if (elem == NULL)
      Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
    out->c = SvNV(*elem);

    return out;
}

/* test T_PACKEDARRAY */
STATIC void
XS_pack_anotherstructPtrPtr(SV *out, anotherstruct **in, UV cnt)
{
    dTHX;
    UV i;
    AV *ary = newAV();
    for (i = 0; i < cnt; ++i) {
        HV *hash = newHV();
        if (NULL == hv_stores(hash, "a", newSViv(in[i]->a)))
          croak("Failed to store data in hash");
        if (NULL == hv_stores(hash, "b", newSViv(in[i]->b)))
          croak("Failed to store data in hash");
        if (NULL == hv_stores(hash, "c", newSVnv(in[i]->c)))
          croak("Failed to store data in hash");
        av_push(ary, newRV_noinc((SV*)hash));
    }
    sv_setsv(out, sv_2mortal(newRV_noinc((SV*)ary)));
}

STATIC anotherstruct **
XS_unpack_anotherstructPtrPtr(SV *in)
{
    dTHX; /* rats, this is expensive */
    /* this is similar to T_HVREF since we chose to use a hash */
    HV *inhash;
    AV *inary;
    SV **elem;
    anotherstruct **out;
    UV nitems, i;
    SV *tmp;

    /* safely deref the input array ref */
    tmp = in;
    SvGETMAGIC(tmp);
    if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVAV)
        inary = (AV*)SvRV(tmp);
    else
        Perl_croak(aTHX_ "Argument is not an ARRAY reference");

    nitems = av_tindex(inary) + 1;

    /* FIXME dunno if supposed to use perl mallocs here */
    /* N+1 elements so we know the last one is NULL */
    Newxz(out, nitems+1, anotherstruct*);

    /* WARNING: in real code, we'd have to Safefree() on exception, but
     *          since we're testing perl, if we croak() here, stuff is
     *          rotten anyway! */
    for (i = 0; i < nitems; ++i) {
        Newxz(out[i], 1, anotherstruct);
        elem = av_fetch(inary, i, 0);
        if (elem == NULL)
            Perl_croak(aTHX_ "Shouldn't happen: av_fetch returns NULL");
        tmp = *elem;
        SvGETMAGIC(tmp);
        if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVHV)
            inhash = (HV*)SvRV(tmp);
        else
            Perl_croak(aTHX_ "Array element %"UVuf" is not a HASH reference", i);

        elem = hv_fetchs(inhash, "a", 0);
        if (elem == NULL)
            Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
        out[i]->a = SvIV(*elem);

        elem = hv_fetchs(inhash, "b", 0);
        if (elem == NULL)
            Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
        out[i]->b = SvIV(*elem);

        elem = hv_fetchs(inhash, "c", 0);
        if (elem == NULL)
            Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL");
        out[i]->c = SvNV(*elem);
    }

    return out;
}

/* no special meaning as far as typemaps are concerned,
 * just for convenience */
void
XS_release_anotherstructPtrPtr(anotherstruct **in)
{
    unsigned int i = 0;
    while (in[i] != NULL)
        Safefree(in[i++]);
    Safefree(in);
}


MODULE = XS::Typemap   PACKAGE = XS::Typemap

PROTOTYPES: DISABLE

TYPEMAP: <<END_OF_TYPEMAP

# Typemap file for typemap testing
# includes bonus typemap entries
# Mainly so that all the standard typemaps can be exercised even when
# there is not a corresponding type explicitly identified in the standard
# typemap

svtype           T_ENUM
intRef *         T_PTRREF
intRef           T_IV
intObj *         T_PTROBJ
intObj           T_IV
intRefIv *       T_REF_IV_PTR
intRefIv         T_IV
intArray *       T_ARRAY
intOpq           T_IV
intOpq   *       T_OPAQUEPTR
intUnsigned      T_U_INT
intTINT          T_INT
intTLONG         T_LONG
shortOPQ         T_OPAQUE
shortOPQ *       T_OPAQUEPTR
astruct *        T_OPAQUEPTR
anotherstruct *  T_PACKED
anotherstruct ** T_PACKEDARRAY
AV_FIXED *	 T_AVREF_REFCOUNT_FIXED
HV_FIXED *	 T_HVREF_REFCOUNT_FIXED
CV_FIXED *	 T_CVREF_REFCOUNT_FIXED
SVREF_FIXED	 T_SVREF_REFCOUNT_FIXED
inputfh          T_IN
outputfh         T_OUT

END_OF_TYPEMAP


## T_SV

SV *
T_SV( sv )
  SV * sv
 CODE:
  /* create a new sv for return that is a copy of the input
     do not simply copy the pointer since the SV will be marked
     mortal by the INPUT typemap when it is pushed back onto the stack */
  RETVAL = sv_mortalcopy( sv );
  /* increment the refcount since the default INPUT typemap mortalizes
     by default and we don't want to decrement the ref count twice
     by mistake */
  SvREFCNT_inc(RETVAL);
 OUTPUT:
  RETVAL


## T_SVREF

SVREF
T_SVREF( svref )
  SVREF svref
 CODE:
  RETVAL = svref;
 OUTPUT:
  RETVAL


## T_SVREF_FIXED

SVREF_FIXED
T_SVREF_REFCOUNT_FIXED( svref )
  SVREF_FIXED svref
 CODE:
  SvREFCNT_inc(svref);
  RETVAL = svref;
 OUTPUT:
  RETVAL


## T_AVREF

AV *
T_AVREF( av )
  AV * av
 CODE:
  RETVAL = av;
 OUTPUT:
  RETVAL


## T_AVREF_REFCOUNT_FIXED

AV_FIXED*
T_AVREF_REFCOUNT_FIXED( av )
  AV_FIXED * av
 CODE:
  SvREFCNT_inc(av);
  RETVAL = av;
 OUTPUT:
  RETVAL


## T_HVREF

HV *
T_HVREF( hv )
  HV * hv
 CODE:
  RETVAL = hv;
 OUTPUT:
  RETVAL


## T_HVREF_REFCOUNT_FIXED

HV_FIXED*
T_HVREF_REFCOUNT_FIXED( hv )
  HV_FIXED * hv
 CODE:
  SvREFCNT_inc(hv);
  RETVAL = hv;
 OUTPUT:
  RETVAL


## T_CVREF

CV *
T_CVREF( cv )
  CV * cv
 CODE:
  RETVAL = cv;
 OUTPUT:
  RETVAL


## T_CVREF_REFCOUNT_FIXED

CV_FIXED *
T_CVREF_REFCOUNT_FIXED( cv )
  CV_FIXED * cv
 CODE:
  SvREFCNT_inc(cv);
  RETVAL = cv;
 OUTPUT:
  RETVAL


## T_SYSRET

# Test a successful return

SysRet
T_SYSRET_pass()
 CODE:
  RETVAL = 0;
 OUTPUT:
  RETVAL

# Test failure

SysRet
T_SYSRET_fail()
 CODE:
  RETVAL = -1;
 OUTPUT:
  RETVAL

## T_UV

unsigned int
T_UV( uv )
  unsigned int uv
 CODE:
  RETVAL = uv;
 OUTPUT:
  RETVAL


## T_IV

long
T_IV( iv )
  long iv
 CODE:
  RETVAL = iv;
 OUTPUT:
  RETVAL


## T_INT

intTINT
T_INT( i )
  intTINT i
 CODE:
  RETVAL = i;
 OUTPUT:
  RETVAL


## T_ENUM

# The test should return the value for SVt_PVHV.
# 11 at the present time but we can't not rely on this
# for testing purposes.

svtype
T_ENUM()
 CODE:
  RETVAL = SVt_PVHV;
 OUTPUT:
  RETVAL


## T_BOOL

bool
T_BOOL( in )
  bool in
 CODE:
  RETVAL = in;
 OUTPUT:
  RETVAL

bool
T_BOOL_2( in )
  bool in
 CODE:
    PERL_UNUSED_VAR(RETVAL);
 OUTPUT:
   in

void
T_BOOL_OUT( out, in )
  bool out
  bool in
 CODE:
 out = in;
 OUTPUT:
   out

## T_U_INT

intUnsigned
T_U_INT( uint )
  intUnsigned uint
 CODE:
  RETVAL = uint;
 OUTPUT:
  RETVAL


## T_SHORT

short
T_SHORT( s )
  short s
 CODE:
  RETVAL = s;
 OUTPUT:
  RETVAL


## T_U_SHORT

U16
T_U_SHORT( in )
  U16 in
 CODE:
  RETVAL = in;
 OUTPUT:
  RETVAL


## T_LONG

intTLONG
T_LONG( in )
  intTLONG in
 CODE:
  RETVAL = in;
 OUTPUT:
  RETVAL

## T_U_LONG

U32
T_U_LONG( in )
  U32 in
 CODE:
  RETVAL = in;
 OUTPUT:
  RETVAL


## T_CHAR

char
T_CHAR( in );
  char in
 CODE:
  RETVAL = in;
 OUTPUT:
  RETVAL


## T_U_CHAR

unsigned char
T_U_CHAR( in );
  unsigned char in
 CODE:
  RETVAL = in;
 OUTPUT:
  RETVAL


## T_FLOAT

float
T_FLOAT( in )
  float in
 CODE:
  RETVAL = in;
 OUTPUT:
  RETVAL


## T_NV

NV
T_NV( in )
  NV in
 CODE:
  RETVAL = in;
 OUTPUT:
  RETVAL


## T_DOUBLE

double
T_DOUBLE( in )
  double in
 CODE:
  RETVAL = in;
 OUTPUT:
  RETVAL


## T_PV

char *
T_PV( in )
  char * in
 CODE:
  RETVAL = in;
 OUTPUT:
  RETVAL

char *
T_PV_null()
 CODE:
  RETVAL = NULL;
 OUTPUT:
  RETVAL


## T_PTR

# Pass in a value. Store the value in some static memory and
# then return the pointer

void *
T_PTR_OUT( in )
  int in;
 CODE:
  xst_anint = in;
  RETVAL = &xst_anint;
 OUTPUT:
  RETVAL

# pass in the pointer and return the value

int
T_PTR_IN( ptr )
  void * ptr
 CODE:
  RETVAL = *(int *)ptr;
 OUTPUT:
  RETVAL


## T_PTRREF

# Similar test to T_PTR
# Pass in a value. Store the value in some static memory and
# then return the pointer

intRef *
T_PTRREF_OUT( in )
  intRef in;
 CODE:
  xst_anintref = in;
  RETVAL = &xst_anintref;
 OUTPUT:
  RETVAL

# pass in the pointer and return the value

intRef
T_PTRREF_IN( ptr )
  intRef * ptr
 CODE:
  RETVAL = *ptr;
 OUTPUT:
  RETVAL


## T_PTROBJ

# Similar test to T_PTRREF
# Pass in a value. Store the value in some static memory and
# then return the pointer

intObj *
T_PTROBJ_OUT( in )
  intObj in;
 CODE:
  xst_anintobj = in;
  RETVAL = &xst_anintobj;
 OUTPUT:
  RETVAL

# pass in the pointer and return the value

MODULE = XS::Typemap  PACKAGE = intObjPtr

intObj
T_PTROBJ_IN( ptr )
  intObj * ptr
 CODE:
  RETVAL = *ptr;
 OUTPUT:
  RETVAL

MODULE = XS::Typemap PACKAGE = XS::Typemap


## T_REF_IV_REF
## NOT YET


## T_REF_IV_PTR

# Similar test to T_PTROBJ
# Pass in a value. Store the value in some static memory and
# then return the pointer

intRefIv *
T_REF_IV_PTR_OUT( in )
  intRefIv in;
 CODE:
  xst_anintrefiv = in;
  RETVAL = &xst_anintrefiv;
 OUTPUT:
  RETVAL

# pass in the pointer and return the value

MODULE = XS::Typemap  PACKAGE = intRefIvPtr

intRefIv
T_REF_IV_PTR_IN( ptr )
  intRefIv * ptr
 CODE:
  RETVAL = *ptr;
 OUTPUT:
  RETVAL


MODULE = XS::Typemap PACKAGE = XS::Typemap

## T_PTRDESC
## NOT YET


## T_REFREF
## NOT YET


## T_REFOBJ
## NOT YET


## T_OPAQUEPTR

intOpq *
T_OPAQUEPTR_IN( val )
  intOpq val
 CODE:
  xst_anintopq = val;
  RETVAL = &xst_anintopq;
 OUTPUT:
  RETVAL

intOpq
T_OPAQUEPTR_OUT( ptr )
  intOpq * ptr
 CODE:
  RETVAL = *ptr;
 OUTPUT:
  RETVAL

short
T_OPAQUEPTR_OUT_short( ptr )
  shortOPQ * ptr
 CODE:
  RETVAL = *ptr;
 OUTPUT:
  RETVAL

# Test it with a structure
astruct *
T_OPAQUEPTR_IN_struct( a,b,c )
  int a
  int b
  double c
 PREINIT:
  struct t_opaqueptr test;
 CODE:
  test.a = a;
  test.b = b;
  test.c = c;
  RETVAL = &test;
 OUTPUT:
  RETVAL

void
T_OPAQUEPTR_OUT_struct( test )
  astruct * test
 PPCODE:
  XPUSHs(sv_2mortal(newSViv(test->a)));
  XPUSHs(sv_2mortal(newSViv(test->b)));
  XPUSHs(sv_2mortal(newSVnv(test->c)));


## T_OPAQUE

shortOPQ
T_OPAQUE_IN( val )
  int val
 CODE:
  RETVAL = (shortOPQ)val;
 OUTPUT:
  RETVAL

IV
T_OPAQUE_OUT( val )
  shortOPQ val
 CODE:
  RETVAL = (IV)val;
 OUTPUT:
  RETVAL

array(int,3)
T_OPAQUE_array( a,b,c)
  int a
  int b
  int c
 PREINIT:
  int array[3];
 CODE:
  array[0] = a;
  array[1] = b;
  array[2] = c;
  RETVAL = array;
 OUTPUT:
  RETVAL


## T_PACKED

void
T_PACKED_in(in)
  anotherstruct *in;
 PPCODE:
  mXPUSHi(in->a);
  mXPUSHi(in->b);
  mXPUSHn(in->c);
  Safefree(in);
  XSRETURN(3);

anotherstruct *
T_PACKED_out(a, b ,c)
  int a;
  int b;
  double c;
 CODE:
  Newxz(RETVAL, 1, anotherstruct);
  RETVAL->a = a;
  RETVAL->b = b;
  RETVAL->c = c;
 OUTPUT: RETVAL
 CLEANUP:
  Safefree(RETVAL);

## T_PACKEDARRAY

void
T_PACKEDARRAY_in(in)
  anotherstruct **in;
 PREINIT:
  unsigned int i = 0;
 PPCODE:
  while (in[i] != NULL) {
    mXPUSHi(in[i]->a);
    mXPUSHi(in[i]->b);
    mXPUSHn(in[i]->c);
    ++i;
  }
  XS_release_anotherstructPtrPtr(in);
  XSRETURN(3*i);

anotherstruct **
T_PACKEDARRAY_out(...)
 PREINIT:
  unsigned int i, nstructs, count_anotherstructPtrPtr;
 CODE:
  if ((items % 3) != 0)
    croak("Need nitems divisible by 3");
  nstructs = (unsigned int)(items / 3);
  count_anotherstructPtrPtr = nstructs;
  Newxz(RETVAL, nstructs+1, anotherstruct *);
  for (i = 0; i < nstructs; ++i) {
    Newxz(RETVAL[i], 1, anotherstruct);
    RETVAL[i]->a = SvIV(ST(3*i));
    RETVAL[i]->b = SvIV(ST(3*i+1));
    RETVAL[i]->c = SvNV(ST(3*i+2));
  }
 OUTPUT: RETVAL
 CLEANUP:
  XS_release_anotherstructPtrPtr(RETVAL);


## T_DATAUNIT
## NOT YET


## T_CALLBACK
## NOT YET


## T_ARRAY

# Test passes in an integer array and returns it along with
# the number of elements
# Pass in a dummy value to test offsetting

# Problem is that xsubpp does XSRETURN(1) because we arent
# using PPCODE. This means that only the first element
# is returned. KLUGE this by using CLEANUP to return before the
# end.
# Note: I read this as: The "T_ARRAY" typemap is really rather broken,
#       at least for OUTPUT. That is apart from the general design
#       weaknesses. --Steffen

intArray *
T_ARRAY( dummy, array, ... )
  int dummy = 0;
  intArray * array
 PREINIT:
  U32 size_RETVAL;
 CODE:
  dummy += 0; /* Fix -Wall */
  size_RETVAL = ix_array;
  RETVAL = array;
 OUTPUT:
  RETVAL
 CLEANUP:
  Safefree(array);
  XSRETURN(size_RETVAL);


## T_STDIO

FILE *
T_STDIO_open( file )
  const char * file
 CODE:
  RETVAL = xsfopen( file );
 OUTPUT:
  RETVAL

void
T_STDIO_open_ret_in_arg( file, io)
  const char * file
  FILE * io = NO_INIT
 CODE:
  io = xsfopen( file );
 OUTPUT:
  io

SysRet
T_STDIO_close( f )
  PerlIO * f
 PREINIT:
  FILE * stream;
 CODE:
  /* Get the FILE* */
  stream = PerlIO_findFILE( f );  
  /* Release the FILE* from the PerlIO system so that we do
     not close the file twice */
  PerlIO_releaseFILE(f,stream);
  /* Must release the file before closing it */
  RETVAL = xsfclose( stream );
 OUTPUT:
  RETVAL

int
T_STDIO_print( stream, string )
  FILE * stream
  const char * string
 CODE:
  RETVAL = xsfprintf( stream, string );
 OUTPUT:
  RETVAL


## T_INOUT

PerlIO *
T_INOUT(in)
  PerlIO *in;
 CODE:
  RETVAL = in; /* silly test but better than nothing */
 OUTPUT: RETVAL


## T_IN

inputfh
T_IN(in)
  inputfh in;
 CODE:
  RETVAL = in; /* silly test but better than nothing */
 OUTPUT: RETVAL


## T_OUT

outputfh
T_OUT(in)
  outputfh in;
 CODE:
  RETVAL = in; /* silly test but better than nothing */
 OUTPUT: RETVAL
Commit	Line	Data
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
3c53ff3f NC	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 */
	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 */
604db645 S	28	typedef int intTINT; /* T_INT */
604db645 S	29	typedef int intTLONG; /* T_LONG */
ea035a69 JH	30	typedef short shortOPQ; /* T_OPAQUE */
ea035a69 JH	31	typedef int intOpq; /* T_OPAQUEPTR */
604db645	32	typedef unsigned intUnsigned; /* T_U_INT */
08d5d1db CB	33	typedef PerlIO * inputfh; /* T_IN */
08d5d1db CB	34	typedef PerlIO * outputfh; /* T_OUT */
ea035a69	35
2465d83f	36	/* A structure to test T_OPAQUEPTR and T_PACKED */
5abff6f9 TJ	37	struct t_opaqueptr {
	38	int a;
	39	int b;
	40	double c;
	41	};
	42
	43	typedef struct t_opaqueptr astruct;
2465d83f	44	typedef struct t_opaqueptr anotherstruct;
5abff6f9	45
ea035a69	46	/* Some static memory for the tests */
052980ee TJ	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;
ea035a69	52
b64f48ff	53	/* A different type to refer to for testing the different
1d2615b4	54	* AV, HV, etc typemaps */
b64f48ff S	55	typedef AV AV_FIXED;
b64f48ff S	56	typedef HV HV_FIXED;
1d2615b4 S	57	typedef CV CV_FIXED;
1d2615b4 S	58	typedef SVREF SVREF_FIXED;
b64f48ff	59
ea035a69 JH	60	/* Helper functions */
	61
	62	/* T_ARRAY - allocate some memory */
	63	intArray * 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	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	}
2465d83f	83
ea0d3d8e	84	STATIC anotherstruct *
2465d83f S	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
ea0d3d8e	120	/* test T_PACKEDARRAY */
62e90759 S	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	}
ea0d3d8e S	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)
d28d0f86	156	inary = (AV*)SvRV(tmp);
ea0d3d8e S	157	else
	158	Perl_croak(aTHX_ "Argument is not an ARRAY reference");
	159
b9f2b683	160	nitems = av_tindex(inary) + 1;
ea0d3d8e S	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 */
	202	void
	203	XS_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	}
ea0d3d8e S	210
ea035a69 JH	211
	212	MODULE = XS::Typemap PACKAGE = XS::Typemap
	213
	214	PROTOTYPES: DISABLE
	215
09186e9e S	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
ea0d3d8e S	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
60a929b5 CB	246	inputfh T_IN
60a929b5 CB	247	outputfh T_OUT
09186e9e S	248
	249	END_OF_TYPEMAP
	250
ea035a69	251
0eb29def	252	## T_SV
ea035a69 JH	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
1d2615b4	269
0eb29def	270	## T_SVREF
ea035a69 JH	271
	272	SVREF
	273	T_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
	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
b64f48ff	292
0eb29def	293	## T_AVREF
ea035a69 JH	294
	295	AV *
	296	T_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
	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
b64f48ff	315
0eb29def	316	## T_HVREF
ea035a69 JH	317
	318	HV *
	319	T_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
	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
0eb29def	339	## T_CVREF
ea035a69 JH	340
	341	CV *
	342	T_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
	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
ea035a69	360
ea035a69	361
0eb29def	362	## T_SYSRET
ea035a69 JH	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
0eb29def	382	## T_UV
ea035a69 JH	383
	384	unsigned int
	385	T_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
	395	long
	396	T_IV( iv )
	397	long iv
	398	CODE:
	399	RETVAL = iv;
	400	OUTPUT:
	401	RETVAL
	402
ea035a69	403
0eb29def	404	## T_INT
604db645 S	405
	406	intTINT
	407	T_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
	421	svtype
	422	T_ENUM()
	423	CODE:
	424	RETVAL = SVt_PVHV;
	425	OUTPUT:
	426	RETVAL
	427
ea035a69	428
0eb29def	429	## T_BOOL
ea035a69 JH	430
	431	bool
	432	T_BOOL( in )
	433	bool in
	434	CODE:
	435	RETVAL = in;
	436	OUTPUT:
	437	RETVAL
	438
742aa4c0 S	439	bool
	440	T_BOOL_2( in )
	441	bool in
	442	CODE:
e5411d1e	443	PERL_UNUSED_VAR(RETVAL);
742aa4c0 S	444	OUTPUT:
	445	in
	446
b0bbf760 DD	447	void
	448	T_BOOL_OUT( out, in )
	449	bool out
	450	bool in
	451	CODE:
	452	out = in;
	453	OUTPUT:
	454	out
ea035a69	455
0eb29def	456	## T_U_INT
604db645 S	457
	458	intUnsigned
	459	T_U_INT( uint )
	460	intUnsigned uint
	461	CODE:
	462	RETVAL = uint;
	463	OUTPUT:
	464	RETVAL
	465
ea035a69	466
0eb29def	467	## T_SHORT
604db645 S	468
	469	short
	470	T_SHORT( s )
	471	short s
	472	CODE:
	473	RETVAL = s;
	474	OUTPUT:
	475	RETVAL
	476
ea035a69	477
0eb29def	478	## T_U_SHORT
ea035a69 JH	479
	480	U16
	481	T_U_SHORT( in )
	482	U16 in
	483	CODE:
	484	RETVAL = in;
	485	OUTPUT:
	486	RETVAL
	487
	488
0eb29def	489	## T_LONG
604db645 S	490
	491	intTLONG
	492	T_LONG( in )
	493	intTLONG in
	494	CODE:
	495	RETVAL = in;
	496	OUTPUT:
	497	RETVAL
	498
0eb29def	499	## T_U_LONG
ea035a69 JH	500
	501	U32
	502	T_U_LONG( in )
	503	U32 in
	504	CODE:
	505	RETVAL = in;
	506	OUTPUT:
	507	RETVAL
	508
ea035a69	509
0eb29def	510	## T_CHAR
ea035a69 JH	511
	512	char
	513	T_CHAR( in );
	514	char in
	515	CODE:
	516	RETVAL = in;
	517	OUTPUT:
	518	RETVAL
	519
	520
0eb29def	521	## T_U_CHAR
ea035a69 JH	522
	523	unsigned char
	524	T_U_CHAR( in );
	525	unsigned char in
	526	CODE:
	527	RETVAL = in;
	528	OUTPUT:
	529	RETVAL
	530
	531
0eb29def	532	## T_FLOAT
ea035a69 JH	533
	534	float
	535	T_FLOAT( in )
	536	float in
	537	CODE:
	538	RETVAL = in;
	539	OUTPUT:
	540	RETVAL
	541
ea035a69	542
0eb29def	543	## T_NV
ea035a69 JH	544
	545	NV
	546	T_NV( in )
	547	NV in
	548	CODE:
	549	RETVAL = in;
	550	OUTPUT:
	551	RETVAL
	552
ea035a69	553
0eb29def	554	## T_DOUBLE
ea035a69 JH	555
	556	double
	557	T_DOUBLE( in )
	558	double in
	559	CODE:
	560	RETVAL = in;
	561	OUTPUT:
	562	RETVAL
	563
ea035a69	564
0eb29def	565	## T_PV
ea035a69 JH	566
	567	char *
	568	T_PV( in )
	569	char * in
	570	CODE:
	571	RETVAL = in;
	572	OUTPUT:
	573	RETVAL
	574
4f62cd62 FC	575	char *
	576	T_PV_null()
	577	CODE:
	578	RETVAL = NULL;
	579	OUTPUT:
	580	RETVAL
	581
ea035a69	582
0eb29def	583	## T_PTR
ea035a69 JH	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:
052980ee TJ	592	xst_anint = in;
052980ee TJ	593	RETVAL = &xst_anint;
ea035a69 JH	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
ea035a69	607
0eb29def	608	## T_PTRREF
ea035a69 JH	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:
052980ee TJ	618	xst_anintref = in;
052980ee TJ	619	RETVAL = &xst_anintref;
ea035a69 JH	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
0eb29def	634	## T_PTROBJ
ea035a69 JH	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:
052980ee TJ	644	xst_anintobj = in;
052980ee TJ	645	RETVAL = &xst_anintobj;
ea035a69 JH	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
ea035a69	663
0eb29def S	664	## T_REF_IV_REF
0eb29def S	665	## NOT YET
ea035a69	666
ea035a69	667
0eb29def	668	## T_REF_IV_PTR
ea035a69 JH	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:
052980ee TJ	678	xst_anintrefiv = in;
052980ee TJ	679	RETVAL = &xst_anintrefiv;
ea035a69 JH	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
0eb29def S	698	## T_PTRDESC
0eb29def S	699	## NOT YET
ea035a69	700
ea035a69	701
0eb29def S	702	## T_REFREF
0eb29def S	703	## NOT YET
ea035a69	704
ea035a69	705
0eb29def S	706	## T_REFOBJ
0eb29def S	707	## NOT YET
ea035a69	708
5abff6f9	709
0eb29def	710	## T_OPAQUEPTR
ea035a69 JH	711
	712	intOpq *
	713	T_OPAQUEPTR_IN( val )
	714	intOpq val
	715	CODE:
052980ee TJ	716	xst_anintopq = val;
052980ee TJ	717	RETVAL = &xst_anintopq;
ea035a69 JH	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
aa921f48 TJ	729	short
	730	T_OPAQUEPTR_OUT_short( ptr )
	731	shortOPQ * ptr
	732	CODE:
	733	RETVAL = *ptr;
	734	OUTPUT:
	735	RETVAL
	736
5abff6f9 TJ	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
0eb29def	762	## T_OPAQUE
ea035a69 JH	763
	764	shortOPQ
	765	T_OPAQUE_IN( val )
	766	int val
	767	CODE:
	768	RETVAL = (shortOPQ)val;
	769	OUTPUT:
	770	RETVAL
	771
5abff6f9 TJ	772	IV
	773	T_OPAQUE_OUT( val )
	774	shortOPQ val
	775	CODE:
	776	RETVAL = (IV)val;
	777	OUTPUT:
	778	RETVAL
	779
ea035a69 JH	780	array(int,3)
	781	T_OPAQUE_array( a,b,c)
	782	int a
	783	int b
	784	int c
	785	PREINIT:
3d5d53b8	786	int array[3];
ea035a69 JH	787	CODE:
	788	array[0] = a;
	789	array[1] = b;
	790	array[2] = c;
	791	RETVAL = array;
	792	OUTPUT:
	793	RETVAL
	794
	795
0eb29def	796	## T_PACKED
2465d83f S	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
0eb29def	822	## T_PACKEDARRAY
ea0d3d8e S	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
ea035a69	859
0eb29def S	860	## T_DATAUNIT
0eb29def S	861	## NOT YET
ea035a69	862
ea035a69	863
0eb29def S	864	## T_CALLBACK
0eb29def S	865	## NOT YET
ea035a69	866
ea035a69	867
0eb29def	868	## T_ARRAY
ea035a69 JH	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.
ac23f157 S	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
ea035a69 JH	881
	882	intArray *
	883	T_ARRAY( dummy, array, ... )
4d0439ce	884	int dummy = 0;
ea035a69 JH	885	intArray * array
	886	PREINIT:
	887	U32 size_RETVAL;
	888	CODE:
8876ff82	889	dummy += 0; /* Fix -Wall */
ea035a69 JH	890	size_RETVAL = ix_array;
	891	RETVAL = array;
	892	OUTPUT:
	893	RETVAL
	894	CLEANUP:
	895	Safefree(array);
	896	XSRETURN(size_RETVAL);
	897
	898
0eb29def	899	## T_STDIO
ea035a69 JH	900
	901	FILE *
	902	T_STDIO_open( file )
	903	const char * file
	904	CODE:
	905	RETVAL = xsfopen( file );
	906	OUTPUT:
	907	RETVAL
	908
c1b8440f DD	909	void
	910	T_STDIO_open_ret_in_arg( file, io)
	911	const char * file
	912	FILE * io = NO_INIT
	913	CODE:
	914	io = xsfopen( file );
	915	OUTPUT:
	916	io
	917
ea035a69	918	SysRet
c72de6e4 TJ	919	T_STDIO_close( f )
	920	PerlIO * f
	921	PREINIT:
	922	FILE * stream;
ea035a69	923	CODE:
c72de6e4 TJ	924	/* Get the FILE* */
c72de6e4 TJ	925	stream = PerlIO_findFILE( f );
c72de6e4 TJ	926	/* Release the FILE* from the PerlIO system so that we do
	927	not close the file twice */
	928	PerlIO_releaseFILE(f,stream);
6b54a403 NC	929	/* Must release the file before closing it */
6b54a403 NC	930	RETVAL = xsfclose( stream );
ea035a69 JH	931	OUTPUT:
	932	RETVAL
	933
	934	int
	935	T_STDIO_print( stream, string )
	936	FILE * stream
	937	const char * string
	938	CODE:
	939	RETVAL = xsfprintf( stream, string );
	940	OUTPUT:
	941	RETVAL
	942
	943
0eb29def	944	## T_INOUT
0a442273	945
60a929b5 CB	946	PerlIO *
	947	T_INOUT(in)
	948	PerlIO *in;
	949	CODE:
	950	RETVAL = in; /* silly test but better than nothing */
	951	OUTPUT: RETVAL
0a442273	952
21b5216d	953
0eb29def	954	## T_IN
21b5216d	955
60a929b5 CB	956	inputfh
	957	T_IN(in)
	958	inputfh in;
	959	CODE:
	960	RETVAL = in; /* silly test but better than nothing */
	961	OUTPUT: RETVAL
21b5216d	962
ea035a69	963
0eb29def	964	## T_OUT
ea035a69	965
60a929b5 CB	966	outputfh
	967	T_OUT(in)
	968	outputfh in;
	969	CODE:
	970	RETVAL = in; /* silly test but better than nothing */
	971	OUTPUT: RETVAL
21b5216d	972