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