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" 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 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
 918 SysRet
 919 T_STDIO_close( f )
 920   PerlIO * f
 921  PREINIT:
 922   FILE * stream;
 923  CODE:
 924   /* Get the FILE* */
 925   stream = PerlIO_findFILE( f );
 926   /* Release the FILE* from the PerlIO system so that we do
 927      not close the file twice */
 928   PerlIO_releaseFILE(f,stream);
 929   /* Must release the file before closing it */
 930   RETVAL = xsfclose( stream );
 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
 944 ## T_INOUT
 945
 946 PerlIO *
 947 T_INOUT(in)
 948   PerlIO *in;
 949  CODE:
 950   RETVAL = in; /* silly test but better than nothing */
 951  OUTPUT: RETVAL
 952
 953
 954 ## T_IN
 955
 956 inputfh
 957 T_IN(in)
 958   inputfh in;
 959  CODE:
 960   RETVAL = in; /* silly test but better than nothing */
 961  OUTPUT: RETVAL
 962
 963
 964 ## T_OUT
 965
 966 outputfh
 967 T_OUT(in)
 968   outputfh in;
 969  CODE:
 970   RETVAL = in; /* silly test but better than nothing */
 971  OUTPUT: RETVAL
 972