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_count(inary); 161 162 /* FIXME dunno if supposed to use perl mallocs here */ 163 /* N+1 elements so we know the last one is NULL */ 164 Newxz(out, nitems+1, anotherstruct*); 165 166 /* WARNING: in real code, we'd have to Safefree() on exception, but 167 * since we're testing perl, if we croak() here, stuff is 168 * rotten anyway! */ 169 for (i = 0; i < nitems; ++i) { 170 Newxz(out[i], 1, anotherstruct); 171 elem = av_fetch(inary, i, 0); 172 if (elem == NULL) 173 Perl_croak(aTHX_ "Shouldn't happen: av_fetch returns NULL"); 174 tmp = *elem; 175 SvGETMAGIC(tmp); 176 if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVHV) 177 inhash = (HV*)SvRV(tmp); 178 else 179 Perl_croak(aTHX_ "Array element %" UVuf 180 " is not a HASH reference", i); 181 182 elem = hv_fetchs(inhash, "a", 0); 183 if (elem == NULL) 184 Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL"); 185 out[i]->a = SvIV(*elem); 186 187 elem = hv_fetchs(inhash, "b", 0); 188 if (elem == NULL) 189 Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL"); 190 out[i]->b = SvIV(*elem); 191 192 elem = hv_fetchs(inhash, "c", 0); 193 if (elem == NULL) 194 Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL"); 195 out[i]->c = SvNV(*elem); 196 } 197 198 return out; 199 } 200 201 /* no special meaning as far as typemaps are concerned, 202 * just for convenience */ 203 void 204 XS_release_anotherstructPtrPtr(anotherstruct **in) 205 { 206 unsigned int i; 207 for (i = 0; in[i] != NULL; i++) 208 Safefree(in[i]); 209 Safefree(in); 210 } 211 212 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 void 271 T_SV_output(sv) 272 SV *sv 273 CODE: 274 sv = sv_2mortal(newSVpvn("test", 4)); 275 OUTPUT: 276 sv 277 278 ## T_SVREF 279 280 SVREF 281 T_SVREF( svref ) 282 SVREF svref 283 CODE: 284 RETVAL = svref; 285 OUTPUT: 286 RETVAL 287 288 289 ## T_SVREF_FIXED 290 291 SVREF_FIXED 292 T_SVREF_REFCOUNT_FIXED( svref ) 293 SVREF_FIXED svref 294 CODE: 295 SvREFCNT_inc(svref); 296 RETVAL = svref; 297 OUTPUT: 298 RETVAL 299 300 void 301 T_SVREF_REFCOUNT_FIXED_output( OUT svref ) 302 SVREF_FIXED svref 303 CODE: 304 svref = newSVpvn("test", 4); 305 306 ## T_AVREF 307 308 AV * 309 T_AVREF( av ) 310 AV * av 311 CODE: 312 RETVAL = av; 313 OUTPUT: 314 RETVAL 315 316 317 ## T_AVREF_REFCOUNT_FIXED 318 319 AV_FIXED* 320 T_AVREF_REFCOUNT_FIXED( av ) 321 AV_FIXED * av 322 CODE: 323 SvREFCNT_inc(av); 324 RETVAL = av; 325 OUTPUT: 326 RETVAL 327 328 void 329 T_AVREF_REFCOUNT_FIXED_output( OUT avref) 330 AV_FIXED *avref; 331 CODE: 332 avref = newAV(); 333 av_push(avref, newSVpvs("test")); 334 335 ## T_HVREF 336 337 HV * 338 T_HVREF( hv ) 339 HV * hv 340 CODE: 341 RETVAL = hv; 342 OUTPUT: 343 RETVAL 344 345 346 ## T_HVREF_REFCOUNT_FIXED 347 348 HV_FIXED* 349 T_HVREF_REFCOUNT_FIXED( hv ) 350 HV_FIXED * hv 351 CODE: 352 SvREFCNT_inc(hv); 353 RETVAL = hv; 354 OUTPUT: 355 RETVAL 356 357 void 358 T_HVREF_REFCOUNT_FIXED_output( OUT hvref) 359 HV_FIXED *hvref; 360 CODE: 361 hvref = newHV(); 362 hv_stores(hvref, "test", newSVpvs("value")); 363 364 ## T_CVREF 365 366 CV * 367 T_CVREF( cv ) 368 CV * cv 369 CODE: 370 RETVAL = cv; 371 OUTPUT: 372 RETVAL 373 374 375 ## T_CVREF_REFCOUNT_FIXED 376 377 CV_FIXED * 378 T_CVREF_REFCOUNT_FIXED( cv ) 379 CV_FIXED * cv 380 CODE: 381 SvREFCNT_inc(cv); 382 RETVAL = cv; 383 OUTPUT: 384 RETVAL 385 386 void 387 T_CVREF_REFCOUNT_FIXED_output( OUT cvref) 388 CV_FIXED *cvref; 389 CODE: 390 cvref = get_cv("XSLoader::load", 0); 391 SvREFCNT_inc(cvref); 392 393 ## T_SYSRET 394 395 # Test a successful return 396 397 SysRet 398 T_SYSRET_pass() 399 CODE: 400 RETVAL = 0; 401 OUTPUT: 402 RETVAL 403 404 # Test failure 405 406 SysRet 407 T_SYSRET_fail() 408 CODE: 409 RETVAL = -1; 410 OUTPUT: 411 RETVAL 412 413 ## T_UV 414 415 unsigned int 416 T_UV( uv ) 417 unsigned int uv 418 CODE: 419 RETVAL = uv; 420 OUTPUT: 421 RETVAL 422 423 424 ## T_IV 425 426 long 427 T_IV( iv ) 428 long iv 429 CODE: 430 RETVAL = iv; 431 OUTPUT: 432 RETVAL 433 434 435 ## T_INT 436 437 intTINT 438 T_INT( i ) 439 intTINT i 440 CODE: 441 RETVAL = i; 442 OUTPUT: 443 RETVAL 444 445 446 ## T_ENUM 447 448 # The test should return the value for SVt_PVHV. 449 # 11 at the present time but we can't not rely on this 450 # for testing purposes. 451 452 svtype 453 T_ENUM() 454 CODE: 455 RETVAL = SVt_PVHV; 456 OUTPUT: 457 RETVAL 458 459 460 ## T_BOOL 461 462 bool 463 T_BOOL( in ) 464 bool in 465 CODE: 466 RETVAL = in; 467 OUTPUT: 468 RETVAL 469 470 bool 471 T_BOOL_2( in ) 472 bool in 473 CODE: 474 PERL_UNUSED_VAR(RETVAL); 475 OUTPUT: 476 in 477 478 void 479 T_BOOL_OUT( out, in ) 480 bool out 481 bool in 482 CODE: 483 out = in; 484 OUTPUT: 485 out 486 487 ## T_U_INT 488 489 intUnsigned 490 T_U_INT( uint ) 491 intUnsigned uint 492 CODE: 493 RETVAL = uint; 494 OUTPUT: 495 RETVAL 496 497 498 ## T_SHORT 499 500 short 501 T_SHORT( s ) 502 short s 503 CODE: 504 RETVAL = s; 505 OUTPUT: 506 RETVAL 507 508 509 ## T_U_SHORT 510 511 U16 512 T_U_SHORT( in ) 513 U16 in 514 CODE: 515 RETVAL = in; 516 OUTPUT: 517 RETVAL 518 519 520 ## T_LONG 521 522 intTLONG 523 T_LONG( in ) 524 intTLONG in 525 CODE: 526 RETVAL = in; 527 OUTPUT: 528 RETVAL 529 530 ## T_U_LONG 531 532 U32 533 T_U_LONG( in ) 534 U32 in 535 CODE: 536 RETVAL = in; 537 OUTPUT: 538 RETVAL 539 540 541 ## T_CHAR 542 543 char 544 T_CHAR( in ); 545 char in 546 CODE: 547 RETVAL = in; 548 OUTPUT: 549 RETVAL 550 551 552 ## T_U_CHAR 553 554 unsigned char 555 T_U_CHAR( in ); 556 unsigned char in 557 CODE: 558 RETVAL = in; 559 OUTPUT: 560 RETVAL 561 562 563 ## T_FLOAT 564 565 float 566 T_FLOAT( in ) 567 float in 568 CODE: 569 RETVAL = in; 570 OUTPUT: 571 RETVAL 572 573 574 ## T_NV 575 576 NV 577 T_NV( in ) 578 NV in 579 CODE: 580 RETVAL = in; 581 OUTPUT: 582 RETVAL 583 584 585 ## T_DOUBLE 586 587 double 588 T_DOUBLE( in ) 589 double in 590 CODE: 591 RETVAL = in; 592 OUTPUT: 593 RETVAL 594 595 596 ## T_PV 597 598 char * 599 T_PV( in ) 600 char * in 601 CODE: 602 RETVAL = in; 603 OUTPUT: 604 RETVAL 605 606 char * 607 T_PV_null() 608 CODE: 609 RETVAL = NULL; 610 OUTPUT: 611 RETVAL 612 613 614 ## T_PTR 615 616 # Pass in a value. Store the value in some static memory and 617 # then return the pointer 618 619 void * 620 T_PTR_OUT( in ) 621 int in; 622 CODE: 623 xst_anint = in; 624 RETVAL = &xst_anint; 625 OUTPUT: 626 RETVAL 627 628 # pass in the pointer and return the value 629 630 int 631 T_PTR_IN( ptr ) 632 void * ptr 633 CODE: 634 RETVAL = *(int *)ptr; 635 OUTPUT: 636 RETVAL 637 638 639 ## T_PTRREF 640 641 # Similar test to T_PTR 642 # Pass in a value. Store the value in some static memory and 643 # then return the pointer 644 645 intRef * 646 T_PTRREF_OUT( in ) 647 intRef in; 648 CODE: 649 xst_anintref = in; 650 RETVAL = &xst_anintref; 651 OUTPUT: 652 RETVAL 653 654 # pass in the pointer and return the value 655 656 intRef 657 T_PTRREF_IN( ptr ) 658 intRef * ptr 659 CODE: 660 RETVAL = *ptr; 661 OUTPUT: 662 RETVAL 663 664 665 ## T_PTROBJ 666 667 # Similar test to T_PTRREF 668 # Pass in a value. Store the value in some static memory and 669 # then return the pointer 670 671 intObj * 672 T_PTROBJ_OUT( in ) 673 intObj in; 674 CODE: 675 xst_anintobj = in; 676 RETVAL = &xst_anintobj; 677 OUTPUT: 678 RETVAL 679 680 # pass in the pointer and return the value 681 682 MODULE = XS::Typemap PACKAGE = intObjPtr 683 684 intObj 685 T_PTROBJ_IN( ptr ) 686 intObj * ptr 687 CODE: 688 RETVAL = *ptr; 689 OUTPUT: 690 RETVAL 691 692 MODULE = XS::Typemap PACKAGE = XS::Typemap 693 694 695 ## T_REF_IV_REF 696 ## NOT YET 697 698 699 ## T_REF_IV_PTR 700 701 # Similar test to T_PTROBJ 702 # Pass in a value. Store the value in some static memory and 703 # then return the pointer 704 705 intRefIv * 706 T_REF_IV_PTR_OUT( in ) 707 intRefIv in; 708 CODE: 709 xst_anintrefiv = in; 710 RETVAL = &xst_anintrefiv; 711 OUTPUT: 712 RETVAL 713 714 # pass in the pointer and return the value 715 716 MODULE = XS::Typemap PACKAGE = intRefIvPtr 717 718 intRefIv 719 T_REF_IV_PTR_IN( ptr ) 720 intRefIv * ptr 721 CODE: 722 RETVAL = *ptr; 723 OUTPUT: 724 RETVAL 725 726 727 MODULE = XS::Typemap PACKAGE = XS::Typemap 728 729 ## T_PTRDESC 730 ## NOT YET 731 732 733 ## T_REFREF 734 ## NOT YET 735 736 737 ## T_REFOBJ 738 ## NOT YET 739 740 741 ## T_OPAQUEPTR 742 743 intOpq * 744 T_OPAQUEPTR_IN( val ) 745 intOpq val 746 CODE: 747 xst_anintopq = val; 748 RETVAL = &xst_anintopq; 749 OUTPUT: 750 RETVAL 751 752 intOpq 753 T_OPAQUEPTR_OUT( ptr ) 754 intOpq * ptr 755 CODE: 756 RETVAL = *ptr; 757 OUTPUT: 758 RETVAL 759 760 short 761 T_OPAQUEPTR_OUT_short( ptr ) 762 shortOPQ * ptr 763 CODE: 764 RETVAL = *ptr; 765 OUTPUT: 766 RETVAL 767 768 # Test it with a structure 769 astruct * 770 T_OPAQUEPTR_IN_struct( a,b,c ) 771 int a 772 int b 773 double c 774 PREINIT: 775 struct t_opaqueptr test; 776 CODE: 777 test.a = a; 778 test.b = b; 779 test.c = c; 780 RETVAL = &test; 781 OUTPUT: 782 RETVAL 783 784 void 785 T_OPAQUEPTR_OUT_struct( test ) 786 astruct * test 787 PPCODE: 788 XPUSHs(sv_2mortal(newSViv(test->a))); 789 XPUSHs(sv_2mortal(newSViv(test->b))); 790 XPUSHs(sv_2mortal(newSVnv(test->c))); 791 792 793 ## T_OPAQUE 794 795 shortOPQ 796 T_OPAQUE_IN( val ) 797 int val 798 CODE: 799 RETVAL = (shortOPQ)val; 800 OUTPUT: 801 RETVAL 802 803 IV 804 T_OPAQUE_OUT( val ) 805 shortOPQ val 806 CODE: 807 RETVAL = (IV)val; 808 OUTPUT: 809 RETVAL 810 811 array(int,3) 812 T_OPAQUE_array( a,b,c) 813 int a 814 int b 815 int c 816 PREINIT: 817 int array[3]; 818 CODE: 819 array[0] = a; 820 array[1] = b; 821 array[2] = c; 822 RETVAL = array; 823 OUTPUT: 824 RETVAL 825 826 827 ## T_PACKED 828 829 void 830 T_PACKED_in(in) 831 anotherstruct *in; 832 PPCODE: 833 mXPUSHi(in->a); 834 mXPUSHi(in->b); 835 mXPUSHn(in->c); 836 Safefree(in); 837 XSRETURN(3); 838 839 anotherstruct * 840 T_PACKED_out(a, b ,c) 841 int a; 842 int b; 843 double c; 844 CODE: 845 Newxz(RETVAL, 1, anotherstruct); 846 RETVAL->a = a; 847 RETVAL->b = b; 848 RETVAL->c = c; 849 OUTPUT: RETVAL 850 CLEANUP: 851 Safefree(RETVAL); 852 853 ## T_PACKEDARRAY 854 855 void 856 T_PACKEDARRAY_in(in) 857 anotherstruct **in; 858 PREINIT: 859 unsigned int i = 0; 860 PPCODE: 861 while (in[i] != NULL) { 862 mXPUSHi(in[i]->a); 863 mXPUSHi(in[i]->b); 864 mXPUSHn(in[i]->c); 865 ++i; 866 } 867 XS_release_anotherstructPtrPtr(in); 868 XSRETURN(3*i); 869 870 anotherstruct ** 871 T_PACKEDARRAY_out(...) 872 PREINIT: 873 unsigned int i, nstructs, count_anotherstructPtrPtr; 874 CODE: 875 if ((items % 3) != 0) 876 croak("Need nitems divisible by 3"); 877 nstructs = (unsigned int)(items / 3); 878 count_anotherstructPtrPtr = nstructs; 879 Newxz(RETVAL, nstructs+1, anotherstruct *); 880 for (i = 0; i < nstructs; ++i) { 881 Newxz(RETVAL[i], 1, anotherstruct); 882 RETVAL[i]->a = SvIV(ST(3*i)); 883 RETVAL[i]->b = SvIV(ST(3*i+1)); 884 RETVAL[i]->c = SvNV(ST(3*i+2)); 885 } 886 OUTPUT: RETVAL 887 CLEANUP: 888 XS_release_anotherstructPtrPtr(RETVAL); 889 890 891 ## T_DATAUNIT 892 ## NOT YET 893 894 895 ## T_CALLBACK 896 ## NOT YET 897 898 899 ## T_ARRAY 900 901 # Test passes in an integer array and returns it along with 902 # the number of elements 903 # Pass in a dummy value to test offsetting 904 905 # Problem is that xsubpp does XSRETURN(1) because we arent 906 # using PPCODE. This means that only the first element 907 # is returned. KLUGE this by using CLEANUP to return before the 908 # end. 909 # Note: I read this as: The "T_ARRAY" typemap is really rather broken, 910 # at least for OUTPUT. That is apart from the general design 911 # weaknesses. --Steffen 912 913 intArray * 914 T_ARRAY( dummy, array, ... ) 915 int dummy = 0; 916 intArray * array 917 PREINIT: 918 U32 size_RETVAL; 919 CODE: 920 PERL_UNUSED_VAR(dummy); /* GH 21505 */ 921 size_RETVAL = ix_array; 922 RETVAL = array; 923 OUTPUT: 924 RETVAL 925 CLEANUP: 926 Safefree(array); 927 XSRETURN(size_RETVAL); 928 929 930 ## T_STDIO 931 932 FILE * 933 T_STDIO_open( file ) 934 const char * file 935 CODE: 936 RETVAL = xsfopen( file ); 937 OUTPUT: 938 RETVAL 939 940 void 941 T_STDIO_open_ret_in_arg( file, io) 942 const char * file 943 FILE * io = NO_INIT 944 CODE: 945 io = xsfopen( file ); 946 OUTPUT: 947 io 948 949 SysRet 950 T_STDIO_close( f ) 951 PerlIO * f 952 PREINIT: 953 FILE * stream; 954 CODE: 955 /* Get the FILE* */ 956 stream = PerlIO_findFILE( f ); 957 /* Release the FILE* from the PerlIO system so that we do 958 not close the file twice */ 959 PerlIO_releaseFILE(f,stream); 960 /* Must release the file before closing it */ 961 RETVAL = xsfclose( stream ); 962 OUTPUT: 963 RETVAL 964 965 int 966 T_STDIO_print( stream, string ) 967 FILE * stream 968 const char * string 969 CODE: 970 RETVAL = xsfprintf( stream, string ); 971 OUTPUT: 972 RETVAL 973 974 975 ## T_INOUT 976 977 PerlIO * 978 T_INOUT(in) 979 PerlIO *in; 980 CODE: 981 RETVAL = in; /* silly test but better than nothing */ 982 OUTPUT: RETVAL 983 984 985 ## T_IN 986 987 inputfh 988 T_IN(in) 989 inputfh in; 990 CODE: 991 RETVAL = in; /* silly test but better than nothing */ 992 OUTPUT: RETVAL 993 994 995 ## T_OUT 996 997 outputfh 998 T_OUT(in) 999 outputfh in; 1000 CODE: 1001 RETVAL = in; /* silly test but better than nothing */ 1002 OUTPUT: RETVAL 1003 1004