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_len(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  OUTPUT:
 444    in
 445
 446 void
 447 T_BOOL_OUT( out, in )
 448   bool out
 449   bool in
 450  CODE:
 451  out = in;
 452  OUTPUT:
 453    out
 454
 455 ## T_U_INT
 456
 457 intUnsigned
 458 T_U_INT( uint )
 459   intUnsigned uint
 460  CODE:
 461   RETVAL = uint;
 462  OUTPUT:
 463   RETVAL
 464
 465
 466 ## T_SHORT
 467
 468 short
 469 T_SHORT( s )
 470   short s
 471  CODE:
 472   RETVAL = s;
 473  OUTPUT:
 474   RETVAL
 475
 476
 477 ## T_U_SHORT
 478
 479 U16
 480 T_U_SHORT( in )
 481   U16 in
 482  CODE:
 483   RETVAL = in;
 484  OUTPUT:
 485   RETVAL
 486
 487
 488 ## T_LONG
 489
 490 intTLONG
 491 T_LONG( in )
 492   intTLONG in
 493  CODE:
 494   RETVAL = in;
 495  OUTPUT:
 496   RETVAL
 497
 498 ## T_U_LONG
 499
 500 U32
 501 T_U_LONG( in )
 502   U32 in
 503  CODE:
 504   RETVAL = in;
 505  OUTPUT:
 506   RETVAL
 507
 508
 509 ## T_CHAR
 510
 511 char
 512 T_CHAR( in );
 513   char in
 514  CODE:
 515   RETVAL = in;
 516  OUTPUT:
 517   RETVAL
 518
 519
 520 ## T_U_CHAR
 521
 522 unsigned char
 523 T_U_CHAR( in );
 524   unsigned char in
 525  CODE:
 526   RETVAL = in;
 527  OUTPUT:
 528   RETVAL
 529
 530
 531 ## T_FLOAT
 532
 533 float
 534 T_FLOAT( in )
 535   float in
 536  CODE:
 537   RETVAL = in;
 538  OUTPUT:
 539   RETVAL
 540
 541
 542 ## T_NV
 543
 544 NV
 545 T_NV( in )
 546   NV in
 547  CODE:
 548   RETVAL = in;
 549  OUTPUT:
 550   RETVAL
 551
 552
 553 ## T_DOUBLE
 554
 555 double
 556 T_DOUBLE( in )
 557   double in
 558  CODE:
 559   RETVAL = in;
 560  OUTPUT:
 561   RETVAL
 562
 563
 564 ## T_PV
 565
 566 char *
 567 T_PV( in )
 568   char * in
 569  CODE:
 570   RETVAL = in;
 571  OUTPUT:
 572   RETVAL
 573
 574
 575 ## T_PTR
 576
 577 # Pass in a value. Store the value in some static memory and
 578 # then return the pointer
 579
 580 void *
 581 T_PTR_OUT( in )
 582   int in;
 583  CODE:
 584   xst_anint = in;
 585   RETVAL = &xst_anint;
 586  OUTPUT:
 587   RETVAL
 588
 589 # pass in the pointer and return the value
 590
 591 int
 592 T_PTR_IN( ptr )
 593   void * ptr
 594  CODE:
 595   RETVAL = *(int *)ptr;
 596  OUTPUT:
 597   RETVAL
 598
 599
 600 ## T_PTRREF
 601
 602 # Similar test to T_PTR
 603 # Pass in a value. Store the value in some static memory and
 604 # then return the pointer
 605
 606 intRef *
 607 T_PTRREF_OUT( in )
 608   intRef in;
 609  CODE:
 610   xst_anintref = in;
 611   RETVAL = &xst_anintref;
 612  OUTPUT:
 613   RETVAL
 614
 615 # pass in the pointer and return the value
 616
 617 intRef
 618 T_PTRREF_IN( ptr )
 619   intRef * ptr
 620  CODE:
 621   RETVAL = *ptr;
 622  OUTPUT:
 623   RETVAL
 624
 625
 626 ## T_PTROBJ
 627
 628 # Similar test to T_PTRREF
 629 # Pass in a value. Store the value in some static memory and
 630 # then return the pointer
 631
 632 intObj *
 633 T_PTROBJ_OUT( in )
 634   intObj in;
 635  CODE:
 636   xst_anintobj = in;
 637   RETVAL = &xst_anintobj;
 638  OUTPUT:
 639   RETVAL
 640
 641 # pass in the pointer and return the value
 642
 643 MODULE = XS::Typemap  PACKAGE = intObjPtr
 644
 645 intObj
 646 T_PTROBJ_IN( ptr )
 647   intObj * ptr
 648  CODE:
 649   RETVAL = *ptr;
 650  OUTPUT:
 651   RETVAL
 652
 653 MODULE = XS::Typemap PACKAGE = XS::Typemap
 654
 655
 656 ## T_REF_IV_REF
 657 ## NOT YET
 658
 659
 660 ## T_REF_IV_PTR
 661
 662 # Similar test to T_PTROBJ
 663 # Pass in a value. Store the value in some static memory and
 664 # then return the pointer
 665
 666 intRefIv *
 667 T_REF_IV_PTR_OUT( in )
 668   intRefIv in;
 669  CODE:
 670   xst_anintrefiv = in;
 671   RETVAL = &xst_anintrefiv;
 672  OUTPUT:
 673   RETVAL
 674
 675 # pass in the pointer and return the value
 676
 677 MODULE = XS::Typemap  PACKAGE = intRefIvPtr
 678
 679 intRefIv
 680 T_REF_IV_PTR_IN( ptr )
 681   intRefIv * ptr
 682  CODE:
 683   RETVAL = *ptr;
 684  OUTPUT:
 685   RETVAL
 686
 687
 688 MODULE = XS::Typemap PACKAGE = XS::Typemap
 689
 690 ## T_PTRDESC
 691 ## NOT YET
 692
 693
 694 ## T_REFREF
 695 ## NOT YET
 696
 697
 698 ## T_REFOBJ
 699 ## NOT YET
 700
 701
 702 ## T_OPAQUEPTR
 703
 704 intOpq *
 705 T_OPAQUEPTR_IN( val )
 706   intOpq val
 707  CODE:
 708   xst_anintopq = val;
 709   RETVAL = &xst_anintopq;
 710  OUTPUT:
 711   RETVAL
 712
 713 intOpq
 714 T_OPAQUEPTR_OUT( ptr )
 715   intOpq * ptr
 716  CODE:
 717   RETVAL = *ptr;
 718  OUTPUT:
 719   RETVAL
 720
 721 short
 722 T_OPAQUEPTR_OUT_short( ptr )
 723   shortOPQ * ptr
 724  CODE:
 725   RETVAL = *ptr;
 726  OUTPUT:
 727   RETVAL
 728
 729 # Test it with a structure
 730 astruct *
 731 T_OPAQUEPTR_IN_struct( a,b,c )
 732   int a
 733   int b
 734   double c
 735  PREINIT:
 736   struct t_opaqueptr test;
 737  CODE:
 738   test.a = a;
 739   test.b = b;
 740   test.c = c;
 741   RETVAL = &test;
 742  OUTPUT:
 743   RETVAL
 744
 745 void
 746 T_OPAQUEPTR_OUT_struct( test )
 747   astruct * test
 748  PPCODE:
 749   XPUSHs(sv_2mortal(newSViv(test->a)));
 750   XPUSHs(sv_2mortal(newSViv(test->b)));
 751   XPUSHs(sv_2mortal(newSVnv(test->c)));
 752
 753
 754 ## T_OPAQUE
 755
 756 shortOPQ
 757 T_OPAQUE_IN( val )
 758   int val
 759  CODE:
 760   RETVAL = (shortOPQ)val;
 761  OUTPUT:
 762   RETVAL
 763
 764 IV
 765 T_OPAQUE_OUT( val )
 766   shortOPQ val
 767  CODE:
 768   RETVAL = (IV)val;
 769  OUTPUT:
 770   RETVAL
 771
 772 array(int,3)
 773 T_OPAQUE_array( a,b,c)
 774   int a
 775   int b
 776   int c
 777  PREINIT:
 778   int array[3];
 779  CODE:
 780   array[0] = a;
 781   array[1] = b;
 782   array[2] = c;
 783   RETVAL = array;
 784  OUTPUT:
 785   RETVAL
 786
 787
 788 ## T_PACKED
 789
 790 void
 791 T_PACKED_in(in)
 792   anotherstruct *in;
 793  PPCODE:
 794   mXPUSHi(in->a);
 795   mXPUSHi(in->b);
 796   mXPUSHn(in->c);
 797   Safefree(in);
 798   XSRETURN(3);
 799
 800 anotherstruct *
 801 T_PACKED_out(a, b ,c)
 802   int a;
 803   int b;
 804   double c;
 805  CODE:
 806   Newxz(RETVAL, 1, anotherstruct);
 807   RETVAL->a = a;
 808   RETVAL->b = b;
 809   RETVAL->c = c;
 810  OUTPUT: RETVAL
 811  CLEANUP:
 812   Safefree(RETVAL);
 813
 814 ## T_PACKEDARRAY
 815
 816 void
 817 T_PACKEDARRAY_in(in)
 818   anotherstruct **in;
 819  PREINIT:
 820   unsigned int i = 0;
 821  PPCODE:
 822   while (in[i] != NULL) {
 823     mXPUSHi(in[i]->a);
 824     mXPUSHi(in[i]->b);
 825     mXPUSHn(in[i]->c);
 826     ++i;
 827   }
 828   XS_release_anotherstructPtrPtr(in);
 829   XSRETURN(3*i);
 830
 831 anotherstruct **
 832 T_PACKEDARRAY_out(...)
 833  PREINIT:
 834   unsigned int i, nstructs, count_anotherstructPtrPtr;
 835  CODE:
 836   if ((items % 3) != 0)
 837     croak("Need nitems divisible by 3");
 838   nstructs = (unsigned int)(items / 3);
 839   count_anotherstructPtrPtr = nstructs;
 840   Newxz(RETVAL, nstructs+1, anotherstruct *);
 841   for (i = 0; i < nstructs; ++i) {
 842     Newxz(RETVAL[i], 1, anotherstruct);
 843     RETVAL[i]->a = SvIV(ST(3*i));
 844     RETVAL[i]->b = SvIV(ST(3*i+1));
 845     RETVAL[i]->c = SvNV(ST(3*i+2));
 846   }
 847  OUTPUT: RETVAL
 848  CLEANUP:
 849   XS_release_anotherstructPtrPtr(RETVAL);
 850
 851
 852 ## T_DATAUNIT
 853 ## NOT YET
 854
 855
 856 ## T_CALLBACK
 857 ## NOT YET
 858
 859
 860 ## T_ARRAY
 861
 862 # Test passes in an integer array and returns it along with
 863 # the number of elements
 864 # Pass in a dummy value to test offsetting
 865
 866 # Problem is that xsubpp does XSRETURN(1) because we arent
 867 # using PPCODE. This means that only the first element
 868 # is returned. KLUGE this by using CLEANUP to return before the
 869 # end.
 870 # Note: I read this as: The "T_ARRAY" typemap is really rather broken,
 871 #       at least for OUTPUT. That is apart from the general design
 872 #       weaknesses. --Steffen
 873
 874 intArray *
 875 T_ARRAY( dummy, array, ... )
 876   int dummy = 0;
 877   intArray * array
 878  PREINIT:
 879   U32 size_RETVAL;
 880  CODE:
 881   dummy += 0; /* Fix -Wall */
 882   size_RETVAL = ix_array;
 883   RETVAL = array;
 884  OUTPUT:
 885   RETVAL
 886  CLEANUP:
 887   Safefree(array);
 888   XSRETURN(size_RETVAL);
 889
 890
 891 ## T_STDIO
 892
 893 FILE *
 894 T_STDIO_open( file )
 895   const char * file
 896  CODE:
 897   RETVAL = xsfopen( file );
 898  OUTPUT:
 899   RETVAL
 900
 901 SysRet
 902 T_STDIO_close( f )
 903   PerlIO * f
 904  PREINIT:
 905   FILE * stream;
 906  CODE:
 907   /* Get the FILE* */
 908   stream = PerlIO_findFILE( f );
 909   /* Release the FILE* from the PerlIO system so that we do
 910      not close the file twice */
 911   PerlIO_releaseFILE(f,stream);
 912   /* Must release the file before closing it */
 913   RETVAL = xsfclose( stream );
 914  OUTPUT:
 915   RETVAL
 916
 917 int
 918 T_STDIO_print( stream, string )
 919   FILE * stream
 920   const char * string
 921  CODE:
 922   RETVAL = xsfprintf( stream, string );
 923  OUTPUT:
 924   RETVAL
 925
 926
 927 ## T_INOUT
 928
 929 PerlIO *
 930 T_INOUT(in)
 931   PerlIO *in;
 932  CODE:
 933   RETVAL = in; /* silly test but better than nothing */
 934  OUTPUT: RETVAL
 935
 936
 937 ## T_IN
 938
 939 inputfh
 940 T_IN(in)
 941   inputfh in;
 942  CODE:
 943   RETVAL = in; /* silly test but better than nothing */
 944  OUTPUT: RETVAL
 945
 946
 947 ## T_OUT
 948
 949 outputfh
 950 T_OUT(in)
 951   outputfh in;
 952  CODE:
 953   RETVAL = in; /* silly test but better than nothing */
 954  OUTPUT: RETVAL
 955