ext/Devel/PPPort/PPPort.xs

   1 /*******************************************************************************
   2 *
   3 *  !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
   4 *
   5 ********************************************************************************
   6 *
   7 *  Perl/Pollution/Portability
   8 *
   9 ********************************************************************************
  10 *
  11 *  $Revision: 9 $
  12 *  $Author: mhx $
  13 *  $Date: 2006/01/14 18:07:55 +0100 $
  14 *
  15 ********************************************************************************
  16 *
  17 *  Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
  18 *  Version 2.x, Copyright (C) 2001, Paul Marquess.
  19 *  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
  20 *
  21 *  This program is free software; you can redistribute it and/or
  22 *  modify it under the same terms as Perl itself.
  23 *
  24 *******************************************************************************/
  25
  26 /* ========== BEGIN XSHEAD ================================================== */
  27
  28
  29
  30 /* =========== END XSHEAD =================================================== */
  31
  32 #include "EXTERN.h"
  33 #include "perl.h"
  34 #include "XSUB.h"
  35
  36 /* ========== BEGIN XSINIT ================================================== */
  37
  38 /* ---- from parts/inc/call ---- */
  39 #define NEED_eval_pv
  40
  41 /* ---- from parts/inc/grok ---- */
  42 #define NEED_grok_number
  43 #define NEED_grok_numeric_radix
  44 #define NEED_grok_bin
  45 #define NEED_grok_hex
  46 #define NEED_grok_oct
  47
  48 /* ---- from parts/inc/newCONSTSUB ---- */
  49 #define NEED_newCONSTSUB
  50
  51 /* ---- from parts/inc/newRV ---- */
  52 #define NEED_newRV_noinc
  53
  54 /* ---- from parts/inc/snprintf ---- */
  55 #define NEED_my_snprintf
  56
  57 /* ---- from parts/inc/sv_xpvf ---- */
  58 #define NEED_vnewSVpvf
  59 #define NEED_sv_catpvf_mg
  60 #define NEED_sv_catpvf_mg_nocontext
  61 #define NEED_sv_setpvf_mg
  62 #define NEED_sv_setpvf_mg_nocontext
  63
  64 /* ---- from parts/inc/SvPV ---- */
  65 #define NEED_sv_2pv_nolen
  66 #define NEED_sv_2pvbyte
  67
  68 /* ---- from parts/inc/variables ---- */
  69 #define NEED_PL_signals
  70
  71 /* ---- from parts/inc/warn ---- */
  72 #define NEED_warner
  73
  74 /* =========== END XSINIT =================================================== */
  75
  76 #include "ppport.h"
  77
  78 /* ========== BEGIN XSMISC ================================================== */
  79
  80 /* ---- from parts/inc/exception ---- */
  81 /* defined in module3.c */
  82 int exception(int throw_e);
  83
  84 /* ---- from parts/inc/misc ---- */
  85 XS(XS_Devel__PPPort_dXSTARG);  /* prototype */
  86 XS(XS_Devel__PPPort_dXSTARG)
  87 {
  88   dXSARGS;
  89   dXSTARG;
  90   IV iv;
  91   SP -= items;
  92   iv = SvIV(ST(0)) + 1;
  93   PUSHi(iv);
  94   XSRETURN(1);
  95 }
  96
  97 XS(XS_Devel__PPPort_dAXMARK);  /* prototype */
  98 XS(XS_Devel__PPPort_dAXMARK)
  99 {
 100   dSP;
 101   dAXMARK;
 102   dITEMS;
 103   IV iv;
 104   SP -= items;
 105   iv = SvIV(ST(0)) - 1;
 106   PUSHs(sv_2mortal(newSViv(iv)));
 107   XSRETURN(1);
 108 }
 109
 110 /* ---- from parts/inc/MY_CXT ---- */
 111 #define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION
 112
 113 typedef struct {
 114   /* Put Global Data in here */
 115   int dummy;
 116 } my_cxt_t;
 117
 118 START_MY_CXT
 119
 120 /* ---- from parts/inc/newCONSTSUB ---- */
 121 void call_newCONSTSUB_1(void)
 122 {
 123 #ifdef PERL_NO_GET_CONTEXT
 124         dTHX;
 125 #endif
 126         newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
 127 }
 128
 129 extern void call_newCONSTSUB_2(void);
 130 extern void call_newCONSTSUB_3(void);
 131
 132 /* ---- from parts/inc/sv_xpvf ---- */
 133 static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
 134 {
 135   SV *sv;
 136   va_list args;
 137   va_start(args, pat);
 138 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
 139   sv = vnewSVpvf(pat, &args);
 140 #else
 141   sv = newSVpv(pat, 0);
 142 #endif
 143   va_end(args);
 144   return sv;
 145 }
 146
 147 static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
 148 {
 149   va_list args;
 150   va_start(args, pat);
 151 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
 152   sv_vcatpvf(sv, pat, &args);
 153 #else
 154   sv_catpv(sv, pat);
 155 #endif
 156   va_end(args);
 157 }
 158
 159 static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
 160 {
 161   va_list args;
 162   va_start(args, pat);
 163 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
 164   sv_vsetpvf(sv, pat, &args);
 165 #else
 166   sv_setpv(sv, pat);
 167 #endif
 168   va_end(args);
 169 }
 170
 171 /* ---- from parts/inc/variables ---- */
 172 U32 get_PL_signals_1(void)
 173 {
 174   return PL_signals;
 175 }
 176
 177 extern U32 get_PL_signals_2(void);
 178 extern U32 get_PL_signals_3(void);
 179
 180 /* =========== END XSMISC =================================================== */
 181
 182 MODULE = Devel::PPPort          PACKAGE = Devel::PPPort
 183
 184 BOOT:
 185         /* ---- from parts/inc/misc ---- */
 186         newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file);
 187         newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
 188
 189         /* ---- from parts/inc/MY_CXT ---- */
 190         {
 191           MY_CXT_INIT;
 192           /* If any of the fields in the my_cxt_t struct need
 193            * to be initialised, do it here.
 194            */
 195           MY_CXT.dummy = 42;
 196         }
 197
 198
 199 ##----------------------------------------------------------------------
 200 ##  XSUBs from parts/inc/call
 201 ##----------------------------------------------------------------------
 202
 203 I32
 204 G_SCALAR()
 205         CODE:
 206                 RETVAL = G_SCALAR;
 207         OUTPUT:
 208                 RETVAL
 209
 210 I32
 211 G_ARRAY()
 212         CODE:
 213                 RETVAL = G_ARRAY;
 214         OUTPUT:
 215                 RETVAL
 216
 217 I32
 218 G_DISCARD()
 219         CODE:
 220                 RETVAL = G_DISCARD;
 221         OUTPUT:
 222                 RETVAL
 223
 224 void
 225 eval_sv(sv, flags)
 226         SV* sv
 227         I32 flags
 228         PREINIT:
 229                 I32 i;
 230         PPCODE:
 231                 PUTBACK;
 232                 i = eval_sv(sv, flags);
 233                 SPAGAIN;
 234                 EXTEND(SP, 1);
 235                 PUSHs(sv_2mortal(newSViv(i)));
 236
 237 void
 238 eval_pv(p, croak_on_error)
 239         char* p
 240         I32 croak_on_error
 241         PPCODE:
 242                 PUTBACK;
 243                 EXTEND(SP, 1);
 244                 PUSHs(eval_pv(p, croak_on_error));
 245
 246 void
 247 call_sv(sv, flags, ...)
 248         SV* sv
 249         I32 flags
 250         PREINIT:
 251                 I32 i;
 252         PPCODE:
 253                 for (i=0; i<items-2; i++)
 254                   ST(i) = ST(i+2); /* pop first two args */
 255                 PUSHMARK(SP);
 256                 SP += items - 2;
 257                 PUTBACK;
 258                 i = call_sv(sv, flags);
 259                 SPAGAIN;
 260                 EXTEND(SP, 1);
 261                 PUSHs(sv_2mortal(newSViv(i)));
 262
 263 void
 264 call_pv(subname, flags, ...)
 265         char* subname
 266         I32 flags
 267         PREINIT:
 268                 I32 i;
 269         PPCODE:
 270                 for (i=0; i<items-2; i++)
 271                   ST(i) = ST(i+2); /* pop first two args */
 272                 PUSHMARK(SP);
 273                 SP += items - 2;
 274                 PUTBACK;
 275                 i = call_pv(subname, flags);
 276                 SPAGAIN;
 277                 EXTEND(SP, 1);
 278                 PUSHs(sv_2mortal(newSViv(i)));
 279
 280 void
 281 call_argv(subname, flags, ...)
 282         char* subname
 283         I32 flags
 284         PREINIT:
 285                 I32 i;
 286                 char *args[8];
 287         PPCODE:
 288                 if (items > 8)  /* play safe */
 289                   XSRETURN_UNDEF;
 290                 for (i=2; i<items; i++)
 291                   args[i-2] = SvPV_nolen(ST(i));
 292                 args[items-2] = NULL;
 293                 PUTBACK;
 294                 i = call_argv(subname, flags, args);
 295                 SPAGAIN;
 296                 EXTEND(SP, 1);
 297                 PUSHs(sv_2mortal(newSViv(i)));
 298
 299 void
 300 call_method(methname, flags, ...)
 301         char* methname
 302         I32 flags
 303         PREINIT:
 304                 I32 i;
 305         PPCODE:
 306                 for (i=0; i<items-2; i++)
 307                   ST(i) = ST(i+2); /* pop first two args */
 308                 PUSHMARK(SP);
 309                 SP += items - 2;
 310                 PUTBACK;
 311                 i = call_method(methname, flags);
 312                 SPAGAIN;
 313                 EXTEND(SP, 1);
 314                 PUSHs(sv_2mortal(newSViv(i)));
 315
 316 ##----------------------------------------------------------------------
 317 ##  XSUBs from parts/inc/cop
 318 ##----------------------------------------------------------------------
 319
 320 char *
 321 CopSTASHPV()
 322         CODE:
 323                 RETVAL = CopSTASHPV(PL_curcop);
 324         OUTPUT:
 325                 RETVAL
 326
 327 char *
 328 CopFILE()
 329         CODE:
 330                 RETVAL = CopFILE(PL_curcop);
 331         OUTPUT:
 332                 RETVAL
 333
 334 ##----------------------------------------------------------------------
 335 ##  XSUBs from parts/inc/exception
 336 ##----------------------------------------------------------------------
 337
 338 int
 339 exception(throw_e)
 340   int throw_e
 341   OUTPUT:
 342     RETVAL
 343
 344 ##----------------------------------------------------------------------
 345 ##  XSUBs from parts/inc/grok
 346 ##----------------------------------------------------------------------
 347
 348 UV
 349 grok_number(string)
 350         SV *string
 351         PREINIT:
 352                 const char *pv;
 353                 STRLEN len;
 354         CODE:
 355                 pv = SvPV(string, len);
 356                 if (!grok_number(pv, len, &RETVAL))
 357                   XSRETURN_UNDEF;
 358         OUTPUT:
 359                 RETVAL
 360
 361 UV
 362 grok_bin(string)
 363         SV *string
 364         PREINIT:
 365                 char *pv;
 366                 I32 flags;
 367                 STRLEN len;
 368         CODE:
 369                 pv = SvPV(string, len);
 370                 RETVAL = grok_bin(pv, &len, &flags, NULL);
 371         OUTPUT:
 372                 RETVAL
 373
 374 UV
 375 grok_hex(string)
 376         SV *string
 377         PREINIT:
 378                 char *pv;
 379                 I32 flags;
 380                 STRLEN len;
 381         CODE:
 382                 pv = SvPV(string, len);
 383                 RETVAL = grok_hex(pv, &len, &flags, NULL);
 384         OUTPUT:
 385                 RETVAL
 386
 387 UV
 388 grok_oct(string)
 389         SV *string
 390         PREINIT:
 391                 char *pv;
 392                 I32 flags;
 393                 STRLEN len;
 394         CODE:
 395                 pv = SvPV(string, len);
 396                 RETVAL = grok_oct(pv, &len, &flags, NULL);
 397         OUTPUT:
 398                 RETVAL
 399
 400 UV
 401 Perl_grok_number(string)
 402         SV *string
 403         PREINIT:
 404                 const char *pv;
 405                 STRLEN len;
 406         CODE:
 407                 pv = SvPV(string, len);
 408                 if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
 409                   XSRETURN_UNDEF;
 410         OUTPUT:
 411                 RETVAL
 412
 413 UV
 414 Perl_grok_bin(string)
 415         SV *string
 416         PREINIT:
 417                 char *pv;
 418                 I32 flags;
 419                 STRLEN len;
 420         CODE:
 421                 pv = SvPV(string, len);
 422                 RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
 423         OUTPUT:
 424                 RETVAL
 425
 426 UV
 427 Perl_grok_hex(string)
 428         SV *string
 429         PREINIT:
 430                 char *pv;
 431                 I32 flags;
 432                 STRLEN len;
 433         CODE:
 434                 pv = SvPV(string, len);
 435                 RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
 436         OUTPUT:
 437                 RETVAL
 438
 439 UV
 440 Perl_grok_oct(string)
 441         SV *string
 442         PREINIT:
 443                 char *pv;
 444                 I32 flags;
 445                 STRLEN len;
 446         CODE:
 447                 pv = SvPV(string, len);
 448                 RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
 449         OUTPUT:
 450                 RETVAL
 451
 452 ##----------------------------------------------------------------------
 453 ##  XSUBs from parts/inc/limits
 454 ##----------------------------------------------------------------------
 455
 456 IV
 457 iv_size()
 458         CODE:
 459                 RETVAL = IVSIZE == sizeof(IV);
 460         OUTPUT:
 461                 RETVAL
 462
 463 IV
 464 uv_size()
 465         CODE:
 466                 RETVAL = UVSIZE == sizeof(UV);
 467         OUTPUT:
 468                 RETVAL
 469
 470 IV
 471 iv_type()
 472         CODE:
 473                 RETVAL = sizeof(IVTYPE) == sizeof(IV);
 474         OUTPUT:
 475                 RETVAL
 476
 477 IV
 478 uv_type()
 479         CODE:
 480                 RETVAL = sizeof(UVTYPE) == sizeof(UV);
 481         OUTPUT:
 482                 RETVAL
 483
 484 ##----------------------------------------------------------------------
 485 ##  XSUBs from parts/inc/magic
 486 ##----------------------------------------------------------------------
 487
 488 void
 489 sv_catpv_mg(sv, string)
 490         SV *sv;
 491         char *string;
 492         CODE:
 493                 sv_catpv_mg(sv, string);
 494
 495 void
 496 sv_catpvn_mg(sv, sv2)
 497         SV *sv;
 498         SV *sv2;
 499         PREINIT:
 500                 char *str;
 501                 STRLEN len;
 502         CODE:
 503                 str = SvPV(sv2, len);
 504                 sv_catpvn_mg(sv, str, len);
 505
 506 void
 507 sv_catsv_mg(sv, sv2)
 508         SV *sv;
 509         SV *sv2;
 510         CODE:
 511                 sv_catsv_mg(sv, sv2);
 512
 513 void
 514 sv_setiv_mg(sv, iv)
 515         SV *sv;
 516         IV iv;
 517         CODE:
 518                 sv_setiv_mg(sv, iv);
 519
 520 void
 521 sv_setnv_mg(sv, nv)
 522         SV *sv;
 523         NV nv;
 524         CODE:
 525                 sv_setnv_mg(sv, nv);
 526
 527 void
 528 sv_setpv_mg(sv, pv)
 529         SV *sv;
 530         char *pv;
 531         CODE:
 532                 sv_setpv_mg(sv, pv);
 533
 534 void
 535 sv_setpvn_mg(sv, sv2)
 536         SV *sv;
 537         SV *sv2;
 538         PREINIT:
 539                 char *str;
 540                 STRLEN len;
 541         CODE:
 542                 str = SvPV(sv2, len);
 543                 sv_setpvn_mg(sv, str, len);
 544
 545 void
 546 sv_setsv_mg(sv, sv2)
 547         SV *sv;
 548         SV *sv2;
 549         CODE:
 550                 sv_setsv_mg(sv, sv2);
 551
 552 void
 553 sv_setuv_mg(sv, uv)
 554         SV *sv;
 555         UV uv;
 556         CODE:
 557                 sv_setuv_mg(sv, uv);
 558
 559 void
 560 sv_usepvn_mg(sv, sv2)
 561         SV *sv;
 562         SV *sv2;
 563         PREINIT:
 564                 char *str, *copy;
 565                 STRLEN len;
 566         CODE:
 567                 str = SvPV(sv2, len);
 568                 New(42, copy, len+1, char);
 569                 Copy(str, copy, len+1, char);
 570                 sv_usepvn_mg(sv, copy, len);
 571
 572 int
 573 SvVSTRING_mg(sv)
 574         SV *sv;
 575         CODE:
 576                 RETVAL = SvVSTRING_mg(sv) != NULL;
 577         OUTPUT:
 578                 RETVAL
 579
 580 ##----------------------------------------------------------------------
 581 ##  XSUBs from parts/inc/memory
 582 ##----------------------------------------------------------------------
 583
 584 int
 585 checkmem()
 586   PREINIT:
 587     char *p;
 588
 589   CODE:
 590     RETVAL = 0;
 591     Newx(p, 6, char);
 592     CopyD("Hello", p, 6, char);
 593     if (memEQ(p, "Hello", 6))
 594       RETVAL++;
 595     ZeroD(p, 6, char);
 596     if (memEQ(p, "\0\0\0\0\0\0", 6))
 597       RETVAL++;
 598     Poison(p, 6, char);
 599     if (memNE(p, "\0\0\0\0\0\0", 6))
 600       RETVAL++;
 601     Safefree(p);
 602
 603     Newxz(p, 6, char);
 604     if (memEQ(p, "\0\0\0\0\0\0", 6))
 605       RETVAL++;
 606     Safefree(p);
 607
 608     Newxc(p, 3, short, char);
 609     Safefree(p);
 610
 611   OUTPUT:
 612     RETVAL
 613
 614 ##----------------------------------------------------------------------
 615 ##  XSUBs from parts/inc/misc
 616 ##----------------------------------------------------------------------
 617
 618 int
 619 gv_stashpvn(name, create)
 620         char *name
 621         I32 create
 622         CODE:
 623                 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
 624         OUTPUT:
 625                 RETVAL
 626
 627 int
 628 get_sv(name, create)
 629         char *name
 630         I32 create
 631         CODE:
 632                 RETVAL = get_sv(name, create) != NULL;
 633         OUTPUT:
 634                 RETVAL
 635
 636 int
 637 get_av(name, create)
 638         char *name
 639         I32 create
 640         CODE:
 641                 RETVAL = get_av(name, create) != NULL;
 642         OUTPUT:
 643                 RETVAL
 644
 645 int
 646 get_hv(name, create)
 647         char *name
 648         I32 create
 649         CODE:
 650                 RETVAL = get_hv(name, create) != NULL;
 651         OUTPUT:
 652                 RETVAL
 653
 654 int
 655 get_cv(name, create)
 656         char *name
 657         I32 create
 658         CODE:
 659                 RETVAL = get_cv(name, create) != NULL;
 660         OUTPUT:
 661                 RETVAL
 662
 663 void
 664 newSVpvn()
 665         PPCODE:
 666                 XPUSHs(newSVpvn("test", 4));
 667                 XPUSHs(newSVpvn("test", 2));
 668                 XPUSHs(newSVpvn("test", 0));
 669                 XPUSHs(newSVpvn(NULL, 2));
 670                 XPUSHs(newSVpvn(NULL, 0));
 671                 XSRETURN(5);
 672
 673 void
 674 xsreturn(two)
 675         int two
 676         PPCODE:
 677                 XPUSHs(newSVpvn("test1", 5));
 678                 if (two)
 679                   XPUSHs(newSVpvn("test2", 5));
 680                 if (two)
 681                   XSRETURN(2);
 682                 else
 683                   XSRETURN(1);
 684
 685 SV *
 686 PL_sv_undef()
 687         CODE:
 688                 RETVAL = newSVsv(&PL_sv_undef);
 689         OUTPUT:
 690                 RETVAL
 691
 692 SV *
 693 PL_sv_yes()
 694         CODE:
 695                 RETVAL = newSVsv(&PL_sv_yes);
 696         OUTPUT:
 697                 RETVAL
 698
 699 SV *
 700 PL_sv_no()
 701         CODE:
 702                 RETVAL = newSVsv(&PL_sv_no);
 703         OUTPUT:
 704                 RETVAL
 705
 706 int
 707 PL_na(string)
 708         char *string
 709         CODE:
 710                 PL_na = strlen(string);
 711                 RETVAL = PL_na;
 712         OUTPUT:
 713                 RETVAL
 714
 715 SV*
 716 boolSV(value)
 717         int value
 718         CODE:
 719                 RETVAL = newSVsv(boolSV(value));
 720         OUTPUT:
 721                 RETVAL
 722
 723 SV*
 724 DEFSV()
 725         CODE:
 726                 RETVAL = newSVsv(DEFSV);
 727         OUTPUT:
 728                 RETVAL
 729
 730 int
 731 ERRSV()
 732         CODE:
 733                 RETVAL = SvTRUE(ERRSV);
 734         OUTPUT:
 735                 RETVAL
 736
 737 SV*
 738 UNDERBAR()
 739         CODE:
 740                 {
 741                   dUNDERBAR;
 742                   RETVAL = newSVsv(UNDERBAR);
 743                 }
 744         OUTPUT:
 745                 RETVAL
 746
 747 void
 748 prepush()
 749         CODE:
 750                 {
 751                   dXSTARG;
 752                   XSprePUSH;
 753                   PUSHi(42);
 754                   XSRETURN(1);
 755                 }
 756
 757 int
 758 PERL_ABS(a)
 759         int a
 760
 761 void
 762 SVf(x)
 763         SV *x
 764         PPCODE:
 765 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
 766                 x = newSVpvf("[%"SVf"]", x);
 767 #endif
 768                 XPUSHs(x);
 769                 XSRETURN(1);
 770
 771 ##----------------------------------------------------------------------
 772 ##  XSUBs from parts/inc/mPUSH
 773 ##----------------------------------------------------------------------
 774
 775 void
 776 mPUSHp()
 777         PPCODE:
 778         EXTEND(SP, 3);
 779         mPUSHp("one", 3);
 780         mPUSHp("two", 3);
 781         mPUSHp("three", 5);
 782         XSRETURN(3);
 783
 784 void
 785 mPUSHn()
 786         PPCODE:
 787         EXTEND(SP, 3);
 788         mPUSHn(0.5);
 789         mPUSHn(-0.25);
 790         mPUSHn(0.125);
 791         XSRETURN(3);
 792
 793 void
 794 mPUSHi()
 795         PPCODE:
 796         EXTEND(SP, 3);
 797         mPUSHi(-1);
 798         mPUSHi(2);
 799         mPUSHi(-3);
 800         XSRETURN(3);
 801
 802 void
 803 mPUSHu()
 804         PPCODE:
 805         EXTEND(SP, 3);
 806         mPUSHu(1);
 807         mPUSHu(2);
 808         mPUSHu(3);
 809         XSRETURN(3);
 810
 811 void
 812 mXPUSHp()
 813         PPCODE:
 814         mXPUSHp("one", 3);
 815         mXPUSHp("two", 3);
 816         mXPUSHp("three", 5);
 817         XSRETURN(3);
 818
 819 void
 820 mXPUSHn()
 821         PPCODE:
 822         mXPUSHn(0.5);
 823         mXPUSHn(-0.25);
 824         mXPUSHn(0.125);
 825         XSRETURN(3);
 826
 827 void
 828 mXPUSHi()
 829         PPCODE:
 830         mXPUSHi(-1);
 831         mXPUSHi(2);
 832         mXPUSHi(-3);
 833         XSRETURN(3);
 834
 835 void
 836 mXPUSHu()
 837         PPCODE:
 838         mXPUSHu(1);
 839         mXPUSHu(2);
 840         mXPUSHu(3);
 841         XSRETURN(3);
 842
 843 ##----------------------------------------------------------------------
 844 ##  XSUBs from parts/inc/MY_CXT
 845 ##----------------------------------------------------------------------
 846
 847 int
 848 MY_CXT_1()
 849         CODE:
 850                 dMY_CXT;
 851                 RETVAL = MY_CXT.dummy == 42;
 852                 ++MY_CXT.dummy;
 853         OUTPUT:
 854                 RETVAL
 855
 856 int
 857 MY_CXT_2()
 858         CODE:
 859                 dMY_CXT;
 860                 RETVAL = MY_CXT.dummy == 43;
 861         OUTPUT:
 862                 RETVAL
 863
 864 int
 865 MY_CXT_CLONE()
 866         CODE:
 867                 MY_CXT_CLONE;
 868                 RETVAL = 42;
 869         OUTPUT:
 870                 RETVAL
 871
 872 ##----------------------------------------------------------------------
 873 ##  XSUBs from parts/inc/newCONSTSUB
 874 ##----------------------------------------------------------------------
 875
 876 void
 877 call_newCONSTSUB_1()
 878
 879 void
 880 call_newCONSTSUB_2()
 881
 882 void
 883 call_newCONSTSUB_3()
 884
 885 ##----------------------------------------------------------------------
 886 ##  XSUBs from parts/inc/newRV
 887 ##----------------------------------------------------------------------
 888
 889 U32
 890 newRV_inc_REFCNT()
 891         PREINIT:
 892                 SV *sv, *rv;
 893         CODE:
 894                 sv = newSViv(42);
 895                 rv = newRV_inc(sv);
 896                 SvREFCNT_dec(sv);
 897                 RETVAL = SvREFCNT(sv);
 898                 sv_2mortal(rv);
 899         OUTPUT:
 900                 RETVAL
 901
 902 U32
 903 newRV_noinc_REFCNT()
 904         PREINIT:
 905                 SV *sv, *rv;
 906         CODE:
 907                 sv = newSViv(42);
 908                 rv = newRV_noinc(sv);
 909                 RETVAL = SvREFCNT(sv);
 910                 sv_2mortal(rv);
 911         OUTPUT:
 912                 RETVAL
 913
 914 ##----------------------------------------------------------------------
 915 ##  XSUBs from parts/inc/pvs
 916 ##----------------------------------------------------------------------
 917
 918 void
 919 newSVpvs()
 920         PPCODE:
 921                 XPUSHs(newSVpvs("newSVpvs"));
 922                 XSRETURN(1);
 923
 924 void
 925 sv_catpvs(sv)
 926         SV *sv
 927         PPCODE:
 928                 sv_catpvs(sv, "sv_catpvs");
 929
 930 void
 931 sv_setpvs(sv)
 932         SV *sv
 933         PPCODE:
 934                 sv_setpvs(sv, "sv_setpvs");
 935
 936 void
 937 hv_fetchs(hv)
 938         SV *hv
 939         PREINIT:
 940                 SV **s;
 941         PPCODE:
 942                 s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0);
 943                 XPUSHs(sv_mortalcopy(*s));
 944                 XSRETURN(1);
 945
 946 void
 947 hv_stores(hv, sv)
 948         SV *hv
 949         SV *sv
 950         PPCODE:
 951                 hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc(sv), 0);
 952
 953 ##----------------------------------------------------------------------
 954 ##  XSUBs from parts/inc/snprintf
 955 ##----------------------------------------------------------------------
 956
 957 void
 958 my_snprintf()
 959         PREINIT:
 960                 char buf[128];
 961                 int len;
 962         PPCODE:
 963                 len = my_snprintf(buf, sizeof buf, "foo%s%d", "bar", 42);
 964                 XPUSHs(newSViv(len));
 965                 XPUSHs(newSVpv(buf, 0));
 966                 XSRETURN(2);
 967
 968 ##----------------------------------------------------------------------
 969 ##  XSUBs from parts/inc/Sv_set
 970 ##----------------------------------------------------------------------
 971
 972 IV
 973 TestSvUV_set(sv, val)
 974         SV *sv
 975         UV val
 976         CODE:
 977                 SvUV_set(sv, val);
 978                 RETVAL = SvUVX(sv) == val ? 42 : -1;
 979         OUTPUT:
 980                 RETVAL
 981
 982 IV
 983 TestSvPVX_const(sv)
 984         SV *sv
 985         CODE:
 986                 RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1;
 987         OUTPUT:
 988                 RETVAL
 989
 990 IV
 991 TestSvPVX_mutable(sv)
 992         SV *sv
 993         CODE:
 994                 RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1;
 995         OUTPUT:
 996                 RETVAL
 997
 998 void
 999 TestSvSTASH_set(sv, name)
1000         SV *sv
1001         char *name
1002         CODE:
1003                 sv = SvRV(sv);
1004                 SvREFCNT_dec(SvSTASH(sv));
1005                 SvSTASH_set(sv, (HV*) SvREFCNT_inc(gv_stashpv(name, 0)));
1006
1007 ##----------------------------------------------------------------------
1008 ##  XSUBs from parts/inc/sv_xpvf
1009 ##----------------------------------------------------------------------
1010
1011 SV *
1012 vnewSVpvf()
1013         CODE:
1014                 RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
1015         OUTPUT:
1016                 RETVAL
1017
1018 SV *
1019 sv_vcatpvf(sv)
1020         SV *sv
1021         CODE:
1022                 RETVAL = newSVsv(sv);
1023                 test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
1024         OUTPUT:
1025                 RETVAL
1026
1027 SV *
1028 sv_vsetpvf(sv)
1029         SV *sv
1030         CODE:
1031                 RETVAL = newSVsv(sv);
1032                 test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
1033         OUTPUT:
1034                 RETVAL
1035
1036 void
1037 sv_catpvf_mg(sv)
1038         SV *sv
1039         CODE:
1040 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
1041                 sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
1042 #endif
1043
1044 void
1045 Perl_sv_catpvf_mg(sv)
1046         SV *sv
1047         CODE:
1048 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
1049                 Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
1050 #endif
1051
1052 void
1053 sv_catpvf_mg_nocontext(sv)
1054         SV *sv
1055         CODE:
1056 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
1057 #ifdef PERL_IMPLICIT_CONTEXT
1058                 sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
1059 #else
1060                 sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
1061 #endif
1062 #endif
1063
1064 void
1065 sv_setpvf_mg(sv)
1066         SV *sv
1067         CODE:
1068 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
1069                 sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
1070 #endif
1071
1072 void
1073 Perl_sv_setpvf_mg(sv)
1074         SV *sv
1075         CODE:
1076 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
1077                 Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
1078 #endif
1079
1080 void
1081 sv_setpvf_mg_nocontext(sv)
1082         SV *sv
1083         CODE:
1084 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
1085 #ifdef PERL_IMPLICIT_CONTEXT
1086                 sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
1087 #else
1088                 sv_setpvf_mg(sv, "%s-%d", "bar", 44);
1089 #endif
1090 #endif
1091
1092 ##----------------------------------------------------------------------
1093 ##  XSUBs from parts/inc/SvPV
1094 ##----------------------------------------------------------------------
1095
1096 IV
1097 SvPVbyte(sv)
1098         SV *sv
1099         PREINIT:
1100                 STRLEN len;
1101                 const char *str;
1102         CODE:
1103                 str = SvPVbyte(sv, len);
1104                 RETVAL = strEQ(str, "mhx") ? (IV) len : (IV) -1;
1105         OUTPUT:
1106                 RETVAL
1107
1108 IV
1109 SvPV_nolen(sv)
1110         SV *sv
1111         PREINIT:
1112                 const char *str;
1113         CODE:
1114                 str = SvPV_nolen(sv);
1115                 RETVAL = strEQ(str, "mhx") ? 42 : 0;
1116         OUTPUT:
1117                 RETVAL
1118
1119 ##----------------------------------------------------------------------
1120 ##  XSUBs from parts/inc/threads
1121 ##----------------------------------------------------------------------
1122
1123 IV
1124 no_THX_arg(sv)
1125         SV *sv
1126         CODE:
1127                 RETVAL = 1 + sv_2iv(sv);
1128         OUTPUT:
1129                 RETVAL
1130
1131 void
1132 with_THX_arg(error)
1133         char *error
1134         PPCODE:
1135                 Perl_croak(aTHX_ "%s", error);
1136
1137 ##----------------------------------------------------------------------
1138 ##  XSUBs from parts/inc/uv
1139 ##----------------------------------------------------------------------
1140
1141 SV *
1142 sv_setuv(uv)
1143         UV uv
1144         CODE:
1145                 RETVAL = newSViv(1);
1146                 sv_setuv(RETVAL, uv);
1147         OUTPUT:
1148                 RETVAL
1149
1150 SV *
1151 newSVuv(uv)
1152         UV uv
1153         CODE:
1154                 RETVAL = newSVuv(uv);
1155         OUTPUT:
1156                 RETVAL
1157
1158 UV
1159 sv_2uv(sv)
1160         SV *sv
1161         CODE:
1162                 RETVAL = sv_2uv(sv);
1163         OUTPUT:
1164                 RETVAL
1165
1166 UV
1167 SvUVx(sv)
1168         SV *sv
1169         CODE:
1170                 sv--;
1171                 RETVAL = SvUVx(++sv);
1172         OUTPUT:
1173                 RETVAL
1174
1175 void
1176 XSRETURN_UV()
1177         PPCODE:
1178                 XSRETURN_UV(42);
1179
1180 void
1181 PUSHu()
1182         PREINIT:
1183                 dTARG;
1184         PPCODE:
1185                 TARG = sv_newmortal();
1186                 EXTEND(SP, 1);
1187                 PUSHu(42);
1188                 XSRETURN(1);
1189
1190 void
1191 XPUSHu()
1192         PREINIT:
1193                 dTARG;
1194         PPCODE:
1195                 TARG = sv_newmortal();
1196                 XPUSHu(43);
1197                 XSRETURN(1);
1198
1199 ##----------------------------------------------------------------------
1200 ##  XSUBs from parts/inc/variables
1201 ##----------------------------------------------------------------------
1202
1203 int
1204 compare_PL_signals()
1205         CODE:
1206                 {
1207                   U32 ref = get_PL_signals_1();
1208                   RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
1209                 }
1210         OUTPUT:
1211                 RETVAL
1212
1213 ##----------------------------------------------------------------------
1214 ##  XSUBs from parts/inc/warn
1215 ##----------------------------------------------------------------------
1216
1217 void
1218 warner()
1219         CODE:
1220 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
1221                 warner(packWARN(WARN_MISC), "warner %s:%d", "bar", 42);
1222 #endif
1223
1224 void
1225 Perl_warner()
1226         CODE:
1227 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
1228                 Perl_warner(aTHX_ packWARN(WARN_MISC), "Perl_warner %s:%d", "bar", 42);
1229 #endif
1230
1231 void
1232 Perl_warner_nocontext()
1233         CODE:
1234 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
1235                 Perl_warner_nocontext(packWARN(WARN_MISC), "Perl_warner_nocontext %s:%d", "bar", 42);
1236 #endif
1237
1238 void
1239 ckWARN()
1240         CODE:
1241 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
1242                 if (ckWARN(WARN_MISC))
1243                   Perl_warner_nocontext(packWARN(WARN_MISC), "ckWARN %s:%d", "bar", 42);
1244 #endif