ext/XS-APItest/APItest.xs

   1 #define PERL_IN_XS_APITEST
   2 #include "EXTERN.h"
   3 #include "perl.h"
   4 #include "XSUB.h"
   5
   6 typedef SV *SVREF;
   7 typedef PTR_TBL_t *XS__APItest__PtrTable;
   8
   9 #define croak_fail() croak("fail at " __FILE__ " line %d", __LINE__)
  10 #define croak_fail_ne(h, w) croak("fail %p!=%p at " __FILE__ " line %d", (h), (w), __LINE__)
  11
  12 /* for my_cxt tests */
  13
  14 #define MY_CXT_KEY "XS::APItest::_guts" XS_VERSION
  15
  16 typedef struct {
  17     int i;
  18     SV *sv;
  19     GV *cscgv;
  20     AV *cscav;
  21     AV *bhkav;
  22     bool bhk_record;
  23     peep_t orig_peep;
  24     peep_t orig_rpeep;
  25     int peep_recording;
  26     AV *peep_recorder;
  27     AV *rpeep_recorder;
  28     AV *xop_record;
  29 } my_cxt_t;
  30
  31 START_MY_CXT
  32
  33 MGVTBL vtbl_foo, vtbl_bar;
  34
  35 /* indirect functions to test the [pa]MY_CXT macros */
  36
  37 int
  38 my_cxt_getint_p(pMY_CXT)
  39 {
  40     return MY_CXT.i;
  41 }
  42
  43 void
  44 my_cxt_setint_p(pMY_CXT_ int i)
  45 {
  46     MY_CXT.i = i;
  47 }
  48
  49 SV*
  50 my_cxt_getsv_interp_context(void)
  51 {
  52     dTHX;
  53     dMY_CXT_INTERP(my_perl);
  54     return MY_CXT.sv;
  55 }
  56
  57 SV*
  58 my_cxt_getsv_interp(void)
  59 {
  60     dMY_CXT;
  61     return MY_CXT.sv;
  62 }
  63
  64 void
  65 my_cxt_setsv_p(SV* sv _pMY_CXT)
  66 {
  67     MY_CXT.sv = sv;
  68 }
  69
  70
  71 /* from exception.c */
  72 int apitest_exception(int);
  73
  74 /* from core_or_not.inc */
  75 bool sv_setsv_cow_hashkey_core(void);
  76 bool sv_setsv_cow_hashkey_notcore(void);
  77
  78 /* A routine to test hv_delayfree_ent
  79    (which itself is tested by testing on hv_free_ent  */
  80
  81 typedef void (freeent_function)(pTHX_ HV *, HE *);
  82
  83 void
  84 test_freeent(freeent_function *f) {
  85     dTHX;
  86     dSP;
  87     HV *test_hash = newHV();
  88     HE *victim;
  89     SV *test_scalar;
  90     U32 results[4];
  91     int i;
  92
  93 #ifdef PURIFY
  94     victim = (HE*)safemalloc(sizeof(HE));
  95 #else
  96     /* Storing then deleting something should ensure that a hash entry is
  97        available.  */
  98     (void) hv_store(test_hash, "", 0, &PL_sv_yes, 0);
  99     (void) hv_delete(test_hash, "", 0, 0);
 100
 101     /* We need to "inline" new_he here as it's static, and the functions we
 102        test expect to be able to call del_HE on the HE  */
 103     if (!PL_body_roots[HE_SVSLOT])
 104         croak("PL_he_root is 0");
 105     victim = (HE*) PL_body_roots[HE_SVSLOT];
 106     PL_body_roots[HE_SVSLOT] = HeNEXT(victim);
 107 #endif
 108
 109     victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);
 110
 111     test_scalar = newSV(0);
 112     SvREFCNT_inc(test_scalar);
 113     HeVAL(victim) = test_scalar;
 114
 115     /* Need this little game else we free the temps on the return stack.  */
 116     results[0] = SvREFCNT(test_scalar);
 117     SAVETMPS;
 118     results[1] = SvREFCNT(test_scalar);
 119     f(aTHX_ test_hash, victim);
 120     results[2] = SvREFCNT(test_scalar);
 121     FREETMPS;
 122     results[3] = SvREFCNT(test_scalar);
 123
 124     i = 0;
 125     do {
 126         mPUSHu(results[i]);
 127     } while (++i < (int)(sizeof(results)/sizeof(results[0])));
 128
 129     /* Goodbye to our extra reference.  */
 130     SvREFCNT_dec(test_scalar);
 131 }
 132
 133
 134 static I32
 135 bitflip_key(pTHX_ IV action, SV *field) {
 136     MAGIC *mg = mg_find(field, PERL_MAGIC_uvar);
 137     SV *keysv;
 138     PERL_UNUSED_ARG(action);
 139     if (mg && (keysv = mg->mg_obj)) {
 140         STRLEN len;
 141         const char *p = SvPV(keysv, len);
 142
 143         if (len) {
 144             SV *newkey = newSV(len);
 145             char *new_p = SvPVX(newkey);
 146
 147             if (SvUTF8(keysv)) {
 148                 const char *const end = p + len;
 149                 while (p < end) {
 150                     STRLEN len;
 151                     UV chr = utf8_to_uvchr_buf((U8 *)p, (U8 *) end, &len);
 152                     new_p = (char *)uvchr_to_utf8((U8 *)new_p, chr ^ 32);
 153                     p += len;
 154                 }
 155                 SvUTF8_on(newkey);
 156             } else {
 157                 while (len--)
 158                     *new_p++ = *p++ ^ 32;
 159             }
 160             *new_p = '\0';
 161             SvCUR_set(newkey, SvCUR(keysv));
 162             SvPOK_on(newkey);
 163
 164             mg->mg_obj = newkey;
 165         }
 166     }
 167     return 0;
 168 }
 169
 170 static I32
 171 rot13_key(pTHX_ IV action, SV *field) {
 172     MAGIC *mg = mg_find(field, PERL_MAGIC_uvar);
 173     SV *keysv;
 174     PERL_UNUSED_ARG(action);
 175     if (mg && (keysv = mg->mg_obj)) {
 176         STRLEN len;
 177         const char *p = SvPV(keysv, len);
 178
 179         if (len) {
 180             SV *newkey = newSV(len);
 181             char *new_p = SvPVX(newkey);
 182
 183             /* There's a deliberate fencepost error here to loop len + 1 times
 184                to copy the trailing \0  */
 185             do {
 186                 char new_c = *p++;
 187                 /* Try doing this cleanly and clearly in EBCDIC another way: */
 188                 switch (new_c) {
 189                 case 'A': new_c = 'N'; break;
 190                 case 'B': new_c = 'O'; break;
 191                 case 'C': new_c = 'P'; break;
 192                 case 'D': new_c = 'Q'; break;
 193                 case 'E': new_c = 'R'; break;
 194                 case 'F': new_c = 'S'; break;
 195                 case 'G': new_c = 'T'; break;
 196                 case 'H': new_c = 'U'; break;
 197                 case 'I': new_c = 'V'; break;
 198                 case 'J': new_c = 'W'; break;
 199                 case 'K': new_c = 'X'; break;
 200                 case 'L': new_c = 'Y'; break;
 201                 case 'M': new_c = 'Z'; break;
 202                 case 'N': new_c = 'A'; break;
 203                 case 'O': new_c = 'B'; break;
 204                 case 'P': new_c = 'C'; break;
 205                 case 'Q': new_c = 'D'; break;
 206                 case 'R': new_c = 'E'; break;
 207                 case 'S': new_c = 'F'; break;
 208                 case 'T': new_c = 'G'; break;
 209                 case 'U': new_c = 'H'; break;
 210                 case 'V': new_c = 'I'; break;
 211                 case 'W': new_c = 'J'; break;
 212                 case 'X': new_c = 'K'; break;
 213                 case 'Y': new_c = 'L'; break;
 214                 case 'Z': new_c = 'M'; break;
 215                 case 'a': new_c = 'n'; break;
 216                 case 'b': new_c = 'o'; break;
 217                 case 'c': new_c = 'p'; break;
 218                 case 'd': new_c = 'q'; break;
 219                 case 'e': new_c = 'r'; break;
 220                 case 'f': new_c = 's'; break;
 221                 case 'g': new_c = 't'; break;
 222                 case 'h': new_c = 'u'; break;
 223                 case 'i': new_c = 'v'; break;
 224                 case 'j': new_c = 'w'; break;
 225                 case 'k': new_c = 'x'; break;
 226                 case 'l': new_c = 'y'; break;
 227                 case 'm': new_c = 'z'; break;
 228                 case 'n': new_c = 'a'; break;
 229                 case 'o': new_c = 'b'; break;
 230                 case 'p': new_c = 'c'; break;
 231                 case 'q': new_c = 'd'; break;
 232                 case 'r': new_c = 'e'; break;
 233                 case 's': new_c = 'f'; break;
 234                 case 't': new_c = 'g'; break;
 235                 case 'u': new_c = 'h'; break;
 236                 case 'v': new_c = 'i'; break;
 237                 case 'w': new_c = 'j'; break;
 238                 case 'x': new_c = 'k'; break;
 239                 case 'y': new_c = 'l'; break;
 240                 case 'z': new_c = 'm'; break;
 241                 }
 242                 *new_p++ = new_c;
 243             } while (len--);
 244             SvCUR_set(newkey, SvCUR(keysv));
 245             SvPOK_on(newkey);
 246             if (SvUTF8(keysv))
 247                 SvUTF8_on(newkey);
 248
 249             mg->mg_obj = newkey;
 250         }
 251     }
 252     return 0;
 253 }
 254
 255 STATIC I32
 256 rmagical_a_dummy(pTHX_ IV idx, SV *sv) {
 257     PERL_UNUSED_ARG(idx);
 258     PERL_UNUSED_ARG(sv);
 259     return 0;
 260 }
 261
 262 STATIC MGVTBL rmagical_b = { 0 };
 263
 264 STATIC void
 265 blockhook_csc_start(pTHX_ int full)
 266 {
 267     dMY_CXT;
 268     AV *const cur = GvAV(MY_CXT.cscgv);
 269
 270     PERL_UNUSED_ARG(full);
 271     SAVEGENERICSV(GvAV(MY_CXT.cscgv));
 272
 273     if (cur) {
 274         I32 i;
 275         AV *const new_av = newAV();
 276
 277         for (i = 0; i <= av_len(cur); i++) {
 278             av_store(new_av, i, newSVsv(*av_fetch(cur, i, 0)));
 279         }
 280
 281         GvAV(MY_CXT.cscgv) = new_av;
 282     }
 283 }
 284
 285 STATIC void
 286 blockhook_csc_pre_end(pTHX_ OP **o)
 287 {
 288     dMY_CXT;
 289
 290     PERL_UNUSED_ARG(o);
 291     /* if we hit the end of a scope we missed the start of, we need to
 292      * unconditionally clear @CSC */
 293     if (GvAV(MY_CXT.cscgv) == MY_CXT.cscav && MY_CXT.cscav) {
 294         av_clear(MY_CXT.cscav);
 295     }
 296
 297 }
 298
 299 STATIC void
 300 blockhook_test_start(pTHX_ int full)
 301 {
 302     dMY_CXT;
 303     AV *av;
 304
 305     if (MY_CXT.bhk_record) {
 306         av = newAV();
 307         av_push(av, newSVpvs("start"));
 308         av_push(av, newSViv(full));
 309         av_push(MY_CXT.bhkav, newRV_noinc(MUTABLE_SV(av)));
 310     }
 311 }
 312
 313 STATIC void
 314 blockhook_test_pre_end(pTHX_ OP **o)
 315 {
 316     dMY_CXT;
 317
 318     PERL_UNUSED_ARG(o);
 319     if (MY_CXT.bhk_record)
 320         av_push(MY_CXT.bhkav, newSVpvs("pre_end"));
 321 }
 322
 323 STATIC void
 324 blockhook_test_post_end(pTHX_ OP **o)
 325 {
 326     dMY_CXT;
 327
 328     PERL_UNUSED_ARG(o);
 329     if (MY_CXT.bhk_record)
 330         av_push(MY_CXT.bhkav, newSVpvs("post_end"));
 331 }
 332
 333 STATIC void
 334 blockhook_test_eval(pTHX_ OP *const o)
 335 {
 336     dMY_CXT;
 337     AV *av;
 338
 339     if (MY_CXT.bhk_record) {
 340         av = newAV();
 341         av_push(av, newSVpvs("eval"));
 342         av_push(av, newSVpv(OP_NAME(o), 0));
 343         av_push(MY_CXT.bhkav, newRV_noinc(MUTABLE_SV(av)));
 344     }
 345 }
 346
 347 STATIC BHK bhk_csc, bhk_test;
 348
 349 STATIC void
 350 my_peep (pTHX_ OP *o)
 351 {
 352     dMY_CXT;
 353
 354     if (!o)
 355         return;
 356
 357     MY_CXT.orig_peep(aTHX_ o);
 358
 359     if (!MY_CXT.peep_recording)
 360         return;
 361
 362     for (; o; o = o->op_next) {
 363         if (o->op_type == OP_CONST && cSVOPx_sv(o) && SvPOK(cSVOPx_sv(o))) {
 364             av_push(MY_CXT.peep_recorder, newSVsv(cSVOPx_sv(o)));
 365         }
 366     }
 367 }
 368
 369 STATIC void
 370 my_rpeep (pTHX_ OP *o)
 371 {
 372     dMY_CXT;
 373
 374     if (!o)
 375         return;
 376
 377     MY_CXT.orig_rpeep(aTHX_ o);
 378
 379     if (!MY_CXT.peep_recording)
 380         return;
 381
 382     for (; o; o = o->op_next) {
 383         if (o->op_type == OP_CONST && cSVOPx_sv(o) && SvPOK(cSVOPx_sv(o))) {
 384             av_push(MY_CXT.rpeep_recorder, newSVsv(cSVOPx_sv(o)));
 385         }
 386     }
 387 }
 388
 389 STATIC OP *
 390 THX_ck_entersub_args_lists(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 391 {
 392     PERL_UNUSED_ARG(namegv);
 393     PERL_UNUSED_ARG(ckobj);
 394     return ck_entersub_args_list(entersubop);
 395 }
 396
 397 STATIC OP *
 398 THX_ck_entersub_args_scalars(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 399 {
 400     OP *aop = cUNOPx(entersubop)->op_first;
 401     PERL_UNUSED_ARG(namegv);
 402     PERL_UNUSED_ARG(ckobj);
 403     if (!aop->op_sibling)
 404         aop = cUNOPx(aop)->op_first;
 405     for (aop = aop->op_sibling; aop->op_sibling; aop = aop->op_sibling) {
 406         op_contextualize(aop, G_SCALAR);
 407     }
 408     return entersubop;
 409 }
 410
 411 STATIC OP *
 412 THX_ck_entersub_multi_sum(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 413 {
 414     OP *sumop = NULL;
 415     OP *pushop = cUNOPx(entersubop)->op_first;
 416     PERL_UNUSED_ARG(namegv);
 417     PERL_UNUSED_ARG(ckobj);
 418     if (!pushop->op_sibling)
 419         pushop = cUNOPx(pushop)->op_first;
 420     while (1) {
 421         OP *aop = pushop->op_sibling;
 422         if (!aop->op_sibling)
 423             break;
 424         pushop->op_sibling = aop->op_sibling;
 425         aop->op_sibling = NULL;
 426         op_contextualize(aop, G_SCALAR);
 427         if (sumop) {
 428             sumop = newBINOP(OP_ADD, 0, sumop, aop);
 429         } else {
 430             sumop = aop;
 431         }
 432     }
 433     if (!sumop)
 434         sumop = newSVOP(OP_CONST, 0, newSViv(0));
 435     op_free(entersubop);
 436     return sumop;
 437 }
 438
 439 STATIC void test_op_list_describe_part(SV *res, OP *o);
 440 STATIC void
 441 test_op_list_describe_part(SV *res, OP *o)
 442 {
 443     sv_catpv(res, PL_op_name[o->op_type]);
 444     switch (o->op_type) {
 445         case OP_CONST: {
 446             sv_catpvf(res, "(%d)", (int)SvIV(cSVOPx(o)->op_sv));
 447         } break;
 448     }
 449     if (o->op_flags & OPf_KIDS) {
 450         OP *k;
 451         sv_catpvs(res, "[");
 452         for (k = cUNOPx(o)->op_first; k; k = k->op_sibling)
 453             test_op_list_describe_part(res, k);
 454         sv_catpvs(res, "]");
 455     } else {
 456         sv_catpvs(res, ".");
 457     }
 458 }
 459
 460 STATIC char *
 461 test_op_list_describe(OP *o)
 462 {
 463     SV *res = sv_2mortal(newSVpvs(""));
 464     if (o)
 465         test_op_list_describe_part(res, o);
 466     return SvPVX(res);
 467 }
 468
 469 /* the real new*OP functions have a tendency to call fold_constants, and
 470  * other such unhelpful things, so we need our own versions for testing */
 471
 472 #define mkUNOP(t, f) THX_mkUNOP(aTHX_ (t), (f))
 473 static OP *
 474 THX_mkUNOP(pTHX_ U32 type, OP *first)
 475 {
 476     UNOP *unop;
 477     NewOp(1103, unop, 1, UNOP);
 478     unop->op_type   = (OPCODE)type;
 479     unop->op_first  = first;
 480     unop->op_flags  = OPf_KIDS;
 481     return (OP *)unop;
 482 }
 483
 484 #define mkBINOP(t, f, l) THX_mkBINOP(aTHX_ (t), (f), (l))
 485 static OP *
 486 THX_mkBINOP(pTHX_ U32 type, OP *first, OP *last)
 487 {
 488     BINOP *binop;
 489     NewOp(1103, binop, 1, BINOP);
 490     binop->op_type      = (OPCODE)type;
 491     binop->op_first     = first;
 492     binop->op_flags     = OPf_KIDS;
 493     binop->op_last      = last;
 494     first->op_sibling   = last;
 495     return (OP *)binop;
 496 }
 497
 498 #define mkLISTOP(t, f, s, l) THX_mkLISTOP(aTHX_ (t), (f), (s), (l))
 499 static OP *
 500 THX_mkLISTOP(pTHX_ U32 type, OP *first, OP *sib, OP *last)
 501 {
 502     LISTOP *listop;
 503     NewOp(1103, listop, 1, LISTOP);
 504     listop->op_type     = (OPCODE)type;
 505     listop->op_flags    = OPf_KIDS;
 506     listop->op_first    = first;
 507     first->op_sibling   = sib;
 508     sib->op_sibling     = last;
 509     listop->op_last     = last;
 510     return (OP *)listop;
 511 }
 512
 513 static char *
 514 test_op_linklist_describe(OP *start)
 515 {
 516     SV *rv = sv_2mortal(newSVpvs(""));
 517     OP *o;
 518     o = start = LINKLIST(start);
 519     do {
 520         sv_catpvs(rv, ".");
 521         sv_catpv(rv, OP_NAME(o));
 522         if (o->op_type == OP_CONST)
 523             sv_catsv(rv, cSVOPo->op_sv);
 524         o = o->op_next;
 525     } while (o && o != start);
 526     return SvPVX(rv);
 527 }
 528
 529 /** establish_cleanup operator, ripped off from Scope::Cleanup **/
 530
 531 STATIC void
 532 THX_run_cleanup(pTHX_ void *cleanup_code_ref)
 533 {
 534     dSP;
 535     ENTER;
 536     SAVETMPS;
 537     PUSHMARK(SP);
 538     call_sv((SV*)cleanup_code_ref, G_VOID|G_DISCARD);
 539     FREETMPS;
 540     LEAVE;
 541 }
 542
 543 STATIC OP *
 544 THX_pp_establish_cleanup(pTHX)
 545 {
 546     dSP;
 547     SV *cleanup_code_ref;
 548     cleanup_code_ref = newSVsv(POPs);
 549     SAVEFREESV(cleanup_code_ref);
 550     SAVEDESTRUCTOR_X(THX_run_cleanup, cleanup_code_ref);
 551     if(GIMME_V != G_VOID) PUSHs(&PL_sv_undef);
 552     RETURN;
 553 }
 554
 555 STATIC OP *
 556 THX_ck_entersub_establish_cleanup(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 557 {
 558     OP *pushop, *argop, *estop;
 559     ck_entersub_args_proto(entersubop, namegv, ckobj);
 560     pushop = cUNOPx(entersubop)->op_first;
 561     if(!pushop->op_sibling) pushop = cUNOPx(pushop)->op_first;
 562     argop = pushop->op_sibling;
 563     pushop->op_sibling = argop->op_sibling;
 564     argop->op_sibling = NULL;
 565     op_free(entersubop);
 566     NewOpSz(0, estop, sizeof(UNOP));
 567     estop->op_type = OP_RAND;
 568     estop->op_ppaddr = THX_pp_establish_cleanup;
 569     cUNOPx(estop)->op_flags = OPf_KIDS;
 570     cUNOPx(estop)->op_first = argop;
 571     PL_hints |= HINT_BLOCK_SCOPE;
 572     return estop;
 573 }
 574
 575 STATIC OP *
 576 THX_ck_entersub_postinc(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 577 {
 578     OP *pushop, *argop;
 579     ck_entersub_args_proto(entersubop, namegv, ckobj);
 580     pushop = cUNOPx(entersubop)->op_first;
 581     if(!pushop->op_sibling) pushop = cUNOPx(pushop)->op_first;
 582     argop = pushop->op_sibling;
 583     pushop->op_sibling = argop->op_sibling;
 584     argop->op_sibling = NULL;
 585     op_free(entersubop);
 586     return newUNOP(OP_POSTINC, 0,
 587         op_lvalue(op_contextualize(argop, G_SCALAR), OP_POSTINC));
 588 }
 589
 590 STATIC OP *
 591 THX_ck_entersub_pad_scalar(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 592 {
 593     OP *pushop, *argop;
 594     PADOFFSET padoff = NOT_IN_PAD;
 595     SV *a0, *a1;
 596     ck_entersub_args_proto(entersubop, namegv, ckobj);
 597     pushop = cUNOPx(entersubop)->op_first;
 598     if(!pushop->op_sibling) pushop = cUNOPx(pushop)->op_first;
 599     argop = pushop->op_sibling;
 600     if(argop->op_type != OP_CONST || argop->op_sibling->op_type != OP_CONST)
 601         croak("bad argument expression type for pad_scalar()");
 602     a0 = cSVOPx_sv(argop);
 603     a1 = cSVOPx_sv(argop->op_sibling);
 604     switch(SvIV(a0)) {
 605         case 1: {
 606             SV *namesv = sv_2mortal(newSVpvs("$"));
 607             sv_catsv(namesv, a1);
 608             padoff = pad_findmy_sv(namesv, 0);
 609         } break;
 610         case 2: {
 611             char *namepv;
 612             STRLEN namelen;
 613             SV *namesv = sv_2mortal(newSVpvs("$"));
 614             sv_catsv(namesv, a1);
 615             namepv = SvPV(namesv, namelen);
 616             padoff = pad_findmy_pvn(namepv, namelen, SvUTF8(namesv));
 617         } break;
 618         case 3: {
 619             char *namepv;
 620             SV *namesv = sv_2mortal(newSVpvs("$"));
 621             sv_catsv(namesv, a1);
 622             namepv = SvPV_nolen(namesv);
 623             padoff = pad_findmy_pv(namepv, SvUTF8(namesv));
 624         } break;
 625         case 4: {
 626             padoff = pad_findmy_pvs("$foo", 0);
 627         } break;
 628         default: croak("bad type value for pad_scalar()");
 629     }
 630     op_free(entersubop);
 631     if(padoff == NOT_IN_PAD) {
 632         return newSVOP(OP_CONST, 0, newSVpvs("NOT_IN_PAD"));
 633     } else if(PAD_COMPNAME_FLAGS_isOUR(padoff)) {
 634         return newSVOP(OP_CONST, 0, newSVpvs("NOT_MY"));
 635     } else {
 636         OP *padop = newOP(OP_PADSV, 0);
 637         padop->op_targ = padoff;
 638         return padop;
 639     }
 640 }
 641
 642 /** RPN keyword parser **/
 643
 644 #define sv_is_glob(sv) (SvTYPE(sv) == SVt_PVGV)
 645 #define sv_is_regexp(sv) (SvTYPE(sv) == SVt_REGEXP)
 646 #define sv_is_string(sv) \
 647     (!sv_is_glob(sv) && !sv_is_regexp(sv) && \
 648      (SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK)))
 649
 650 static SV *hintkey_rpn_sv, *hintkey_calcrpn_sv, *hintkey_stufftest_sv;
 651 static SV *hintkey_swaptwostmts_sv, *hintkey_looprest_sv;
 652 static SV *hintkey_scopelessblock_sv;
 653 static SV *hintkey_stmtasexpr_sv, *hintkey_stmtsasexpr_sv;
 654 static SV *hintkey_loopblock_sv, *hintkey_blockasexpr_sv;
 655 static SV *hintkey_swaplabel_sv, *hintkey_labelconst_sv;
 656 static SV *hintkey_arrayfullexpr_sv, *hintkey_arraylistexpr_sv;
 657 static SV *hintkey_arraytermexpr_sv, *hintkey_arrayarithexpr_sv;
 658 static SV *hintkey_arrayexprflags_sv;
 659 static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
 660
 661 /* low-level parser helpers */
 662
 663 #define PL_bufptr (PL_parser->bufptr)
 664 #define PL_bufend (PL_parser->bufend)
 665
 666 /* RPN parser */
 667
 668 #define parse_var() THX_parse_var(aTHX)
 669 static OP *THX_parse_var(pTHX)
 670 {
 671     char *s = PL_bufptr;
 672     char *start = s;
 673     PADOFFSET varpos;
 674     OP *padop;
 675     if(*s != '$') croak("RPN syntax error");
 676     while(1) {
 677         char c = *++s;
 678         if(!isALNUM(c)) break;
 679     }
 680     if(s-start < 2) croak("RPN syntax error");
 681     lex_read_to(s);
 682     varpos = pad_findmy_pvn(start, s-start, 0);
 683     if(varpos == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(varpos))
 684         croak("RPN only supports \"my\" variables");
 685     padop = newOP(OP_PADSV, 0);
 686     padop->op_targ = varpos;
 687     return padop;
 688 }
 689
 690 #define push_rpn_item(o) \
 691     (tmpop = (o), tmpop->op_sibling = stack, stack = tmpop)
 692 #define pop_rpn_item() \
 693     (!stack ? (croak("RPN stack underflow"), (OP*)NULL) : \
 694      (tmpop = stack, stack = stack->op_sibling, \
 695       tmpop->op_sibling = NULL, tmpop))
 696
 697 #define parse_rpn_expr() THX_parse_rpn_expr(aTHX)
 698 static OP *THX_parse_rpn_expr(pTHX)
 699 {
 700     OP *stack = NULL, *tmpop;
 701     while(1) {
 702         I32 c;
 703         lex_read_space(0);
 704         c = lex_peek_unichar(0);
 705         switch(c) {
 706             case /*(*/')': case /*{*/'}': {
 707                 OP *result = pop_rpn_item();
 708                 if(stack) croak("RPN expression must return a single value");
 709                 return result;
 710             } break;
 711             case '0': case '1': case '2': case '3': case '4':
 712             case '5': case '6': case '7': case '8': case '9': {
 713                 UV val = 0;
 714                 do {
 715                     lex_read_unichar(0);
 716                     val = 10*val + (c - '0');
 717                     c = lex_peek_unichar(0);
 718                 } while(c >= '0' && c <= '9');
 719                 push_rpn_item(newSVOP(OP_CONST, 0, newSVuv(val)));
 720             } break;
 721             case '$': {
 722                 push_rpn_item(parse_var());
 723             } break;
 724             case '+': {
 725                 OP *b = pop_rpn_item();
 726                 OP *a = pop_rpn_item();
 727                 lex_read_unichar(0);
 728                 push_rpn_item(newBINOP(OP_I_ADD, 0, a, b));
 729             } break;
 730             case '-': {
 731                 OP *b = pop_rpn_item();
 732                 OP *a = pop_rpn_item();
 733                 lex_read_unichar(0);
 734                 push_rpn_item(newBINOP(OP_I_SUBTRACT, 0, a, b));
 735             } break;
 736             case '*': {
 737                 OP *b = pop_rpn_item();
 738                 OP *a = pop_rpn_item();
 739                 lex_read_unichar(0);
 740                 push_rpn_item(newBINOP(OP_I_MULTIPLY, 0, a, b));
 741             } break;
 742             case '/': {
 743                 OP *b = pop_rpn_item();
 744                 OP *a = pop_rpn_item();
 745                 lex_read_unichar(0);
 746                 push_rpn_item(newBINOP(OP_I_DIVIDE, 0, a, b));
 747             } break;
 748             case '%': {
 749                 OP *b = pop_rpn_item();
 750                 OP *a = pop_rpn_item();
 751                 lex_read_unichar(0);
 752                 push_rpn_item(newBINOP(OP_I_MODULO, 0, a, b));
 753             } break;
 754             default: {
 755                 croak("RPN syntax error");
 756             } break;
 757         }
 758     }
 759 }
 760
 761 #define parse_keyword_rpn() THX_parse_keyword_rpn(aTHX)
 762 static OP *THX_parse_keyword_rpn(pTHX)
 763 {
 764     OP *op;
 765     lex_read_space(0);
 766     if(lex_peek_unichar(0) != '('/*)*/)
 767         croak("RPN expression must be parenthesised");
 768     lex_read_unichar(0);
 769     op = parse_rpn_expr();
 770     if(lex_peek_unichar(0) != /*(*/')')
 771         croak("RPN expression must be parenthesised");
 772     lex_read_unichar(0);
 773     return op;
 774 }
 775
 776 #define parse_keyword_calcrpn() THX_parse_keyword_calcrpn(aTHX)
 777 static OP *THX_parse_keyword_calcrpn(pTHX)
 778 {
 779     OP *varop, *exprop;
 780     lex_read_space(0);
 781     varop = parse_var();
 782     lex_read_space(0);
 783     if(lex_peek_unichar(0) != '{'/*}*/)
 784         croak("RPN expression must be braced");
 785     lex_read_unichar(0);
 786     exprop = parse_rpn_expr();
 787     if(lex_peek_unichar(0) != /*{*/'}')
 788         croak("RPN expression must be braced");
 789     lex_read_unichar(0);
 790     return newASSIGNOP(OPf_STACKED, varop, 0, exprop);
 791 }
 792
 793 #define parse_keyword_stufftest() THX_parse_keyword_stufftest(aTHX)
 794 static OP *THX_parse_keyword_stufftest(pTHX)
 795 {
 796     I32 c;
 797     bool do_stuff;
 798     lex_read_space(0);
 799     do_stuff = lex_peek_unichar(0) == '+';
 800     if(do_stuff) {
 801         lex_read_unichar(0);
 802         lex_read_space(0);
 803     }
 804     c = lex_peek_unichar(0);
 805     if(c == ';') {
 806         lex_read_unichar(0);
 807     } else if(c != /*{*/'}') {
 808         croak("syntax error");
 809     }
 810     if(do_stuff) lex_stuff_pvs(" ", 0);
 811     return newOP(OP_NULL, 0);
 812 }
 813
 814 #define parse_keyword_swaptwostmts() THX_parse_keyword_swaptwostmts(aTHX)
 815 static OP *THX_parse_keyword_swaptwostmts(pTHX)
 816 {
 817     OP *a, *b;
 818     a = parse_fullstmt(0);
 819     b = parse_fullstmt(0);
 820     if(a && b)
 821         PL_hints |= HINT_BLOCK_SCOPE;
 822     return op_append_list(OP_LINESEQ, b, a);
 823 }
 824
 825 #define parse_keyword_looprest() THX_parse_keyword_looprest(aTHX)
 826 static OP *THX_parse_keyword_looprest(pTHX)
 827 {
 828     return newWHILEOP(0, 1, NULL, newSVOP(OP_CONST, 0, &PL_sv_yes),
 829                         parse_stmtseq(0), NULL, 1);
 830 }
 831
 832 #define parse_keyword_scopelessblock() THX_parse_keyword_scopelessblock(aTHX)
 833 static OP *THX_parse_keyword_scopelessblock(pTHX)
 834 {
 835     I32 c;
 836     OP *body;
 837     lex_read_space(0);
 838     if(lex_peek_unichar(0) != '{'/*}*/) croak("syntax error");
 839     lex_read_unichar(0);
 840     body = parse_stmtseq(0);
 841     c = lex_peek_unichar(0);
 842     if(c != /*{*/'}' && c != /*[*/']' && c != /*(*/')') croak("syntax error");
 843     lex_read_unichar(0);
 844     return body;
 845 }
 846
 847 #define parse_keyword_stmtasexpr() THX_parse_keyword_stmtasexpr(aTHX)
 848 static OP *THX_parse_keyword_stmtasexpr(pTHX)
 849 {
 850     OP *o = parse_barestmt(0);
 851     if (!o) o = newOP(OP_STUB, 0);
 852     if (PL_hints & HINT_BLOCK_SCOPE) o->op_flags |= OPf_PARENS;
 853     return op_scope(o);
 854 }
 855
 856 #define parse_keyword_stmtsasexpr() THX_parse_keyword_stmtsasexpr(aTHX)
 857 static OP *THX_parse_keyword_stmtsasexpr(pTHX)
 858 {
 859     OP *o;
 860     lex_read_space(0);
 861     if(lex_peek_unichar(0) != '{'/*}*/) croak("syntax error");
 862     lex_read_unichar(0);
 863     o = parse_stmtseq(0);
 864     lex_read_space(0);
 865     if(lex_peek_unichar(0) != /*{*/'}') croak("syntax error");
 866     lex_read_unichar(0);
 867     if (!o) o = newOP(OP_STUB, 0);
 868     if (PL_hints & HINT_BLOCK_SCOPE) o->op_flags |= OPf_PARENS;
 869     return op_scope(o);
 870 }
 871
 872 #define parse_keyword_loopblock() THX_parse_keyword_loopblock(aTHX)
 873 static OP *THX_parse_keyword_loopblock(pTHX)
 874 {
 875     return newWHILEOP(0, 1, NULL, newSVOP(OP_CONST, 0, &PL_sv_yes),
 876                         parse_block(0), NULL, 1);
 877 }
 878
 879 #define parse_keyword_blockasexpr() THX_parse_keyword_blockasexpr(aTHX)
 880 static OP *THX_parse_keyword_blockasexpr(pTHX)
 881 {
 882     OP *o = parse_block(0);
 883     if (!o) o = newOP(OP_STUB, 0);
 884     if (PL_hints & HINT_BLOCK_SCOPE) o->op_flags |= OPf_PARENS;
 885     return op_scope(o);
 886 }
 887
 888 #define parse_keyword_swaplabel() THX_parse_keyword_swaplabel(aTHX)
 889 static OP *THX_parse_keyword_swaplabel(pTHX)
 890 {
 891     OP *sop = parse_barestmt(0);
 892     SV *label = parse_label(PARSE_OPTIONAL);
 893     if (label) sv_2mortal(label);
 894     return newSTATEOP(label ? SvUTF8(label) : 0,
 895                       label ? savepv(SvPVX(label)) : NULL,
 896                       sop);
 897 }
 898
 899 #define parse_keyword_labelconst() THX_parse_keyword_labelconst(aTHX)
 900 static OP *THX_parse_keyword_labelconst(pTHX)
 901 {
 902     return newSVOP(OP_CONST, 0, parse_label(0));
 903 }
 904
 905 #define parse_keyword_arrayfullexpr() THX_parse_keyword_arrayfullexpr(aTHX)
 906 static OP *THX_parse_keyword_arrayfullexpr(pTHX)
 907 {
 908     return newANONLIST(parse_fullexpr(0));
 909 }
 910
 911 #define parse_keyword_arraylistexpr() THX_parse_keyword_arraylistexpr(aTHX)
 912 static OP *THX_parse_keyword_arraylistexpr(pTHX)
 913 {
 914     return newANONLIST(parse_listexpr(0));
 915 }
 916
 917 #define parse_keyword_arraytermexpr() THX_parse_keyword_arraytermexpr(aTHX)
 918 static OP *THX_parse_keyword_arraytermexpr(pTHX)
 919 {
 920     return newANONLIST(parse_termexpr(0));
 921 }
 922
 923 #define parse_keyword_arrayarithexpr() THX_parse_keyword_arrayarithexpr(aTHX)
 924 static OP *THX_parse_keyword_arrayarithexpr(pTHX)
 925 {
 926     return newANONLIST(parse_arithexpr(0));
 927 }
 928
 929 #define parse_keyword_arrayexprflags() THX_parse_keyword_arrayexprflags(aTHX)
 930 static OP *THX_parse_keyword_arrayexprflags(pTHX)
 931 {
 932     U32 flags = 0;
 933     I32 c;
 934     OP *o;
 935     lex_read_space(0);
 936     c = lex_peek_unichar(0);
 937     if (c != '!' && c != '?') croak("syntax error");
 938     lex_read_unichar(0);
 939     if (c == '?') flags |= PARSE_OPTIONAL;
 940     o = parse_listexpr(flags);
 941     return o ? newANONLIST(o) : newANONHASH(newOP(OP_STUB, 0));
 942 }
 943
 944 /* plugin glue */
 945
 946 #define keyword_active(hintkey_sv) THX_keyword_active(aTHX_ hintkey_sv)
 947 static int THX_keyword_active(pTHX_ SV *hintkey_sv)
 948 {
 949     HE *he;
 950     if(!GvHV(PL_hintgv)) return 0;
 951     he = hv_fetch_ent(GvHV(PL_hintgv), hintkey_sv, 0,
 952                 SvSHARED_HASH(hintkey_sv));
 953     return he && SvTRUE(HeVAL(he));
 954 }
 955
 956 static int my_keyword_plugin(pTHX_
 957     char *keyword_ptr, STRLEN keyword_len, OP **op_ptr)
 958 {
 959     if(keyword_len == 3 && strnEQ(keyword_ptr, "rpn", 3) &&
 960                     keyword_active(hintkey_rpn_sv)) {
 961         *op_ptr = parse_keyword_rpn();
 962         return KEYWORD_PLUGIN_EXPR;
 963     } else if(keyword_len == 7 && strnEQ(keyword_ptr, "calcrpn", 7) &&
 964                     keyword_active(hintkey_calcrpn_sv)) {
 965         *op_ptr = parse_keyword_calcrpn();
 966         return KEYWORD_PLUGIN_STMT;
 967     } else if(keyword_len == 9 && strnEQ(keyword_ptr, "stufftest", 9) &&
 968                     keyword_active(hintkey_stufftest_sv)) {
 969         *op_ptr = parse_keyword_stufftest();
 970         return KEYWORD_PLUGIN_STMT;
 971     } else if(keyword_len == 12 &&
 972                     strnEQ(keyword_ptr, "swaptwostmts", 12) &&
 973                     keyword_active(hintkey_swaptwostmts_sv)) {
 974         *op_ptr = parse_keyword_swaptwostmts();
 975         return KEYWORD_PLUGIN_STMT;
 976     } else if(keyword_len == 8 && strnEQ(keyword_ptr, "looprest", 8) &&
 977                     keyword_active(hintkey_looprest_sv)) {
 978         *op_ptr = parse_keyword_looprest();
 979         return KEYWORD_PLUGIN_STMT;
 980     } else if(keyword_len == 14 && strnEQ(keyword_ptr, "scopelessblock", 14) &&
 981                     keyword_active(hintkey_scopelessblock_sv)) {
 982         *op_ptr = parse_keyword_scopelessblock();
 983         return KEYWORD_PLUGIN_STMT;
 984     } else if(keyword_len == 10 && strnEQ(keyword_ptr, "stmtasexpr", 10) &&
 985                     keyword_active(hintkey_stmtasexpr_sv)) {
 986         *op_ptr = parse_keyword_stmtasexpr();
 987         return KEYWORD_PLUGIN_EXPR;
 988     } else if(keyword_len == 11 && strnEQ(keyword_ptr, "stmtsasexpr", 11) &&
 989                     keyword_active(hintkey_stmtsasexpr_sv)) {
 990         *op_ptr = parse_keyword_stmtsasexpr();
 991         return KEYWORD_PLUGIN_EXPR;
 992     } else if(keyword_len == 9 && strnEQ(keyword_ptr, "loopblock", 9) &&
 993                     keyword_active(hintkey_loopblock_sv)) {
 994         *op_ptr = parse_keyword_loopblock();
 995         return KEYWORD_PLUGIN_STMT;
 996     } else if(keyword_len == 11 && strnEQ(keyword_ptr, "blockasexpr", 11) &&
 997                     keyword_active(hintkey_blockasexpr_sv)) {
 998         *op_ptr = parse_keyword_blockasexpr();
 999         return KEYWORD_PLUGIN_EXPR;
1000     } else if(keyword_len == 9 && strnEQ(keyword_ptr, "swaplabel", 9) &&
1001                     keyword_active(hintkey_swaplabel_sv)) {
1002         *op_ptr = parse_keyword_swaplabel();
1003         return KEYWORD_PLUGIN_STMT;
1004     } else if(keyword_len == 10 && strnEQ(keyword_ptr, "labelconst", 10) &&
1005                     keyword_active(hintkey_labelconst_sv)) {
1006         *op_ptr = parse_keyword_labelconst();
1007         return KEYWORD_PLUGIN_EXPR;
1008     } else if(keyword_len == 13 && strnEQ(keyword_ptr, "arrayfullexpr", 13) &&
1009                     keyword_active(hintkey_arrayfullexpr_sv)) {
1010         *op_ptr = parse_keyword_arrayfullexpr();
1011         return KEYWORD_PLUGIN_EXPR;
1012     } else if(keyword_len == 13 && strnEQ(keyword_ptr, "arraylistexpr", 13) &&
1013                     keyword_active(hintkey_arraylistexpr_sv)) {
1014         *op_ptr = parse_keyword_arraylistexpr();
1015         return KEYWORD_PLUGIN_EXPR;
1016     } else if(keyword_len == 13 && strnEQ(keyword_ptr, "arraytermexpr", 13) &&
1017                     keyword_active(hintkey_arraytermexpr_sv)) {
1018         *op_ptr = parse_keyword_arraytermexpr();
1019         return KEYWORD_PLUGIN_EXPR;
1020     } else if(keyword_len == 14 && strnEQ(keyword_ptr, "arrayarithexpr", 14) &&
1021                     keyword_active(hintkey_arrayarithexpr_sv)) {
1022         *op_ptr = parse_keyword_arrayarithexpr();
1023         return KEYWORD_PLUGIN_EXPR;
1024     } else if(keyword_len == 14 && strnEQ(keyword_ptr, "arrayexprflags", 14) &&
1025                     keyword_active(hintkey_arrayexprflags_sv)) {
1026         *op_ptr = parse_keyword_arrayexprflags();
1027         return KEYWORD_PLUGIN_EXPR;
1028     } else {
1029         return next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
1030     }
1031 }
1032
1033 static XOP my_xop;
1034
1035 static OP *
1036 pp_xop(pTHX)
1037 {
1038     return PL_op->op_next;
1039 }
1040
1041 static void
1042 peep_xop(pTHX_ OP *o, OP *oldop)
1043 {
1044     dMY_CXT;
1045     av_push(MY_CXT.xop_record, newSVpvf("peep:%"UVxf, PTR2UV(o)));
1046     av_push(MY_CXT.xop_record, newSVpvf("oldop:%"UVxf, PTR2UV(oldop)));
1047 }
1048
1049 static I32
1050 filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
1051 {
1052     char *p;
1053     char *end;
1054     int n = FILTER_READ(idx + 1, buf_sv, maxlen);
1055
1056     if (n<=0) return n;
1057
1058     p = SvPV_force_nolen(buf_sv);
1059     end = p + SvCUR(buf_sv);
1060     while (p < end) {
1061         if (*p == 'o') *p = 'e';
1062         p++;
1063     }
1064     return SvCUR(buf_sv);
1065 }
1066
1067 static AV *
1068 myget_linear_isa(pTHX_ HV *stash, U32 level) {
1069     GV **gvp = (GV **)hv_fetchs(stash, "ISA", 0);
1070     PERL_UNUSED_ARG(level);
1071     return gvp && *gvp && GvAV(*gvp)
1072          ? GvAV(*gvp)
1073          : (AV *)sv_2mortal((SV *)newAV());
1074 }
1075
1076
1077 XS_EXTERNAL(XS_XS__APItest__XSUB_XS_VERSION_undef);
1078 XS_EXTERNAL(XS_XS__APItest__XSUB_XS_VERSION_empty);
1079 XS_EXTERNAL(XS_XS__APItest__XSUB_XS_APIVERSION_invalid);
1080
1081 static struct mro_alg mymro;
1082
1083 static Perl_check_t addissub_nxck_add;
1084
1085 static OP *
1086 addissub_myck_add(pTHX_ OP *op)
1087 {
1088     SV **flag_svp = hv_fetchs(GvHV(PL_hintgv), "XS::APItest/addissub", 0);
1089     OP *aop, *bop;
1090     U8 flags;
1091     if (!(flag_svp && SvTRUE(*flag_svp) && (op->op_flags & OPf_KIDS) &&
1092             (aop = cBINOPx(op)->op_first) && (bop = aop->op_sibling) &&
1093             !bop->op_sibling))
1094         return addissub_nxck_add(aTHX_ op);
1095     aop->op_sibling = NULL;
1096     cBINOPx(op)->op_first = NULL;
1097     op->op_flags &= ~OPf_KIDS;
1098     flags = op->op_flags;
1099     op_free(op);
1100     return newBINOP(OP_SUBTRACT, flags, aop, bop);
1101 }
1102
1103 static Perl_check_t old_ck_rv2cv;
1104
1105 static OP *
1106 my_ck_rv2cv(pTHX_ OP *o)
1107 {
1108     SV *ref;
1109     SV **flag_svp = hv_fetchs(GvHV(PL_hintgv), "XS::APItest/addunder", 0);
1110     OP *aop;
1111
1112     if (flag_svp && SvTRUE(*flag_svp) && (o->op_flags & OPf_KIDS)
1113      && (aop = cUNOPx(o)->op_first) && aop->op_type == OP_CONST
1114      && aop->op_private & (OPpCONST_ENTERED|OPpCONST_BARE)
1115      && (ref = cSVOPx(aop)->op_sv) && SvPOK(ref) && SvCUR(ref)
1116      && *(SvEND(ref)-1) == 'o')
1117     {
1118         SvGROW(ref, SvCUR(ref)+2);
1119         *SvEND(ref) = '_';
1120         SvCUR(ref)++;
1121         *SvEND(ref) = '\0';
1122     }
1123     return old_ck_rv2cv(aTHX_ o);
1124 }
1125
1126 #include "const-c.inc"
1127
1128 MODULE = XS::APItest            PACKAGE = XS::APItest
1129
1130 INCLUDE: const-xs.inc
1131
1132 INCLUDE: numeric.xs
1133
1134 MODULE = XS::APItest::utf8      PACKAGE = XS::APItest::utf8
1135
1136 int
1137 bytes_cmp_utf8(bytes, utf8)
1138         SV *bytes
1139         SV *utf8
1140     PREINIT:
1141         const U8 *b;
1142         STRLEN blen;
1143         const U8 *u;
1144         STRLEN ulen;
1145     CODE:
1146         b = (const U8 *)SvPVbyte(bytes, blen);
1147         u = (const U8 *)SvPVbyte(utf8, ulen);
1148         RETVAL = bytes_cmp_utf8(b, blen, u, ulen);
1149     OUTPUT:
1150         RETVAL
1151
1152 AV *
1153 test_utf8n_to_uvchr(s, len, flags)
1154
1155         SV *s
1156         SV *len
1157         SV *flags
1158     PREINIT:
1159         STRLEN retlen;
1160         UV ret;
1161         STRLEN slen;
1162
1163     CODE:
1164         /* Call utf8n_to_uvchr() with the inputs.  It always asks for the
1165          * actual length to be returned
1166          *
1167          * Length to assume <s> is; not checked, so could have buffer overflow
1168          */
1169         RETVAL = newAV();
1170         sv_2mortal((SV*)RETVAL);
1171
1172         ret
1173          = utf8n_to_uvchr((U8*) SvPV(s, slen), SvUV(len), &retlen, SvUV(flags));
1174
1175         /* Returns the return value in [0]; <retlen> in [1] */
1176         av_push(RETVAL, newSVuv(ret));
1177         if (retlen == (STRLEN) -1) {
1178             av_push(RETVAL, newSViv(-1));
1179         }
1180         else {
1181             av_push(RETVAL, newSVuv(retlen));
1182         }
1183
1184     OUTPUT:
1185         RETVAL
1186
1187 MODULE = XS::APItest:Overload   PACKAGE = XS::APItest::Overload
1188
1189 void
1190 amagic_deref_call(sv, what)
1191         SV *sv
1192         int what
1193     PPCODE:
1194         /* The reference is owned by something else.  */
1195         PUSHs(amagic_deref_call(sv, what));
1196
1197 # I'd certainly like to discourage the use of this macro, given that we now
1198 # have amagic_deref_call
1199
1200 void
1201 tryAMAGICunDEREF_var(sv, what)
1202         SV *sv
1203         int what
1204     PPCODE:
1205         {
1206             SV **sp = &sv;
1207             switch(what) {
1208             case to_av_amg:
1209                 tryAMAGICunDEREF(to_av);
1210                 break;
1211             case to_cv_amg:
1212                 tryAMAGICunDEREF(to_cv);
1213                 break;
1214             case to_gv_amg:
1215                 tryAMAGICunDEREF(to_gv);
1216                 break;
1217             case to_hv_amg:
1218                 tryAMAGICunDEREF(to_hv);
1219                 break;
1220             case to_sv_amg:
1221                 tryAMAGICunDEREF(to_sv);
1222                 break;
1223             default:
1224                 croak("Invalid value %d passed to tryAMAGICunDEREF_var", what);
1225             }
1226         }
1227         /* The reference is owned by something else.  */
1228         PUSHs(sv);
1229
1230 MODULE = XS::APItest            PACKAGE = XS::APItest::XSUB
1231
1232 BOOT:
1233     newXS("XS::APItest::XSUB::XS_VERSION_undef", XS_XS__APItest__XSUB_XS_VERSION_undef, __FILE__);
1234     newXS("XS::APItest::XSUB::XS_VERSION_empty", XS_XS__APItest__XSUB_XS_VERSION_empty, __FILE__);
1235     newXS("XS::APItest::XSUB::XS_APIVERSION_invalid", XS_XS__APItest__XSUB_XS_APIVERSION_invalid, __FILE__);
1236
1237 void
1238 XS_VERSION_defined(...)
1239     PPCODE:
1240         XS_VERSION_BOOTCHECK;
1241         XSRETURN_EMPTY;
1242
1243 void
1244 XS_APIVERSION_valid(...)
1245     PPCODE:
1246         XS_APIVERSION_BOOTCHECK;
1247         XSRETURN_EMPTY;
1248
1249 MODULE = XS::APItest:Hash               PACKAGE = XS::APItest::Hash
1250
1251 void
1252 rot13_hash(hash)
1253         HV *hash
1254         CODE:
1255         {
1256             struct ufuncs uf;
1257             uf.uf_val = rot13_key;
1258             uf.uf_set = 0;
1259             uf.uf_index = 0;
1260
1261             sv_magic((SV*)hash, NULL, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf));
1262         }
1263
1264 void
1265 bitflip_hash(hash)
1266         HV *hash
1267         CODE:
1268         {
1269             struct ufuncs uf;
1270             uf.uf_val = bitflip_key;
1271             uf.uf_set = 0;
1272             uf.uf_index = 0;
1273
1274             sv_magic((SV*)hash, NULL, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf));
1275         }
1276
1277 #define UTF8KLEN(sv, len)   (SvUTF8(sv) ? -(I32)len : (I32)len)
1278
1279 bool
1280 exists(hash, key_sv)
1281         PREINIT:
1282         STRLEN len;
1283         const char *key;
1284         INPUT:
1285         HV *hash
1286         SV *key_sv
1287         CODE:
1288         key = SvPV(key_sv, len);
1289         RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
1290         OUTPUT:
1291         RETVAL
1292
1293 bool
1294 exists_ent(hash, key_sv)
1295         PREINIT:
1296         INPUT:
1297         HV *hash
1298         SV *key_sv
1299         CODE:
1300         RETVAL = hv_exists_ent(hash, key_sv, 0);
1301         OUTPUT:
1302         RETVAL
1303
1304 SV *
1305 delete(hash, key_sv, flags = 0)
1306         PREINIT:
1307         STRLEN len;
1308         const char *key;
1309         INPUT:
1310         HV *hash
1311         SV *key_sv
1312         I32 flags;
1313         CODE:
1314         key = SvPV(key_sv, len);
1315         /* It's already mortal, so need to increase reference count.  */
1316         RETVAL
1317             = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), flags));
1318         OUTPUT:
1319         RETVAL
1320
1321 SV *
1322 delete_ent(hash, key_sv, flags = 0)
1323         INPUT:
1324         HV *hash
1325         SV *key_sv
1326         I32 flags;
1327         CODE:
1328         /* It's already mortal, so need to increase reference count.  */
1329         RETVAL = SvREFCNT_inc(hv_delete_ent(hash, key_sv, flags, 0));
1330         OUTPUT:
1331         RETVAL
1332
1333 SV *
1334 store_ent(hash, key, value)
1335         PREINIT:
1336         SV *copy;
1337         HE *result;
1338         INPUT:
1339         HV *hash
1340         SV *key
1341         SV *value
1342         CODE:
1343         copy = newSV(0);
1344         result = hv_store_ent(hash, key, copy, 0);
1345         SvSetMagicSV(copy, value);
1346         if (!result) {
1347             SvREFCNT_dec(copy);
1348             XSRETURN_EMPTY;
1349         }
1350         /* It's about to become mortal, so need to increase reference count.
1351          */
1352         RETVAL = SvREFCNT_inc(HeVAL(result));
1353         OUTPUT:
1354         RETVAL
1355
1356 SV *
1357 store(hash, key_sv, value)
1358         PREINIT:
1359         STRLEN len;
1360         const char *key;
1361         SV *copy;
1362         SV **result;
1363         INPUT:
1364         HV *hash
1365         SV *key_sv
1366         SV *value
1367         CODE:
1368         key = SvPV(key_sv, len);
1369         copy = newSV(0);
1370         result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
1371         SvSetMagicSV(copy, value);
1372         if (!result) {
1373             SvREFCNT_dec(copy);
1374             XSRETURN_EMPTY;
1375         }
1376         /* It's about to become mortal, so need to increase reference count.
1377          */
1378         RETVAL = SvREFCNT_inc(*result);
1379         OUTPUT:
1380         RETVAL
1381
1382 SV *
1383 fetch_ent(hash, key_sv)
1384         PREINIT:
1385         HE *result;
1386         INPUT:
1387         HV *hash
1388         SV *key_sv
1389         CODE:
1390         result = hv_fetch_ent(hash, key_sv, 0, 0);
1391         if (!result) {
1392             XSRETURN_EMPTY;
1393         }
1394         /* Force mg_get  */
1395         RETVAL = newSVsv(HeVAL(result));
1396         OUTPUT:
1397         RETVAL
1398
1399 SV *
1400 fetch(hash, key_sv)
1401         PREINIT:
1402         STRLEN len;
1403         const char *key;
1404         SV **result;
1405         INPUT:
1406         HV *hash
1407         SV *key_sv
1408         CODE:
1409         key = SvPV(key_sv, len);
1410         result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
1411         if (!result) {
1412             XSRETURN_EMPTY;
1413         }
1414         /* Force mg_get  */
1415         RETVAL = newSVsv(*result);
1416         OUTPUT:
1417         RETVAL
1418
1419 #if defined (hv_common)
1420
1421 SV *
1422 common(params)
1423         INPUT:
1424         HV *params
1425         PREINIT:
1426         HE *result;
1427         HV *hv = NULL;
1428         SV *keysv = NULL;
1429         const char *key = NULL;
1430         STRLEN klen = 0;
1431         int flags = 0;
1432         int action = 0;
1433         SV *val = NULL;
1434         U32 hash = 0;
1435         SV **svp;
1436         CODE:
1437         if ((svp = hv_fetchs(params, "hv", 0))) {
1438             SV *const rv = *svp;
1439             if (!SvROK(rv))
1440                 croak("common passed a non-reference for parameter hv");
1441             hv = (HV *)SvRV(rv);
1442         }
1443         if ((svp = hv_fetchs(params, "keysv", 0)))
1444             keysv = *svp;
1445         if ((svp = hv_fetchs(params, "keypv", 0))) {
1446             key = SvPV_const(*svp, klen);
1447             if (SvUTF8(*svp))
1448                 flags = HVhek_UTF8;
1449         }
1450         if ((svp = hv_fetchs(params, "action", 0)))
1451             action = SvIV(*svp);
1452         if ((svp = hv_fetchs(params, "val", 0)))
1453             val = newSVsv(*svp);
1454         if ((svp = hv_fetchs(params, "hash", 0)))
1455             hash = SvUV(*svp);
1456
1457         if ((svp = hv_fetchs(params, "hash_pv", 0))) {
1458             PERL_HASH(hash, key, klen);
1459         }
1460         if ((svp = hv_fetchs(params, "hash_sv", 0))) {
1461             STRLEN len;
1462             const char *const p = SvPV(keysv, len);
1463             PERL_HASH(hash, p, len);
1464         }
1465
1466         result = (HE *)hv_common(hv, keysv, key, klen, flags, action, val, hash);
1467         if (!result) {
1468             XSRETURN_EMPTY;
1469         }
1470         /* Force mg_get  */
1471         RETVAL = newSVsv(HeVAL(result));
1472         OUTPUT:
1473         RETVAL
1474
1475 #endif
1476
1477 void
1478 test_hv_free_ent()
1479         PPCODE:
1480         test_freeent(&Perl_hv_free_ent);
1481         XSRETURN(4);
1482
1483 void
1484 test_hv_delayfree_ent()
1485         PPCODE:
1486         test_freeent(&Perl_hv_delayfree_ent);
1487         XSRETURN(4);
1488
1489 SV *
1490 test_share_unshare_pvn(input)
1491         PREINIT:
1492         STRLEN len;
1493         U32 hash;
1494         char *pvx;
1495         char *p;
1496         INPUT:
1497         SV *input
1498         CODE:
1499         pvx = SvPV(input, len);
1500         PERL_HASH(hash, pvx, len);
1501         p = sharepvn(pvx, len, hash);
1502         RETVAL = newSVpvn(p, len);
1503         unsharepvn(p, len, hash);
1504         OUTPUT:
1505         RETVAL
1506
1507 #if PERL_VERSION >= 9
1508
1509 bool
1510 refcounted_he_exists(key, level=0)
1511         SV *key
1512         IV level
1513         CODE:
1514         if (level) {
1515             croak("level must be zero, not %"IVdf, level);
1516         }
1517         RETVAL = (cop_hints_fetch_sv(PL_curcop, key, 0, 0) != &PL_sv_placeholder);
1518         OUTPUT:
1519         RETVAL
1520
1521 SV *
1522 refcounted_he_fetch(key, level=0)
1523         SV *key
1524         IV level
1525         CODE:
1526         if (level) {
1527             croak("level must be zero, not %"IVdf, level);
1528         }
1529         RETVAL = cop_hints_fetch_sv(PL_curcop, key, 0, 0);
1530         SvREFCNT_inc(RETVAL);
1531         OUTPUT:
1532         RETVAL
1533
1534 #endif
1535
1536 void
1537 test_force_keys(HV *hv)
1538     PREINIT:
1539         HE *he;
1540         STRLEN count = 0;
1541     PPCODE:
1542         hv_iterinit(hv);
1543         he = hv_iternext(hv);
1544         while (he) {
1545             SV *sv = HeSVKEY_force(he);
1546             ++count;
1547             EXTEND(SP, count);
1548             PUSHs(sv_mortalcopy(sv));
1549             he = hv_iternext(hv);
1550         }
1551
1552 =pod
1553
1554 sub TIEHASH  { bless {}, $_[0] }
1555 sub STORE    { $_[0]->{$_[1]} = $_[2] }
1556 sub FETCH    { $_[0]->{$_[1]} }
1557 sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
1558 sub NEXTKEY  { each %{$_[0]} }
1559 sub EXISTS   { exists $_[0]->{$_[1]} }
1560 sub DELETE   { delete $_[0]->{$_[1]} }
1561 sub CLEAR    { %{$_[0]} = () }
1562
1563 =cut
1564
1565 MODULE = XS::APItest:TempLv             PACKAGE = XS::APItest::TempLv
1566
1567 void
1568 make_temp_mg_lv(sv)
1569 SV* sv
1570     PREINIT:
1571         SV * const lv = newSV_type(SVt_PVLV);
1572         STRLEN len;
1573     PPCODE:
1574         SvPV(sv, len);
1575
1576         sv_magic(lv, NULL, PERL_MAGIC_substr, NULL, 0);
1577         LvTYPE(lv) = 'x';
1578         LvTARG(lv) = SvREFCNT_inc_simple(sv);
1579         LvTARGOFF(lv) = len == 0 ? 0 : 1;
1580         LvTARGLEN(lv) = len < 2 ? 0 : len-2;
1581
1582         EXTEND(SP, 1);
1583         ST(0) = sv_2mortal(lv);
1584         XSRETURN(1);
1585
1586
1587 MODULE = XS::APItest::PtrTable  PACKAGE = XS::APItest::PtrTable PREFIX = ptr_table_
1588
1589 void
1590 ptr_table_new(classname)
1591 const char * classname
1592     PPCODE:
1593     PUSHs(sv_setref_pv(sv_newmortal(), classname, (void*)ptr_table_new()));
1594
1595 void
1596 DESTROY(table)
1597 XS::APItest::PtrTable table
1598     CODE:
1599     ptr_table_free(table);
1600
1601 void
1602 ptr_table_store(table, from, to)
1603 XS::APItest::PtrTable table
1604 SVREF from
1605 SVREF to
1606    CODE:
1607    ptr_table_store(table, from, to);
1608
1609 UV
1610 ptr_table_fetch(table, from)
1611 XS::APItest::PtrTable table
1612 SVREF from
1613    CODE:
1614    RETVAL = PTR2UV(ptr_table_fetch(table, from));
1615    OUTPUT:
1616    RETVAL
1617
1618 void
1619 ptr_table_split(table)
1620 XS::APItest::PtrTable table
1621
1622 void
1623 ptr_table_clear(table)
1624 XS::APItest::PtrTable table
1625
1626 MODULE = XS::APItest::AutoLoader        PACKAGE = XS::APItest::AutoLoader
1627
1628 SV *
1629 AUTOLOAD()
1630     CODE:
1631         RETVAL = newSVpvn_flags(SvPVX(cv), SvCUR(cv), SvUTF8(cv));
1632     OUTPUT:
1633         RETVAL
1634
1635 SV *
1636 AUTOLOADp(...)
1637     PROTOTYPE: *$
1638     CODE:
1639         PERL_UNUSED_ARG(items);
1640         RETVAL = newSVpvn_flags(SvPVX(cv), SvCUR(cv), SvUTF8(cv));
1641     OUTPUT:
1642         RETVAL
1643
1644
1645 MODULE = XS::APItest            PACKAGE = XS::APItest
1646
1647 PROTOTYPES: DISABLE
1648
1649 BOOT:
1650     mymro.resolve = myget_linear_isa;
1651     mymro.name    = "justisa";
1652     mymro.length  = 7;
1653     mymro.kflags  = 0;
1654     mymro.hash    = 0;
1655     Perl_mro_register(aTHX_ &mymro);
1656
1657 HV *
1658 xop_custom_ops ()
1659     CODE:
1660         RETVAL = PL_custom_ops;
1661     OUTPUT:
1662         RETVAL
1663
1664 HV *
1665 xop_custom_op_names ()
1666     CODE:
1667         PL_custom_op_names = newHV();
1668         RETVAL = PL_custom_op_names;
1669     OUTPUT:
1670         RETVAL
1671
1672 HV *
1673 xop_custom_op_descs ()
1674     CODE:
1675         PL_custom_op_descs = newHV();
1676         RETVAL = PL_custom_op_descs;
1677     OUTPUT:
1678         RETVAL
1679
1680 void
1681 xop_register ()
1682     CODE:
1683         XopENTRY_set(&my_xop, xop_name, "my_xop");
1684         XopENTRY_set(&my_xop, xop_desc, "XOP for testing");
1685         XopENTRY_set(&my_xop, xop_class, OA_UNOP);
1686         XopENTRY_set(&my_xop, xop_peep, peep_xop);
1687         Perl_custom_op_register(aTHX_ pp_xop, &my_xop);
1688
1689 void
1690 xop_clear ()
1691     CODE:
1692         XopDISABLE(&my_xop, xop_name);
1693         XopDISABLE(&my_xop, xop_desc);
1694         XopDISABLE(&my_xop, xop_class);
1695         XopDISABLE(&my_xop, xop_peep);
1696
1697 IV
1698 xop_my_xop ()
1699     CODE:
1700         RETVAL = PTR2IV(&my_xop);
1701     OUTPUT:
1702         RETVAL
1703
1704 IV
1705 xop_ppaddr ()
1706     CODE:
1707         RETVAL = PTR2IV(pp_xop);
1708     OUTPUT:
1709         RETVAL
1710
1711 IV
1712 xop_OA_UNOP ()
1713     CODE:
1714         RETVAL = OA_UNOP;
1715     OUTPUT:
1716         RETVAL
1717
1718 AV *
1719 xop_build_optree ()
1720     CODE:
1721         dMY_CXT;
1722         UNOP *unop;
1723         OP *kid;
1724
1725         MY_CXT.xop_record = newAV();
1726
1727         kid = newSVOP(OP_CONST, 0, newSViv(42));
1728
1729         NewOp(1102, unop, 1, UNOP);
1730         unop->op_type       = OP_CUSTOM;
1731         unop->op_ppaddr     = pp_xop;
1732         unop->op_flags      = OPf_KIDS;
1733         unop->op_private    = 0;
1734         unop->op_first      = kid;
1735         unop->op_next       = NULL;
1736         kid->op_next        = (OP*)unop;
1737
1738         av_push(MY_CXT.xop_record, newSVpvf("unop:%"UVxf, PTR2UV(unop)));
1739         av_push(MY_CXT.xop_record, newSVpvf("kid:%"UVxf, PTR2UV(kid)));
1740
1741         av_push(MY_CXT.xop_record, newSVpvf("NAME:%s", OP_NAME((OP*)unop)));
1742         av_push(MY_CXT.xop_record, newSVpvf("DESC:%s", OP_DESC((OP*)unop)));
1743         av_push(MY_CXT.xop_record, newSVpvf("CLASS:%d", (int)OP_CLASS((OP*)unop)));
1744
1745         PL_rpeepp(aTHX_ kid);
1746
1747         FreeOp(kid);
1748         FreeOp(unop);
1749
1750         RETVAL = MY_CXT.xop_record;
1751         MY_CXT.xop_record = NULL;
1752     OUTPUT:
1753         RETVAL
1754
1755 IV
1756 xop_from_custom_op ()
1757     CODE:
1758 /* author note: this test doesn't imply Perl_custom_op_xop is or isn't public
1759    API or that Perl_custom_op_xop is known to be used outside the core */
1760         UNOP *unop;
1761         XOP *xop;
1762
1763         NewOp(1102, unop, 1, UNOP);
1764         unop->op_type       = OP_CUSTOM;
1765         unop->op_ppaddr     = pp_xop;
1766         unop->op_flags      = OPf_KIDS;
1767         unop->op_private    = 0;
1768         unop->op_first      = NULL;
1769         unop->op_next       = NULL;
1770
1771         xop = Perl_custom_op_xop(aTHX_ (OP *)unop);
1772         FreeOp(unop);
1773         RETVAL = PTR2IV(xop);
1774     OUTPUT:
1775         RETVAL
1776
1777 BOOT:
1778 {
1779     MY_CXT_INIT;
1780
1781     MY_CXT.i  = 99;
1782     MY_CXT.sv = newSVpv("initial",0);
1783
1784     MY_CXT.bhkav = get_av("XS::APItest::bhkav", GV_ADDMULTI);
1785     MY_CXT.bhk_record = 0;
1786
1787     BhkENTRY_set(&bhk_test, bhk_start, blockhook_test_start);
1788     BhkENTRY_set(&bhk_test, bhk_pre_end, blockhook_test_pre_end);
1789     BhkENTRY_set(&bhk_test, bhk_post_end, blockhook_test_post_end);
1790     BhkENTRY_set(&bhk_test, bhk_eval, blockhook_test_eval);
1791     Perl_blockhook_register(aTHX_ &bhk_test);
1792
1793     MY_CXT.cscgv = gv_fetchpvs("XS::APItest::COMPILE_SCOPE_CONTAINER",
1794         GV_ADDMULTI, SVt_PVAV);
1795     MY_CXT.cscav = GvAV(MY_CXT.cscgv);
1796
1797     BhkENTRY_set(&bhk_csc, bhk_start, blockhook_csc_start);
1798     BhkENTRY_set(&bhk_csc, bhk_pre_end, blockhook_csc_pre_end);
1799     Perl_blockhook_register(aTHX_ &bhk_csc);
1800
1801     MY_CXT.peep_recorder = newAV();
1802     MY_CXT.rpeep_recorder = newAV();
1803
1804     MY_CXT.orig_peep = PL_peepp;
1805     MY_CXT.orig_rpeep = PL_rpeepp;
1806     PL_peepp = my_peep;
1807     PL_rpeepp = my_rpeep;
1808 }
1809
1810 void
1811 CLONE(...)
1812     CODE:
1813     MY_CXT_CLONE;
1814     PERL_UNUSED_VAR(items);
1815     MY_CXT.sv = newSVpv("initial_clone",0);
1816     MY_CXT.cscgv = gv_fetchpvs("XS::APItest::COMPILE_SCOPE_CONTAINER",
1817         GV_ADDMULTI, SVt_PVAV);
1818     MY_CXT.cscav = NULL;
1819     MY_CXT.bhkav = get_av("XS::APItest::bhkav", GV_ADDMULTI);
1820     MY_CXT.bhk_record = 0;
1821     MY_CXT.peep_recorder = newAV();
1822     MY_CXT.rpeep_recorder = newAV();
1823
1824 void
1825 print_double(val)
1826         double val
1827         CODE:
1828         printf("%5.3f\n",val);
1829
1830 int
1831 have_long_double()
1832         CODE:
1833 #ifdef HAS_LONG_DOUBLE
1834         RETVAL = 1;
1835 #else
1836         RETVAL = 0;
1837 #endif
1838         OUTPUT:
1839         RETVAL
1840
1841 void
1842 print_long_double()
1843         CODE:
1844 #ifdef HAS_LONG_DOUBLE
1845 #   if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
1846         long double val = 7.0;
1847         printf("%5.3" PERL_PRIfldbl "\n",val);
1848 #   else
1849         double val = 7.0;
1850         printf("%5.3f\n",val);
1851 #   endif
1852 #endif
1853
1854 void
1855 print_int(val)
1856         int val
1857         CODE:
1858         printf("%d\n",val);
1859
1860 void
1861 print_long(val)
1862         long val
1863         CODE:
1864         printf("%ld\n",val);
1865
1866 void
1867 print_float(val)
1868         float val
1869         CODE:
1870         printf("%5.3f\n",val);
1871
1872 void
1873 print_flush()
1874         CODE:
1875         fflush(stdout);
1876
1877 void
1878 mpushp()
1879         PPCODE:
1880         EXTEND(SP, 3);
1881         mPUSHp("one", 3);
1882         mPUSHp("two", 3);
1883         mPUSHp("three", 5);
1884         XSRETURN(3);
1885
1886 void
1887 mpushn()
1888         PPCODE:
1889         EXTEND(SP, 3);
1890         mPUSHn(0.5);
1891         mPUSHn(-0.25);
1892         mPUSHn(0.125);
1893         XSRETURN(3);
1894
1895 void
1896 mpushi()
1897         PPCODE:
1898         EXTEND(SP, 3);
1899         mPUSHi(-1);
1900         mPUSHi(2);
1901         mPUSHi(-3);
1902         XSRETURN(3);
1903
1904 void
1905 mpushu()
1906         PPCODE:
1907         EXTEND(SP, 3);
1908         mPUSHu(1);
1909         mPUSHu(2);
1910         mPUSHu(3);
1911         XSRETURN(3);
1912
1913 void
1914 mxpushp()
1915         PPCODE:
1916         mXPUSHp("one", 3);
1917         mXPUSHp("two", 3);
1918         mXPUSHp("three", 5);
1919         XSRETURN(3);
1920
1921 void
1922 mxpushn()
1923         PPCODE:
1924         mXPUSHn(0.5);
1925         mXPUSHn(-0.25);
1926         mXPUSHn(0.125);
1927         XSRETURN(3);
1928
1929 void
1930 mxpushi()
1931         PPCODE:
1932         mXPUSHi(-1);
1933         mXPUSHi(2);
1934         mXPUSHi(-3);
1935         XSRETURN(3);
1936
1937 void
1938 mxpushu()
1939         PPCODE:
1940         mXPUSHu(1);
1941         mXPUSHu(2);
1942         mXPUSHu(3);
1943         XSRETURN(3);
1944
1945
1946 void
1947 call_sv(sv, flags, ...)
1948     SV* sv
1949     I32 flags
1950     PREINIT:
1951         I32 i;
1952     PPCODE:
1953         for (i=0; i<items-2; i++)
1954             ST(i) = ST(i+2); /* pop first two args */
1955         PUSHMARK(SP);
1956         SP += items - 2;
1957         PUTBACK;
1958         i = call_sv(sv, flags);
1959         SPAGAIN;
1960         EXTEND(SP, 1);
1961         PUSHs(sv_2mortal(newSViv(i)));
1962
1963 void
1964 call_pv(subname, flags, ...)
1965     char* subname
1966     I32 flags
1967     PREINIT:
1968         I32 i;
1969     PPCODE:
1970         for (i=0; i<items-2; i++)
1971             ST(i) = ST(i+2); /* pop first two args */
1972         PUSHMARK(SP);
1973         SP += items - 2;
1974         PUTBACK;
1975         i = call_pv(subname, flags);
1976         SPAGAIN;
1977         EXTEND(SP, 1);
1978         PUSHs(sv_2mortal(newSViv(i)));
1979
1980 void
1981 call_method(methname, flags, ...)
1982     char* methname
1983     I32 flags
1984     PREINIT:
1985         I32 i;
1986     PPCODE:
1987         for (i=0; i<items-2; i++)
1988             ST(i) = ST(i+2); /* pop first two args */
1989         PUSHMARK(SP);
1990         SP += items - 2;
1991         PUTBACK;
1992         i = call_method(methname, flags);
1993         SPAGAIN;
1994         EXTEND(SP, 1);
1995         PUSHs(sv_2mortal(newSViv(i)));
1996
1997 void
1998 newCONSTSUB(stash, name, flags, sv)
1999     HV* stash
2000     SV* name
2001     I32 flags
2002     SV* sv
2003     ALIAS:
2004         newCONSTSUB_flags = 1
2005     PREINIT:
2006         CV* mycv = NULL;
2007         STRLEN len;
2008         const char *pv = SvPV(name, len);
2009     PPCODE:
2010         switch (ix) {
2011            case 0:
2012                mycv = newCONSTSUB(stash, pv, SvOK(sv) ? SvREFCNT_inc(sv) : NULL);
2013                break;
2014            case 1:
2015                mycv = newCONSTSUB_flags(
2016                  stash, pv, len, flags | SvUTF8(name), SvOK(sv) ? SvREFCNT_inc(sv) : NULL
2017                );
2018                break;
2019         }
2020         EXTEND(SP, 2);
2021         PUSHs( CvCONST(mycv) ? &PL_sv_yes : &PL_sv_no );
2022         PUSHs((SV*)CvGV(mycv));
2023
2024 void
2025 gv_init_type(namesv, multi, flags, type)
2026     SV* namesv
2027     int multi
2028     I32 flags
2029     int type
2030     PREINIT:
2031         STRLEN len;
2032         const char * const name = SvPV_const(namesv, len);
2033         GV *gv = *(GV**)hv_fetch(PL_defstash, name, len, TRUE);
2034     PPCODE:
2035         if (SvTYPE(gv) == SVt_PVGV)
2036             Perl_croak(aTHX_ "GV is already a PVGV");
2037         if (multi) flags |= GV_ADDMULTI;
2038         switch (type) {
2039            case 0:
2040                gv_init(gv, PL_defstash, name, len, multi);
2041                break;
2042            case 1:
2043                gv_init_sv(gv, PL_defstash, namesv, flags);
2044                break;
2045            case 2:
2046                gv_init_pv(gv, PL_defstash, name, flags | SvUTF8(namesv));
2047                break;
2048            case 3:
2049                gv_init_pvn(gv, PL_defstash, name, len, flags | SvUTF8(namesv));
2050                break;
2051         }
2052         XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
2053
2054 void
2055 gv_fetchmeth_type(stash, methname, type, level, flags)
2056     HV* stash
2057     SV* methname
2058     int type
2059     I32 level
2060     I32 flags
2061     PREINIT:
2062         STRLEN len;
2063         const char * const name = SvPV_const(methname, len);
2064         GV* gv = NULL;
2065     PPCODE:
2066         switch (type) {
2067            case 0:
2068                gv = gv_fetchmeth(stash, name, len, level);
2069                break;
2070            case 1:
2071                gv = gv_fetchmeth_sv(stash, methname, level, flags);
2072                break;
2073            case 2:
2074                gv = gv_fetchmeth_pv(stash, name, level, flags | SvUTF8(methname));
2075                break;
2076            case 3:
2077                gv = gv_fetchmeth_pvn(stash, name, len, level, flags | SvUTF8(methname));
2078                break;
2079         }
2080         XPUSHs( gv ? MUTABLE_SV(gv) : &PL_sv_undef );
2081
2082 void
2083 gv_fetchmeth_autoload_type(stash, methname, type, level, flags)
2084     HV* stash
2085     SV* methname
2086     int type
2087     I32 level
2088     I32 flags
2089     PREINIT:
2090         STRLEN len;
2091         const char * const name = SvPV_const(methname, len);
2092         GV* gv = NULL;
2093     PPCODE:
2094         switch (type) {
2095            case 0:
2096                gv = gv_fetchmeth_autoload(stash, name, len, level);
2097                break;
2098            case 1:
2099                gv = gv_fetchmeth_sv_autoload(stash, methname, level, flags);
2100                break;
2101            case 2:
2102                gv = gv_fetchmeth_pv_autoload(stash, name, level, flags | SvUTF8(methname));
2103                break;
2104            case 3:
2105                gv = gv_fetchmeth_pvn_autoload(stash, name, len, level, flags | SvUTF8(methname));
2106                break;
2107         }
2108         XPUSHs( gv ? MUTABLE_SV(gv) : &PL_sv_undef );
2109
2110 void
2111 gv_fetchmethod_flags_type(stash, methname, type, flags)
2112     HV* stash
2113     SV* methname
2114     int type
2115     I32 flags
2116     PREINIT:
2117         GV* gv = NULL;
2118     PPCODE:
2119         switch (type) {
2120            case 0:
2121                gv = gv_fetchmethod_flags(stash, SvPVX_const(methname), flags);
2122                break;
2123            case 1:
2124                gv = gv_fetchmethod_sv_flags(stash, methname, flags);
2125                break;
2126            case 2:
2127                gv = gv_fetchmethod_pv_flags(stash, SvPV_nolen(methname), flags | SvUTF8(methname));
2128                break;
2129            case 3: {
2130                STRLEN len;
2131                const char * const name = SvPV_const(methname, len);
2132                gv = gv_fetchmethod_pvn_flags(stash, name, len, flags | SvUTF8(methname));
2133                break;
2134             }
2135         }
2136         XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
2137
2138 void
2139 gv_autoload_type(stash, methname, type, method)
2140     HV* stash
2141     SV* methname
2142     int type
2143     I32 method
2144     PREINIT:
2145         STRLEN len;
2146         const char * const name = SvPV_const(methname, len);
2147         GV* gv = NULL;
2148         I32 flags = method ? GV_AUTOLOAD_ISMETHOD : 0;
2149     PPCODE:
2150         switch (type) {
2151            case 0:
2152                gv = gv_autoload4(stash, name, len, method);
2153                break;
2154            case 1:
2155                gv = gv_autoload_sv(stash, methname, flags);
2156                break;
2157            case 2:
2158                gv = gv_autoload_pv(stash, name, flags | SvUTF8(methname));
2159                break;
2160            case 3:
2161                gv = gv_autoload_pvn(stash, name, len, flags | SvUTF8(methname));
2162                break;
2163         }
2164         XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
2165
2166 void
2167 whichsig_type(namesv, type)
2168     SV* namesv
2169     int type
2170     PREINIT:
2171         STRLEN len;
2172         const char * const name = SvPV_const(namesv, len);
2173         I32 i = 0;
2174     PPCODE:
2175         switch (type) {
2176            case 0:
2177               i = whichsig(name);
2178                break;
2179            case 1:
2180                i = whichsig_sv(namesv);
2181                break;
2182            case 2:
2183                i = whichsig_pv(name);
2184                break;
2185            case 3:
2186                i = whichsig_pvn(name, len);
2187                break;
2188         }
2189         XPUSHs(sv_2mortal(newSViv(i)));
2190
2191 void
2192 eval_sv(sv, flags)
2193     SV* sv
2194     I32 flags
2195     PREINIT:
2196         I32 i;
2197     PPCODE:
2198         PUTBACK;
2199         i = eval_sv(sv, flags);
2200         SPAGAIN;
2201         EXTEND(SP, 1);
2202         PUSHs(sv_2mortal(newSViv(i)));
2203
2204 void
2205 eval_pv(p, croak_on_error)
2206     const char* p
2207     I32 croak_on_error
2208     PPCODE:
2209         PUTBACK;
2210         EXTEND(SP, 1);
2211         PUSHs(eval_pv(p, croak_on_error));
2212
2213 void
2214 require_pv(pv)
2215     const char* pv
2216     PPCODE:
2217         PUTBACK;
2218         require_pv(pv);
2219
2220 int
2221 apitest_exception(throw_e)
2222     int throw_e
2223     OUTPUT:
2224         RETVAL
2225
2226 void
2227 mycroak(sv)
2228     SV* sv
2229     CODE:
2230     if (SvOK(sv)) {
2231         Perl_croak(aTHX_ "%s", SvPV_nolen(sv));
2232     }
2233     else {
2234         Perl_croak(aTHX_ NULL);
2235     }
2236
2237 SV*
2238 strtab()
2239    CODE:
2240    RETVAL = newRV_inc((SV*)PL_strtab);
2241    OUTPUT:
2242    RETVAL
2243
2244 int
2245 my_cxt_getint()
2246     CODE:
2247         dMY_CXT;
2248         RETVAL = my_cxt_getint_p(aMY_CXT);
2249     OUTPUT:
2250         RETVAL
2251
2252 void
2253 my_cxt_setint(i)
2254     int i;
2255     CODE:
2256         dMY_CXT;
2257         my_cxt_setint_p(aMY_CXT_ i);
2258
2259 void
2260 my_cxt_getsv(how)
2261     bool how;
2262     PPCODE:
2263         EXTEND(SP, 1);
2264         ST(0) = how ? my_cxt_getsv_interp_context() : my_cxt_getsv_interp();
2265         XSRETURN(1);
2266
2267 void
2268 my_cxt_setsv(sv)
2269     SV *sv;
2270     CODE:
2271         dMY_CXT;
2272         SvREFCNT_dec(MY_CXT.sv);
2273         my_cxt_setsv_p(sv _aMY_CXT);
2274         SvREFCNT_inc(sv);
2275
2276 bool
2277 sv_setsv_cow_hashkey_core()
2278
2279 bool
2280 sv_setsv_cow_hashkey_notcore()
2281
2282 void
2283 sv_set_deref(SV *sv, SV *sv2, int which)
2284     CODE:
2285     {
2286         STRLEN len;
2287         const char *pv = SvPV(sv2,len);
2288         if (!SvROK(sv)) croak("Not a ref");
2289         sv = SvRV(sv);
2290         switch (which) {
2291             case 0: sv_setsv(sv,sv2); break;
2292             case 1: sv_setpv(sv,pv); break;
2293             case 2: sv_setpvn(sv,pv,len); break;
2294         }
2295     }
2296
2297 void
2298 rmagical_cast(sv, type)
2299     SV *sv;
2300     SV *type;
2301     PREINIT:
2302         struct ufuncs uf;
2303     PPCODE:
2304         if (!SvOK(sv) || !SvROK(sv) || !SvOK(type)) { XSRETURN_UNDEF; }
2305         sv = SvRV(sv);
2306         if (SvTYPE(sv) != SVt_PVHV) { XSRETURN_UNDEF; }
2307         uf.uf_val = rmagical_a_dummy;
2308         uf.uf_set = NULL;
2309         uf.uf_index = 0;
2310         if (SvTRUE(type)) { /* b */
2311             sv_magicext(sv, NULL, PERL_MAGIC_ext, &rmagical_b, NULL, 0);
2312         } else { /* a */
2313             sv_magic(sv, NULL, PERL_MAGIC_uvar, (char *) &uf, sizeof(uf));
2314         }
2315         XSRETURN_YES;
2316
2317 void
2318 rmagical_flags(sv)
2319     SV *sv;
2320     PPCODE:
2321         if (!SvOK(sv) || !SvROK(sv)) { XSRETURN_UNDEF; }
2322         sv = SvRV(sv);
2323         EXTEND(SP, 3);
2324         mXPUSHu(SvFLAGS(sv) & SVs_GMG);
2325         mXPUSHu(SvFLAGS(sv) & SVs_SMG);
2326         mXPUSHu(SvFLAGS(sv) & SVs_RMG);
2327         XSRETURN(3);
2328
2329 void
2330 my_caller(level)
2331         I32 level
2332     PREINIT:
2333         const PERL_CONTEXT *cx, *dbcx;
2334         const char *pv;
2335         const GV *gv;
2336         HV *hv;
2337     PPCODE:
2338         cx = caller_cx(level, &dbcx);
2339         EXTEND(SP, 8);
2340
2341         pv = CopSTASHPV(cx->blk_oldcop);
2342         ST(0) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef;
2343         gv = CvGV(cx->blk_sub.cv);
2344         ST(1) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef;
2345
2346         pv = CopSTASHPV(dbcx->blk_oldcop);
2347         ST(2) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef;
2348         gv = CvGV(dbcx->blk_sub.cv);
2349         ST(3) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef;
2350
2351         ST(4) = cop_hints_fetch_pvs(cx->blk_oldcop, "foo", 0);
2352         ST(5) = cop_hints_fetch_pvn(cx->blk_oldcop, "foo", 3, 0, 0);
2353         ST(6) = cop_hints_fetch_sv(cx->blk_oldcop,
2354                 sv_2mortal(newSVpvn("foo", 3)), 0, 0);
2355
2356         hv = cop_hints_2hv(cx->blk_oldcop, 0);
2357         ST(7) = hv ? sv_2mortal(newRV_noinc((SV *)hv)) : &PL_sv_undef;
2358
2359         XSRETURN(8);
2360
2361 void
2362 DPeek (sv)
2363     SV   *sv
2364
2365   PPCODE:
2366     ST (0) = newSVpv (Perl_sv_peek (aTHX_ sv), 0);
2367     XSRETURN (1);
2368
2369 void
2370 BEGIN()
2371     CODE:
2372         sv_inc(get_sv("XS::APItest::BEGIN_called", GV_ADD|GV_ADDMULTI));
2373
2374 void
2375 CHECK()
2376     CODE:
2377         sv_inc(get_sv("XS::APItest::CHECK_called", GV_ADD|GV_ADDMULTI));
2378
2379 void
2380 UNITCHECK()
2381     CODE:
2382         sv_inc(get_sv("XS::APItest::UNITCHECK_called", GV_ADD|GV_ADDMULTI));
2383
2384 void
2385 INIT()
2386     CODE:
2387         sv_inc(get_sv("XS::APItest::INIT_called", GV_ADD|GV_ADDMULTI));
2388
2389 void
2390 END()
2391     CODE:
2392         sv_inc(get_sv("XS::APItest::END_called", GV_ADD|GV_ADDMULTI));
2393
2394 void
2395 utf16_to_utf8 (sv, ...)
2396     SV* sv
2397         ALIAS:
2398             utf16_to_utf8_reversed = 1
2399     PREINIT:
2400         STRLEN len;
2401         U8 *source;
2402         SV *dest;
2403         I32 got; /* Gah, badly thought out APIs */
2404     CODE:
2405         source = (U8 *)SvPVbyte(sv, len);
2406         /* Optionally only convert part of the buffer.  */
2407         if (items > 1) {
2408             len = SvUV(ST(1));
2409         }
2410         /* Mortalise this right now, as we'll be testing croak()s  */
2411         dest = sv_2mortal(newSV(len * 3 / 2 + 1));
2412         if (ix) {
2413             utf16_to_utf8_reversed(source, (U8 *)SvPVX(dest), len, &got);
2414         } else {
2415             utf16_to_utf8(source, (U8 *)SvPVX(dest), len, &got);
2416         }
2417         SvCUR_set(dest, got);
2418         SvPVX(dest)[got] = '\0';
2419         SvPOK_on(dest);
2420         ST(0) = dest;
2421         XSRETURN(1);
2422
2423 void
2424 my_exit(int exitcode)
2425         PPCODE:
2426         my_exit(exitcode);
2427
2428 U8
2429 first_byte(sv)
2430         SV *sv
2431    CODE:
2432     char *s;
2433     STRLEN len;
2434         s = SvPVbyte(sv, len);
2435         RETVAL = s[0];
2436    OUTPUT:
2437     RETVAL
2438
2439 I32
2440 sv_count()
2441         CODE:
2442             RETVAL = PL_sv_count;
2443         OUTPUT:
2444             RETVAL
2445
2446 void
2447 bhk_record(bool on)
2448     CODE:
2449         dMY_CXT;
2450         MY_CXT.bhk_record = on;
2451         if (on)
2452             av_clear(MY_CXT.bhkav);
2453
2454 void
2455 test_magic_chain()
2456     PREINIT:
2457         SV *sv;
2458         MAGIC *callmg, *uvarmg;
2459     CODE:
2460         sv = sv_2mortal(newSV(0));
2461         if (SvTYPE(sv) >= SVt_PVMG) croak_fail();
2462         if (SvMAGICAL(sv)) croak_fail();
2463         sv_magic(sv, &PL_sv_yes, PERL_MAGIC_checkcall, (char*)&callmg, 0);
2464         if (SvTYPE(sv) < SVt_PVMG) croak_fail();
2465         if (!SvMAGICAL(sv)) croak_fail();
2466         if (mg_find(sv, PERL_MAGIC_uvar)) croak_fail();
2467         callmg = mg_find(sv, PERL_MAGIC_checkcall);
2468         if (!callmg) croak_fail();
2469         if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
2470             croak_fail();
2471         sv_magic(sv, &PL_sv_no, PERL_MAGIC_uvar, (char*)&uvarmg, 0);
2472         if (SvTYPE(sv) < SVt_PVMG) croak_fail();
2473         if (!SvMAGICAL(sv)) croak_fail();
2474         if (mg_find(sv, PERL_MAGIC_checkcall) != callmg) croak_fail();
2475         uvarmg = mg_find(sv, PERL_MAGIC_uvar);
2476         if (!uvarmg) croak_fail();
2477         if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
2478             croak_fail();
2479         if (uvarmg->mg_obj != &PL_sv_no || uvarmg->mg_ptr != (char*)&uvarmg)
2480             croak_fail();
2481         mg_free_type(sv, PERL_MAGIC_vec);
2482         if (SvTYPE(sv) < SVt_PVMG) croak_fail();
2483         if (!SvMAGICAL(sv)) croak_fail();
2484         if (mg_find(sv, PERL_MAGIC_checkcall) != callmg) croak_fail();
2485         if (mg_find(sv, PERL_MAGIC_uvar) != uvarmg) croak_fail();
2486         if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
2487             croak_fail();
2488         if (uvarmg->mg_obj != &PL_sv_no || uvarmg->mg_ptr != (char*)&uvarmg)
2489             croak_fail();
2490         mg_free_type(sv, PERL_MAGIC_uvar);
2491         if (SvTYPE(sv) < SVt_PVMG) croak_fail();
2492         if (!SvMAGICAL(sv)) croak_fail();
2493         if (mg_find(sv, PERL_MAGIC_checkcall) != callmg) croak_fail();
2494         if (mg_find(sv, PERL_MAGIC_uvar)) croak_fail();
2495         if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
2496             croak_fail();
2497         sv_magic(sv, &PL_sv_no, PERL_MAGIC_uvar, (char*)&uvarmg, 0);
2498         if (SvTYPE(sv) < SVt_PVMG) croak_fail();
2499         if (!SvMAGICAL(sv)) croak_fail();
2500         if (mg_find(sv, PERL_MAGIC_checkcall) != callmg) croak_fail();
2501         uvarmg = mg_find(sv, PERL_MAGIC_uvar);
2502         if (!uvarmg) croak_fail();
2503         if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
2504             croak_fail();
2505         if (uvarmg->mg_obj != &PL_sv_no || uvarmg->mg_ptr != (char*)&uvarmg)
2506             croak_fail();
2507         mg_free_type(sv, PERL_MAGIC_checkcall);
2508         if (SvTYPE(sv) < SVt_PVMG) croak_fail();
2509         if (!SvMAGICAL(sv)) croak_fail();
2510         if (mg_find(sv, PERL_MAGIC_uvar) != uvarmg) croak_fail();
2511         if (mg_find(sv, PERL_MAGIC_checkcall)) croak_fail();
2512         if (uvarmg->mg_obj != &PL_sv_no || uvarmg->mg_ptr != (char*)&uvarmg)
2513             croak_fail();
2514         mg_free_type(sv, PERL_MAGIC_uvar);
2515         if (SvMAGICAL(sv)) croak_fail();
2516         if (mg_find(sv, PERL_MAGIC_checkcall)) croak_fail();
2517         if (mg_find(sv, PERL_MAGIC_uvar)) croak_fail();
2518
2519 void
2520 test_op_contextualize()
2521     PREINIT:
2522         OP *o;
2523     CODE:
2524         o = newSVOP(OP_CONST, 0, newSViv(0));
2525         o->op_flags &= ~OPf_WANT;
2526         o = op_contextualize(o, G_SCALAR);
2527         if (o->op_type != OP_CONST ||
2528                 (o->op_flags & OPf_WANT) != OPf_WANT_SCALAR)
2529             croak_fail();
2530         op_free(o);
2531         o = newSVOP(OP_CONST, 0, newSViv(0));
2532         o->op_flags &= ~OPf_WANT;
2533         o = op_contextualize(o, G_ARRAY);
2534         if (o->op_type != OP_CONST ||
2535                 (o->op_flags & OPf_WANT) != OPf_WANT_LIST)
2536             croak_fail();
2537         op_free(o);
2538         o = newSVOP(OP_CONST, 0, newSViv(0));
2539         o->op_flags &= ~OPf_WANT;
2540         o = op_contextualize(o, G_VOID);
2541         if (o->op_type != OP_NULL) croak_fail();
2542         op_free(o);
2543
2544 void
2545 test_rv2cv_op_cv()
2546     PROTOTYPE:
2547     PREINIT:
2548         GV *troc_gv;
2549         CV *troc_cv;
2550         OP *o;
2551     CODE:
2552         troc_gv = gv_fetchpv("XS::APItest::test_rv2cv_op_cv", 0, SVt_PVGV);
2553         troc_cv = get_cv("XS::APItest::test_rv2cv_op_cv", 0);
2554         o = newCVREF(0, newGVOP(OP_GV, 0, troc_gv));
2555         if (rv2cv_op_cv(o, 0) != troc_cv) croak_fail();
2556         if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV) != (CV*)troc_gv)
2557             croak_fail();
2558         o->op_private |= OPpENTERSUB_AMPER;
2559         if (rv2cv_op_cv(o, 0)) croak_fail();
2560         if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
2561         o->op_private &= ~OPpENTERSUB_AMPER;
2562         if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
2563         if (rv2cv_op_cv(o, RV2CVOPCV_MARK_EARLY) != troc_cv) croak_fail();
2564         if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
2565         op_free(o);
2566         o = newSVOP(OP_CONST, 0, newSVpv("XS::APItest::test_rv2cv_op_cv", 0));
2567         o->op_private = OPpCONST_BARE;
2568         o = newCVREF(0, o);
2569         if (rv2cv_op_cv(o, 0) != troc_cv) croak_fail();
2570         if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV) != (CV*)troc_gv)
2571             croak_fail();
2572         o->op_private |= OPpENTERSUB_AMPER;
2573         if (rv2cv_op_cv(o, 0)) croak_fail();
2574         if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
2575         op_free(o);
2576         o = newCVREF(0, newSVOP(OP_CONST, 0, newRV_inc((SV*)troc_cv)));
2577         if (rv2cv_op_cv(o, 0) != troc_cv) croak_fail();
2578         if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV) != (CV*)troc_gv)
2579             croak_fail();
2580         o->op_private |= OPpENTERSUB_AMPER;
2581         if (rv2cv_op_cv(o, 0)) croak_fail();
2582         if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
2583         o->op_private &= ~OPpENTERSUB_AMPER;
2584         if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
2585         if (rv2cv_op_cv(o, RV2CVOPCV_MARK_EARLY) != troc_cv) croak_fail();
2586         if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
2587         op_free(o);
2588         o = newCVREF(0, newUNOP(OP_RAND, 0, newSVOP(OP_CONST, 0, newSViv(0))));
2589         if (rv2cv_op_cv(o, 0)) croak_fail();
2590         if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
2591         o->op_private |= OPpENTERSUB_AMPER;
2592         if (rv2cv_op_cv(o, 0)) croak_fail();
2593         if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
2594         o->op_private &= ~OPpENTERSUB_AMPER;
2595         if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
2596         if (rv2cv_op_cv(o, RV2CVOPCV_MARK_EARLY)) croak_fail();
2597         if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
2598         op_free(o);
2599         o = newUNOP(OP_RAND, 0, newSVOP(OP_CONST, 0, newSViv(0)));
2600         if (rv2cv_op_cv(o, 0)) croak_fail();
2601         if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
2602         op_free(o);
2603
2604 void
2605 test_cv_getset_call_checker()
2606     PREINIT:
2607         CV *troc_cv, *tsh_cv;
2608         Perl_call_checker ckfun;
2609         SV *ckobj;
2610     CODE:
2611 #define check_cc(cv, xckfun, xckobj) \
2612     do { \
2613         cv_get_call_checker((cv), &ckfun, &ckobj); \
2614         if (ckfun != (xckfun)) croak_fail_ne(FPTR2DPTR(void *, ckfun), xckfun); \
2615         if (ckobj != (xckobj)) croak_fail_ne(FPTR2DPTR(void *, ckobj), xckobj); \
2616     } while(0)
2617         troc_cv = get_cv("XS::APItest::test_rv2cv_op_cv", 0);
2618         tsh_cv = get_cv("XS::APItest::test_savehints", 0);
2619         check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv);
2620         check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv);
2621         cv_set_call_checker(tsh_cv, Perl_ck_entersub_args_proto_or_list,
2622                                     &PL_sv_yes);
2623         check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv);
2624         check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes);
2625         cv_set_call_checker(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no);
2626         check_cc(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no);
2627         check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes);
2628         cv_set_call_checker(tsh_cv, Perl_ck_entersub_args_proto_or_list,
2629                                     (SV*)tsh_cv);
2630         check_cc(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no);
2631         check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv);
2632         cv_set_call_checker(troc_cv, Perl_ck_entersub_args_proto_or_list,
2633                                     (SV*)troc_cv);
2634         check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv);
2635         check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv);
2636         if (SvMAGICAL((SV*)troc_cv) || SvMAGIC((SV*)troc_cv)) croak_fail();
2637         if (SvMAGICAL((SV*)tsh_cv) || SvMAGIC((SV*)tsh_cv)) croak_fail();
2638 #undef check_cc
2639
2640 void
2641 cv_set_call_checker_lists(CV *cv)
2642     CODE:
2643         cv_set_call_checker(cv, THX_ck_entersub_args_lists, &PL_sv_undef);
2644
2645 void
2646 cv_set_call_checker_scalars(CV *cv)
2647     CODE:
2648         cv_set_call_checker(cv, THX_ck_entersub_args_scalars, &PL_sv_undef);
2649
2650 void
2651 cv_set_call_checker_proto(CV *cv, SV *proto)
2652     CODE:
2653         if (SvROK(proto))
2654             proto = SvRV(proto);
2655         cv_set_call_checker(cv, Perl_ck_entersub_args_proto, proto);
2656
2657 void
2658 cv_set_call_checker_proto_or_list(CV *cv, SV *proto)
2659     CODE:
2660         if (SvROK(proto))
2661             proto = SvRV(proto);
2662         cv_set_call_checker(cv, Perl_ck_entersub_args_proto_or_list, proto);
2663
2664 void
2665 cv_set_call_checker_multi_sum(CV *cv)
2666     CODE:
2667         cv_set_call_checker(cv, THX_ck_entersub_multi_sum, &PL_sv_undef);
2668
2669 void
2670 test_cophh()
2671     PREINIT:
2672         COPHH *a, *b;
2673     CODE:
2674 #define check_ph(EXPR) \
2675             do { if((EXPR) != &PL_sv_placeholder) croak("fail"); } while(0)
2676 #define check_iv(EXPR, EXPECT) \
2677             do { if(SvIV(EXPR) != (EXPECT)) croak("fail"); } while(0)
2678 #define msvpvs(STR) sv_2mortal(newSVpvs(STR))
2679 #define msviv(VALUE) sv_2mortal(newSViv(VALUE))
2680         a = cophh_new_empty();
2681         check_ph(cophh_fetch_pvn(a, "foo_1", 5, 0, 0));
2682         check_ph(cophh_fetch_pvs(a, "foo_1", 0));
2683         check_ph(cophh_fetch_pv(a, "foo_1", 0, 0));
2684         check_ph(cophh_fetch_sv(a, msvpvs("foo_1"), 0, 0));
2685         a = cophh_store_pvn(a, "foo_1abc", 5, 0, msviv(111), 0);
2686         a = cophh_store_pvs(a, "foo_2", msviv(222), 0);
2687         a = cophh_store_pv(a, "foo_3", 0, msviv(333), 0);
2688         a = cophh_store_sv(a, msvpvs("foo_4"), 0, msviv(444), 0);
2689         check_iv(cophh_fetch_pvn(a, "foo_1xyz", 5, 0, 0), 111);
2690         check_iv(cophh_fetch_pvs(a, "foo_1", 0), 111);
2691         check_iv(cophh_fetch_pv(a, "foo_1", 0, 0), 111);
2692         check_iv(cophh_fetch_sv(a, msvpvs("foo_1"), 0, 0), 111);
2693         check_iv(cophh_fetch_pvs(a, "foo_2", 0), 222);
2694         check_iv(cophh_fetch_pvs(a, "foo_3", 0), 333);
2695         check_iv(cophh_fetch_pvs(a, "foo_4", 0), 444);
2696         check_ph(cophh_fetch_pvs(a, "foo_5", 0));
2697         b = cophh_copy(a);
2698         b = cophh_store_pvs(b, "foo_1", msviv(1111), 0);
2699         check_iv(cophh_fetch_pvs(a, "foo_1", 0), 111);
2700         check_iv(cophh_fetch_pvs(a, "foo_2", 0), 222);
2701         check_iv(cophh_fetch_pvs(a, "foo_3", 0), 333);
2702         check_iv(cophh_fetch_pvs(a, "foo_4", 0), 444);
2703         check_ph(cophh_fetch_pvs(a, "foo_5", 0));
2704         check_iv(cophh_fetch_pvs(b, "foo_1", 0), 1111);
2705         check_iv(cophh_fetch_pvs(b, "foo_2", 0), 222);
2706         check_iv(cophh_fetch_pvs(b, "foo_3", 0), 333);
2707         check_iv(cophh_fetch_pvs(b, "foo_4", 0), 444);
2708         check_ph(cophh_fetch_pvs(b, "foo_5", 0));
2709         a = cophh_delete_pvn(a, "foo_1abc", 5, 0, 0);
2710         a = cophh_delete_pvs(a, "foo_2", 0);
2711         b = cophh_delete_pv(b, "foo_3", 0, 0);
2712         b = cophh_delete_sv(b, msvpvs("foo_4"), 0, 0);
2713         check_ph(cophh_fetch_pvs(a, "foo_1", 0));
2714         check_ph(cophh_fetch_pvs(a, "foo_2", 0));
2715         check_iv(cophh_fetch_pvs(a, "foo_3", 0), 333);
2716         check_iv(cophh_fetch_pvs(a, "foo_4", 0), 444);
2717         check_ph(cophh_fetch_pvs(a, "foo_5", 0));
2718         check_iv(cophh_fetch_pvs(b, "foo_1", 0), 1111);
2719         check_iv(cophh_fetch_pvs(b, "foo_2", 0), 222);
2720         check_ph(cophh_fetch_pvs(b, "foo_3", 0));
2721         check_ph(cophh_fetch_pvs(b, "foo_4", 0));
2722         check_ph(cophh_fetch_pvs(b, "foo_5", 0));
2723         b = cophh_delete_pvs(b, "foo_3", 0);
2724         b = cophh_delete_pvs(b, "foo_5", 0);
2725         check_iv(cophh_fetch_pvs(b, "foo_1", 0), 1111);
2726         check_iv(cophh_fetch_pvs(b, "foo_2", 0), 222);
2727         check_ph(cophh_fetch_pvs(b, "foo_3", 0));
2728         check_ph(cophh_fetch_pvs(b, "foo_4", 0));
2729         check_ph(cophh_fetch_pvs(b, "foo_5", 0));
2730         cophh_free(b);
2731         check_ph(cophh_fetch_pvs(a, "foo_1", 0));
2732         check_ph(cophh_fetch_pvs(a, "foo_2", 0));
2733         check_iv(cophh_fetch_pvs(a, "foo_3", 0), 333);
2734         check_iv(cophh_fetch_pvs(a, "foo_4", 0), 444);
2735         check_ph(cophh_fetch_pvs(a, "foo_5", 0));
2736         a = cophh_store_pvs(a, "foo_1", msviv(11111), COPHH_KEY_UTF8);
2737         a = cophh_store_pvs(a, "foo_\xaa", msviv(123), 0);
2738         a = cophh_store_pvs(a, "foo_\xc2\xbb", msviv(456), COPHH_KEY_UTF8);
2739         a = cophh_store_pvs(a, "foo_\xc3\x8c", msviv(789), COPHH_KEY_UTF8);
2740         a = cophh_store_pvs(a, "foo_\xd9\xa6", msviv(666), COPHH_KEY_UTF8);
2741         check_iv(cophh_fetch_pvs(a, "foo_1", 0), 11111);
2742         check_iv(cophh_fetch_pvs(a, "foo_1", COPHH_KEY_UTF8), 11111);
2743         check_iv(cophh_fetch_pvs(a, "foo_\xaa", 0), 123);
2744         check_iv(cophh_fetch_pvs(a, "foo_\xc2\xaa", COPHH_KEY_UTF8), 123);
2745         check_ph(cophh_fetch_pvs(a, "foo_\xc2\xaa", 0));
2746         check_iv(cophh_fetch_pvs(a, "foo_\xbb", 0), 456);
2747         check_iv(cophh_fetch_pvs(a, "foo_\xc2\xbb", COPHH_KEY_UTF8), 456);
2748         check_ph(cophh_fetch_pvs(a, "foo_\xc2\xbb", 0));
2749         check_iv(cophh_fetch_pvs(a, "foo_\xcc", 0), 789);
2750         check_iv(cophh_fetch_pvs(a, "foo_\xc3\x8c", COPHH_KEY_UTF8), 789);
2751         check_ph(cophh_fetch_pvs(a, "foo_\xc2\x8c", 0));
2752         check_iv(cophh_fetch_pvs(a, "foo_\xd9\xa6", COPHH_KEY_UTF8), 666);
2753         check_ph(cophh_fetch_pvs(a, "foo_\xd9\xa6", 0));
2754         ENTER;
2755         SAVEFREECOPHH(a);
2756         LEAVE;
2757 #undef check_ph
2758 #undef check_iv
2759 #undef msvpvs
2760 #undef msviv
2761
2762 void
2763 test_coplabel()
2764     PREINIT:
2765         COP *cop;
2766         const char *label;
2767         STRLEN len;
2768         U32 utf8;
2769     CODE:
2770         cop = &PL_compiling;
2771         Perl_cop_store_label(aTHX_ cop, "foo", 3, 0);
2772         label = Perl_cop_fetch_label(aTHX_ cop, &len, &utf8);
2773         if (strcmp(label,"foo")) croak("fail # cop_fetch_label label");
2774         if (len != 3) croak("fail # cop_fetch_label len");
2775         if (utf8) croak("fail # cop_fetch_label utf8");
2776         /* SMALL GERMAN UMLAUT A */
2777         Perl_cop_store_label(aTHX_ cop, "fo\xc3\xa4", 4, SVf_UTF8);
2778         label = Perl_cop_fetch_label(aTHX_ cop, &len, &utf8);
2779         if (strcmp(label,"fo\xc3\xa4")) croak("fail # cop_fetch_label label");
2780         if (len != 4) croak("fail # cop_fetch_label len");
2781         if (!utf8) croak("fail # cop_fetch_label utf8");
2782
2783
2784 HV *
2785 example_cophh_2hv()
2786     PREINIT:
2787         COPHH *a;
2788     CODE:
2789 #define msviv(VALUE) sv_2mortal(newSViv(VALUE))
2790         a = cophh_new_empty();
2791         a = cophh_store_pvs(a, "foo_0", msviv(999), 0);
2792         a = cophh_store_pvs(a, "foo_1", msviv(111), 0);
2793         a = cophh_store_pvs(a, "foo_\xaa", msviv(123), 0);
2794         a = cophh_store_pvs(a, "foo_\xc2\xbb", msviv(456), COPHH_KEY_UTF8);
2795         a = cophh_store_pvs(a, "foo_\xc3\x8c", msviv(789), COPHH_KEY_UTF8);
2796         a = cophh_store_pvs(a, "foo_\xd9\xa6", msviv(666), COPHH_KEY_UTF8);
2797         a = cophh_delete_pvs(a, "foo_0", 0);
2798         a = cophh_delete_pvs(a, "foo_2", 0);
2799         RETVAL = cophh_2hv(a, 0);
2800         cophh_free(a);
2801 #undef msviv
2802     OUTPUT:
2803         RETVAL
2804
2805 void
2806 test_savehints()
2807     PREINIT:
2808         SV **svp, *sv;
2809     CODE:
2810 #define store_hint(KEY, VALUE) \
2811                 sv_setiv_mg(*hv_fetchs(GvHV(PL_hintgv), KEY, 1), (VALUE))
2812 #define hint_ok(KEY, EXPECT) \
2813                 ((svp = hv_fetchs(GvHV(PL_hintgv), KEY, 0)) && \
2814                     (sv = *svp) && SvIV(sv) == (EXPECT) && \
2815                     (sv = cop_hints_fetch_pvs(&PL_compiling, KEY, 0)) && \
2816                     SvIV(sv) == (EXPECT))
2817 #define check_hint(KEY, EXPECT) \
2818                 do { if (!hint_ok(KEY, EXPECT)) croak_fail(); } while(0)
2819         PL_hints |= HINT_LOCALIZE_HH;
2820         ENTER;
2821         SAVEHINTS();
2822         PL_hints &= HINT_INTEGER;
2823         store_hint("t0", 123);
2824         store_hint("t1", 456);
2825         if (PL_hints & HINT_INTEGER) croak_fail();
2826         check_hint("t0", 123); check_hint("t1", 456);
2827         ENTER;
2828         SAVEHINTS();
2829         if (PL_hints & HINT_INTEGER) croak_fail();
2830         check_hint("t0", 123); check_hint("t1", 456);
2831         PL_hints |= HINT_INTEGER;
2832         store_hint("t0", 321);
2833         if (!(PL_hints & HINT_INTEGER)) croak_fail();
2834         check_hint("t0", 321); check_hint("t1", 456);
2835         LEAVE;
2836         if (PL_hints & HINT_INTEGER) croak_fail();
2837         check_hint("t0", 123); check_hint("t1", 456);
2838         ENTER;
2839         SAVEHINTS();
2840         if (PL_hints & HINT_INTEGER) croak_fail();
2841         check_hint("t0", 123); check_hint("t1", 456);
2842         store_hint("t1", 654);
2843         if (PL_hints & HINT_INTEGER) croak_fail();
2844         check_hint("t0", 123); check_hint("t1", 654);
2845         LEAVE;
2846         if (PL_hints & HINT_INTEGER) croak_fail();
2847         check_hint("t0", 123); check_hint("t1", 456);
2848         LEAVE;
2849 #undef store_hint
2850 #undef hint_ok
2851 #undef check_hint
2852
2853 void
2854 test_copyhints()
2855     PREINIT:
2856         HV *a, *b;
2857     CODE:
2858         PL_hints |= HINT_LOCALIZE_HH;
2859         ENTER;
2860         SAVEHINTS();
2861         sv_setiv_mg(*hv_fetchs(GvHV(PL_hintgv), "t0", 1), 123);
2862         if (SvIV(cop_hints_fetch_pvs(&PL_compiling, "t0", 0)) != 123)
2863             croak_fail();
2864         a = newHVhv(GvHV(PL_hintgv));
2865         sv_2mortal((SV*)a);
2866         sv_setiv_mg(*hv_fetchs(a, "t0", 1), 456);
2867         if (SvIV(cop_hints_fetch_pvs(&PL_compiling, "t0", 0)) != 123)
2868             croak_fail();
2869         b = hv_copy_hints_hv(a);
2870         sv_2mortal((SV*)b);
2871         sv_setiv_mg(*hv_fetchs(b, "t0", 1), 789);
2872         if (SvIV(cop_hints_fetch_pvs(&PL_compiling, "t0", 0)) != 789)
2873             croak_fail();
2874         LEAVE;
2875
2876 void
2877 test_op_list()
2878     PREINIT:
2879         OP *a;
2880     CODE:
2881 #define iv_op(iv) newSVOP(OP_CONST, 0, newSViv(iv))
2882 #define check_op(o, expect) \
2883     do { \
2884         if (strcmp(test_op_list_describe(o), (expect))) \
2885             croak("fail %s %s", test_op_list_describe(o), (expect)); \
2886     } while(0)
2887         a = op_append_elem(OP_LIST, NULL, NULL);
2888         check_op(a, "");
2889         a = op_append_elem(OP_LIST, iv_op(1), a);
2890         check_op(a, "const(1).");
2891         a = op_append_elem(OP_LIST, NULL, a);
2892         check_op(a, "const(1).");
2893         a = op_append_elem(OP_LIST, a, iv_op(2));
2894         check_op(a, "list[pushmark.const(1).const(2).]");
2895         a = op_append_elem(OP_LIST, a, iv_op(3));
2896         check_op(a, "list[pushmark.const(1).const(2).const(3).]");
2897         a = op_append_elem(OP_LIST, a, NULL);
2898         check_op(a, "list[pushmark.const(1).const(2).const(3).]");
2899         a = op_append_elem(OP_LIST, NULL, a);
2900         check_op(a, "list[pushmark.const(1).const(2).const(3).]");
2901         a = op_append_elem(OP_LIST, iv_op(4), a);
2902         check_op(a, "list[pushmark.const(4)."
2903                 "list[pushmark.const(1).const(2).const(3).]]");
2904         a = op_append_elem(OP_LIST, a, iv_op(5));
2905         check_op(a, "list[pushmark.const(4)."
2906                 "list[pushmark.const(1).const(2).const(3).]const(5).]");
2907         a = op_append_elem(OP_LIST, a,
2908                 op_append_elem(OP_LIST, iv_op(7), iv_op(6)));
2909         check_op(a, "list[pushmark.const(4)."
2910                 "list[pushmark.const(1).const(2).const(3).]const(5)."
2911                 "list[pushmark.const(7).const(6).]]");
2912         op_free(a);
2913         a = op_append_elem(OP_LINESEQ, iv_op(1), iv_op(2));
2914         check_op(a, "lineseq[const(1).const(2).]");
2915         a = op_append_elem(OP_LINESEQ, a, iv_op(3));
2916         check_op(a, "lineseq[const(1).const(2).const(3).]");
2917         op_free(a);
2918         a = op_append_elem(OP_LINESEQ,
2919                 op_append_elem(OP_LIST, iv_op(1), iv_op(2)),
2920                 iv_op(3));
2921         check_op(a, "lineseq[list[pushmark.const(1).const(2).]const(3).]");
2922         op_free(a);
2923         a = op_prepend_elem(OP_LIST, NULL, NULL);
2924         check_op(a, "");
2925         a = op_prepend_elem(OP_LIST, a, iv_op(1));
2926         check_op(a, "const(1).");
2927         a = op_prepend_elem(OP_LIST, a, NULL);
2928         check_op(a, "const(1).");
2929         a = op_prepend_elem(OP_LIST, iv_op(2), a);
2930         check_op(a, "list[pushmark.const(2).const(1).]");
2931         a = op_prepend_elem(OP_LIST, iv_op(3), a);
2932         check_op(a, "list[pushmark.const(3).const(2).const(1).]");
2933         a = op_prepend_elem(OP_LIST, NULL, a);
2934         check_op(a, "list[pushmark.const(3).const(2).const(1).]");
2935         a = op_prepend_elem(OP_LIST, a, NULL);
2936         check_op(a, "list[pushmark.const(3).const(2).const(1).]");
2937         a = op_prepend_elem(OP_LIST, a, iv_op(4));
2938         check_op(a, "list[pushmark."
2939                 "list[pushmark.const(3).const(2).const(1).]const(4).]");
2940         a = op_prepend_elem(OP_LIST, iv_op(5), a);
2941         check_op(a, "list[pushmark.const(5)."
2942                 "list[pushmark.const(3).const(2).const(1).]const(4).]");
2943         a = op_prepend_elem(OP_LIST,
2944                 op_prepend_elem(OP_LIST, iv_op(6), iv_op(7)), a);
2945         check_op(a, "list[pushmark.list[pushmark.const(6).const(7).]const(5)."
2946                 "list[pushmark.const(3).const(2).const(1).]const(4).]");
2947         op_free(a);
2948         a = op_prepend_elem(OP_LINESEQ, iv_op(2), iv_op(1));
2949         check_op(a, "lineseq[const(2).const(1).]");
2950         a = op_prepend_elem(OP_LINESEQ, iv_op(3), a);
2951         check_op(a, "lineseq[const(3).const(2).const(1).]");
2952         op_free(a);
2953         a = op_prepend_elem(OP_LINESEQ, iv_op(3),
2954                 op_prepend_elem(OP_LIST, iv_op(2), iv_op(1)));
2955         check_op(a, "lineseq[const(3).list[pushmark.const(2).const(1).]]");
2956         op_free(a);
2957         a = op_append_list(OP_LINESEQ, NULL, NULL);
2958         check_op(a, "");
2959         a = op_append_list(OP_LINESEQ, iv_op(1), a);
2960         check_op(a, "const(1).");
2961         a = op_append_list(OP_LINESEQ, NULL, a);
2962         check_op(a, "const(1).");
2963         a = op_append_list(OP_LINESEQ, a, iv_op(2));
2964         check_op(a, "lineseq[const(1).const(2).]");
2965         a = op_append_list(OP_LINESEQ, a, iv_op(3));
2966         check_op(a, "lineseq[const(1).const(2).const(3).]");
2967         a = op_append_list(OP_LINESEQ, iv_op(4), a);
2968         check_op(a, "lineseq[const(4).const(1).const(2).const(3).]");
2969         a = op_append_list(OP_LINESEQ, a, NULL);
2970         check_op(a, "lineseq[const(4).const(1).const(2).const(3).]");
2971         a = op_append_list(OP_LINESEQ, NULL, a);
2972         check_op(a, "lineseq[const(4).const(1).const(2).const(3).]");
2973         a = op_append_list(OP_LINESEQ, a,
2974                 op_append_list(OP_LINESEQ, iv_op(5), iv_op(6)));
2975         check_op(a, "lineseq[const(4).const(1).const(2).const(3)."
2976                 "const(5).const(6).]");
2977         op_free(a);
2978         a = op_append_list(OP_LINESEQ,
2979                 op_append_list(OP_LINESEQ, iv_op(1), iv_op(2)),
2980                 op_append_list(OP_LIST, iv_op(3), iv_op(4)));
2981         check_op(a, "lineseq[const(1).const(2)."
2982                 "list[pushmark.const(3).const(4).]]");
2983         op_free(a);
2984         a = op_append_list(OP_LINESEQ,
2985                 op_append_list(OP_LIST, iv_op(1), iv_op(2)),
2986                 op_append_list(OP_LINESEQ, iv_op(3), iv_op(4)));
2987         check_op(a, "lineseq[list[pushmark.const(1).const(2).]"
2988                 "const(3).const(4).]");
2989         op_free(a);
2990 #undef check_op
2991
2992 void
2993 test_op_linklist ()
2994     PREINIT:
2995         OP *o;
2996     CODE:
2997 #define check_ll(o, expect) \
2998     STMT_START { \
2999         if (strNE(test_op_linklist_describe(o), (expect))) \
3000             croak("fail %s %s", test_op_linklist_describe(o), (expect)); \
3001     } STMT_END
3002         o = iv_op(1);
3003         check_ll(o, ".const1");
3004         op_free(o);
3005
3006         o = mkUNOP(OP_NOT, iv_op(1));
3007         check_ll(o, ".const1.not");
3008         op_free(o);
3009
3010         o = mkUNOP(OP_NOT, mkUNOP(OP_NEGATE, iv_op(1)));
3011         check_ll(o, ".const1.negate.not");
3012         op_free(o);
3013
3014         o = mkBINOP(OP_ADD, iv_op(1), iv_op(2));
3015         check_ll(o, ".const1.const2.add");
3016         op_free(o);
3017
3018         o = mkBINOP(OP_ADD, mkUNOP(OP_NOT, iv_op(1)), iv_op(2));
3019         check_ll(o, ".const1.not.const2.add");
3020         op_free(o);
3021
3022         o = mkUNOP(OP_NOT, mkBINOP(OP_ADD, iv_op(1), iv_op(2)));
3023         check_ll(o, ".const1.const2.add.not");
3024         op_free(o);
3025
3026         o = mkLISTOP(OP_LINESEQ, iv_op(1), iv_op(2), iv_op(3));
3027         check_ll(o, ".const1.const2.const3.lineseq");
3028         op_free(o);
3029
3030         o = mkLISTOP(OP_LINESEQ,
3031                 mkBINOP(OP_ADD, iv_op(1), iv_op(2)),
3032                 mkUNOP(OP_NOT, iv_op(3)),
3033                 mkLISTOP(OP_SUBSTR, iv_op(4), iv_op(5), iv_op(6)));
3034         check_ll(o, ".const1.const2.add.const3.not"
3035                     ".const4.const5.const6.substr.lineseq");
3036         op_free(o);
3037
3038         o = mkBINOP(OP_ADD, iv_op(1), iv_op(2));
3039         LINKLIST(o);
3040         o = mkBINOP(OP_SUBTRACT, o, iv_op(3));
3041         check_ll(o, ".const1.const2.add.const3.subtract");
3042         op_free(o);
3043 #undef check_ll
3044 #undef iv_op
3045
3046 void
3047 peep_enable ()
3048     PREINIT:
3049         dMY_CXT;
3050     CODE:
3051         av_clear(MY_CXT.peep_recorder);
3052         av_clear(MY_CXT.rpeep_recorder);
3053         MY_CXT.peep_recording = 1;
3054
3055 void
3056 peep_disable ()
3057     PREINIT:
3058         dMY_CXT;
3059     CODE:
3060         MY_CXT.peep_recording = 0;
3061
3062 SV *
3063 peep_record ()
3064     PREINIT:
3065         dMY_CXT;
3066     CODE:
3067         RETVAL = newRV_inc((SV *)MY_CXT.peep_recorder);
3068     OUTPUT:
3069         RETVAL
3070
3071 SV *
3072 rpeep_record ()
3073     PREINIT:
3074         dMY_CXT;
3075     CODE:
3076         RETVAL = newRV_inc((SV *)MY_CXT.rpeep_recorder);
3077     OUTPUT:
3078         RETVAL
3079
3080 =pod
3081
3082 multicall_each: call a sub for each item in the list. Used to test MULTICALL
3083
3084 =cut
3085
3086 void
3087 multicall_each(block,...)
3088     SV * block
3089 PROTOTYPE: &@
3090 CODE:
3091 {
3092     dMULTICALL;
3093     int index;
3094     GV *gv;
3095     HV *stash;
3096     I32 gimme = G_SCALAR;
3097     SV **args = &PL_stack_base[ax];
3098     CV *cv;
3099
3100     if(items <= 1) {
3101         XSRETURN_UNDEF;
3102     }
3103     cv = sv_2cv(block, &stash, &gv, 0);
3104     if (cv == Nullcv) {
3105        croak("multicall_each: not a subroutine reference");
3106     }
3107     PUSH_MULTICALL(cv);
3108     SAVESPTR(GvSV(PL_defgv));
3109
3110     for(index = 1 ; index < items ; index++) {
3111         GvSV(PL_defgv) = args[index];
3112         MULTICALL;
3113     }
3114     POP_MULTICALL;
3115     PERL_UNUSED_VAR(newsp);
3116     XSRETURN_UNDEF;
3117 }
3118
3119 #ifdef USE_ITHREADS
3120
3121 void
3122 clone_with_stack()
3123 CODE:
3124 {
3125     PerlInterpreter *interp = aTHX; /* The original interpreter */
3126     PerlInterpreter *interp_dup;    /* The duplicate interpreter */
3127     int oldscope = 1; /* We are responsible for all scopes */
3128
3129     interp_dup = perl_clone(interp, CLONEf_COPY_STACKS | CLONEf_CLONE_HOST );
3130
3131     /* destroy old perl */
3132     PERL_SET_CONTEXT(interp);
3133
3134     POPSTACK_TO(PL_mainstack);
3135     dounwind(-1);
3136     LEAVE_SCOPE(0);
3137
3138     while (interp->Iscopestack_ix > 1)
3139         LEAVE;
3140     FREETMPS;
3141
3142     perl_destruct(interp);
3143     perl_free(interp);
3144
3145     /* switch to new perl */
3146     PERL_SET_CONTEXT(interp_dup);
3147
3148     /* continue after 'clone_with_stack' */
3149     if (interp_dup->Iop)
3150         interp_dup->Iop = interp_dup->Iop->op_next;
3151
3152     /* run with new perl */
3153     Perl_runops_standard(interp_dup);
3154
3155     /* We may have additional unclosed scopes if fork() was called
3156      * from within a BEGIN block.  See perlfork.pod for more details.
3157      * We cannot clean up these other scopes because they belong to a
3158      * different interpreter, but we also cannot leave PL_scopestack_ix
3159      * dangling because that can trigger an assertion in perl_destruct().
3160      */
3161     if (PL_scopestack_ix > oldscope) {
3162         PL_scopestack[oldscope-1] = PL_scopestack[PL_scopestack_ix-1];
3163         PL_scopestack_ix = oldscope;
3164     }
3165
3166     perl_destruct(interp_dup);
3167     perl_free(interp_dup);
3168
3169     /* call the real 'exit' not PerlProc_exit */
3170 #undef exit
3171     exit(0);
3172 }
3173
3174 #endif /* USE_ITHREDS */
3175
3176 SV*
3177 take_svref(SVREF sv)
3178 CODE:
3179     RETVAL = newRV_inc(sv);
3180 OUTPUT:
3181     RETVAL
3182
3183 SV*
3184 take_avref(AV* av)
3185 CODE:
3186     RETVAL = newRV_inc((SV*)av);
3187 OUTPUT:
3188     RETVAL
3189
3190 SV*
3191 take_hvref(HV* hv)
3192 CODE:
3193     RETVAL = newRV_inc((SV*)hv);
3194 OUTPUT:
3195     RETVAL
3196
3197
3198 SV*
3199 take_cvref(CV* cv)
3200 CODE:
3201     RETVAL = newRV_inc((SV*)cv);
3202 OUTPUT:
3203     RETVAL
3204
3205
3206 BOOT:
3207         {
3208         HV* stash;
3209         SV** meth = NULL;
3210         CV* cv;
3211         stash = gv_stashpv("XS::APItest::TempLv", 0);
3212         if (stash)
3213             meth = hv_fetchs(stash, "make_temp_mg_lv", 0);
3214         if (!meth)
3215             croak("lost method 'make_temp_mg_lv'");
3216         cv = GvCV(*meth);
3217         CvLVALUE_on(cv);
3218         }
3219
3220 BOOT:
3221 {
3222     hintkey_rpn_sv = newSVpvs_share("XS::APItest/rpn");
3223     hintkey_calcrpn_sv = newSVpvs_share("XS::APItest/calcrpn");
3224     hintkey_stufftest_sv = newSVpvs_share("XS::APItest/stufftest");
3225     hintkey_swaptwostmts_sv = newSVpvs_share("XS::APItest/swaptwostmts");
3226     hintkey_looprest_sv = newSVpvs_share("XS::APItest/looprest");
3227     hintkey_scopelessblock_sv = newSVpvs_share("XS::APItest/scopelessblock");
3228     hintkey_stmtasexpr_sv = newSVpvs_share("XS::APItest/stmtasexpr");
3229     hintkey_stmtsasexpr_sv = newSVpvs_share("XS::APItest/stmtsasexpr");
3230     hintkey_loopblock_sv = newSVpvs_share("XS::APItest/loopblock");
3231     hintkey_blockasexpr_sv = newSVpvs_share("XS::APItest/blockasexpr");
3232     hintkey_swaplabel_sv = newSVpvs_share("XS::APItest/swaplabel");
3233     hintkey_labelconst_sv = newSVpvs_share("XS::APItest/labelconst");
3234     hintkey_arrayfullexpr_sv = newSVpvs_share("XS::APItest/arrayfullexpr");
3235     hintkey_arraylistexpr_sv = newSVpvs_share("XS::APItest/arraylistexpr");
3236     hintkey_arraytermexpr_sv = newSVpvs_share("XS::APItest/arraytermexpr");
3237     hintkey_arrayarithexpr_sv = newSVpvs_share("XS::APItest/arrayarithexpr");
3238     hintkey_arrayexprflags_sv = newSVpvs_share("XS::APItest/arrayexprflags");
3239     next_keyword_plugin = PL_keyword_plugin;
3240     PL_keyword_plugin = my_keyword_plugin;
3241 }
3242
3243 void
3244 establish_cleanup(...)
3245 PROTOTYPE: $
3246 CODE:
3247     PERL_UNUSED_VAR(items);
3248     croak("establish_cleanup called as a function");
3249
3250 BOOT:
3251 {
3252     CV *estcv = get_cv("XS::APItest::establish_cleanup", 0);
3253     cv_set_call_checker(estcv, THX_ck_entersub_establish_cleanup, (SV*)estcv);
3254 }
3255
3256 void
3257 postinc(...)
3258 PROTOTYPE: $
3259 CODE:
3260     PERL_UNUSED_VAR(items);
3261     croak("postinc called as a function");
3262
3263 void
3264 filter()
3265 CODE:
3266     filter_add(filter_call, NULL);
3267
3268 BOOT:
3269 {
3270     CV *asscv = get_cv("XS::APItest::postinc", 0);
3271     cv_set_call_checker(asscv, THX_ck_entersub_postinc, (SV*)asscv);
3272 }
3273
3274 SV *
3275 lv_temp_object()
3276 CODE:
3277     RETVAL =
3278           sv_bless(
3279             newRV_noinc(newSV(0)),
3280             gv_stashpvs("XS::APItest::TempObj",GV_ADD)
3281           );             /* Package defined in test script */
3282 OUTPUT:
3283     RETVAL
3284
3285 void
3286 fill_hash_with_nulls(HV *hv)
3287 PREINIT:
3288     UV i = 0;
3289 CODE:
3290     for(; i < 1000; ++i) {
3291         HE *entry = hv_fetch_ent(hv, sv_2mortal(newSVuv(i)), 1, 0);
3292         SvREFCNT_dec(HeVAL(entry));
3293         HeVAL(entry) = NULL;
3294     }
3295
3296 HV *
3297 newHVhv(HV *hv)
3298 CODE:
3299     RETVAL = newHVhv(hv);
3300 OUTPUT:
3301     RETVAL
3302
3303 U32
3304 SvIsCOW(SV *sv)
3305 CODE:
3306     RETVAL = SvIsCOW(sv);
3307 OUTPUT:
3308     RETVAL
3309
3310 void
3311 pad_scalar(...)
3312 PROTOTYPE: $$
3313 CODE:
3314     PERL_UNUSED_VAR(items);
3315     croak("pad_scalar called as a function");
3316
3317 BOOT:
3318 {
3319     CV *pscv = get_cv("XS::APItest::pad_scalar", 0);
3320     cv_set_call_checker(pscv, THX_ck_entersub_pad_scalar, (SV*)pscv);
3321 }
3322
3323 SV*
3324 fetch_pad_names( cv )
3325 CV* cv
3326  PREINIT:
3327   I32 i;
3328   PADNAMELIST *pad_namelist;
3329   AV *retav = newAV();
3330  CODE:
3331   pad_namelist = PadlistNAMES(CvPADLIST(cv));
3332
3333   for ( i = PadnamelistMAX(pad_namelist); i >= 0; i-- ) {
3334     PADNAME* name = PadnamelistARRAY(pad_namelist)[i];
3335
3336     if (PadnameLEN(name)) {
3337         av_push(retav, newSVpadname(name));
3338     }
3339   }
3340   RETVAL = newRV_noinc((SV*)retav);
3341  OUTPUT:
3342   RETVAL
3343
3344 STRLEN
3345 underscore_length()
3346 PROTOTYPE:
3347 PREINIT:
3348     SV *u;
3349     U8 *pv;
3350     STRLEN bytelen;
3351 CODE:
3352     u = find_rundefsv();
3353     pv = (U8*)SvPV(u, bytelen);
3354     RETVAL = SvUTF8(u) ? utf8_length(pv, pv+bytelen) : bytelen;
3355 OUTPUT:
3356     RETVAL
3357
3358 void
3359 stringify(SV *sv)
3360 CODE:
3361     (void)SvPV_nolen(sv);
3362
3363 SV *
3364 HvENAME(HV *hv)
3365 CODE:
3366     RETVAL = hv && HvENAME(hv)
3367               ? newSVpvn_flags(
3368                   HvENAME(hv),HvENAMELEN(hv),
3369                   (HvENAMEUTF8(hv) ? SVf_UTF8 : 0)
3370                 )
3371               : NULL;
3372 OUTPUT:
3373     RETVAL
3374
3375 int
3376 xs_cmp(int a, int b)
3377 CODE:
3378     /* Odd sorting (odd numbers first), to make sure we are actually
3379        being called */
3380     RETVAL = a % 2 != b % 2
3381                ? a % 2 ? -1 : 1
3382                : a < b ? -1 : a == b ? 0 : 1;
3383 OUTPUT:
3384     RETVAL
3385
3386 SV *
3387 xs_cmp_undef(SV *a, SV *b)
3388 CODE:
3389     PERL_UNUSED_ARG(a);
3390     PERL_UNUSED_ARG(b);
3391     RETVAL = &PL_sv_undef;
3392 OUTPUT:
3393     RETVAL
3394
3395 char *
3396 SvPVbyte(SV *sv)
3397 CODE:
3398     RETVAL = SvPVbyte_nolen(sv);
3399 OUTPUT:
3400     RETVAL
3401
3402 char *
3403 SvPVutf8(SV *sv)
3404 CODE:
3405     RETVAL = SvPVutf8_nolen(sv);
3406 OUTPUT:
3407     RETVAL
3408
3409 void
3410 setup_addissub()
3411 CODE:
3412     wrap_op_checker(OP_ADD, addissub_myck_add, &addissub_nxck_add);
3413
3414 void
3415 setup_rv2cv_addunderbar()
3416 CODE:
3417     wrap_op_checker(OP_RV2CV, my_ck_rv2cv, &old_ck_rv2cv);
3418
3419 #ifdef USE_ITHREADS
3420
3421 bool
3422 test_alloccopstash()
3423 CODE:
3424     RETVAL = PL_stashpad[alloccopstash(PL_defstash)] == PL_defstash;
3425 OUTPUT:
3426     RETVAL
3427
3428 #endif
3429
3430 bool
3431 test_newFOROP_without_slab()
3432 CODE:
3433     {
3434         const I32 floor = start_subparse(0,0);
3435         /* The slab allocator does not like CvROOT being set. */
3436         CvROOT(PL_compcv) = (OP *)1;
3437         op_free(newFOROP(0, 0, newOP(OP_PUSHMARK, 0), 0, 0));
3438         CvROOT(PL_compcv) = NULL;
3439         SvREFCNT_dec(PL_compcv);
3440         LEAVE_SCOPE(floor);
3441         /* If we have not crashed yet, then the test passes. */
3442         RETVAL = TRUE;
3443     }
3444 OUTPUT:
3445     RETVAL
3446
3447  # provide access to CALLREGEXEC, except replace pointers within the
3448  # string with offsets from the start of the string
3449
3450 I32
3451 callregexec(SV *prog, STRLEN stringarg, STRLEN strend, I32 minend, SV *sv, U32 nosave)
3452 CODE:
3453     {
3454         STRLEN len;
3455         char *strbeg;
3456         if (SvROK(prog))
3457             prog = SvRV(prog);
3458         strbeg = SvPV_force(sv, len);
3459         RETVAL = CALLREGEXEC((REGEXP *)prog,
3460                             strbeg + stringarg,
3461                             strbeg + strend,
3462                             strbeg,
3463                             minend,
3464                             sv,
3465                             NULL, /* data */
3466                             nosave);
3467     }
3468 OUTPUT:
3469     RETVAL
3470
3471 void
3472 lexical_import(SV *name, CV *cv)
3473     CODE:
3474     {
3475         PADLIST *pl;
3476         PADOFFSET off;
3477         if (!PL_compcv)
3478             Perl_croak(aTHX_
3479                       "lexical_import can only be called at compile time");
3480         pl = CvPADLIST(PL_compcv);
3481         ENTER;
3482         SAVESPTR(PL_comppad_name); PL_comppad_name = PadlistNAMES(pl);
3483         SAVESPTR(PL_comppad);      PL_comppad      = PadlistARRAY(pl)[1];
3484         SAVESPTR(PL_curpad);       PL_curpad       = PadARRAY(PL_comppad);
3485         off = pad_add_name_sv(sv_2mortal(newSVpvf("&%"SVf,name)),
3486                               padadd_STATE, 0, 0);
3487         SvREFCNT_dec(PL_curpad[off]);
3488         PL_curpad[off] = SvREFCNT_inc(cv);
3489         LEAVE;
3490     }
3491
3492 SV *
3493 sv_mortalcopy(SV *sv)
3494     CODE:
3495         RETVAL = SvREFCNT_inc(sv_mortalcopy(sv));
3496     OUTPUT:
3497         RETVAL
3498
3499 SV *
3500 newRV(SV *sv)
3501
3502 void
3503 alias_av(AV *av, IV ix, SV *sv)
3504     CODE:
3505         av_store(av, ix, SvREFCNT_inc(sv));
3506
3507 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
3508
3509 int
3510 AUTOLOAD(...)
3511   INIT:
3512     SV* comms;
3513     SV* class_and_method;
3514   CODE:
3515     PERL_UNUSED_ARG(items);
3516     class_and_method = GvSV(CvGV(cv));
3517     comms = get_sv("main::the_method", 1);
3518     if (class_and_method == NULL) {
3519       RETVAL = 1;
3520     } else if (!SvOK(class_and_method)) {
3521       RETVAL = 2;
3522     } else if (!SvPOK(class_and_method)) {
3523       RETVAL = 3;
3524     } else {
3525       sv_setsv(comms, class_and_method);
3526       RETVAL = 0;
3527     }
3528   OUTPUT: RETVAL
3529
3530
3531 MODULE = XS::APItest            PACKAGE = XS::APItest::Magic
3532
3533 PROTOTYPES: DISABLE
3534
3535 void
3536 sv_magic_foo(SV *sv, SV *thingy)
3537 ALIAS:
3538     sv_magic_bar = 1
3539 CODE:
3540     sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, ix ? &vtbl_bar : &vtbl_foo, (const char *)thingy, 0);
3541
3542 SV *
3543 mg_find_foo(SV *sv)
3544 ALIAS:
3545     mg_find_bar = 1
3546 CODE:
3547     MAGIC *mg = mg_findext(SvRV(sv), PERL_MAGIC_ext, ix ? &vtbl_bar : &vtbl_foo);
3548     RETVAL = mg ? SvREFCNT_inc((SV *)mg->mg_ptr) : &PL_sv_undef;
3549 OUTPUT:
3550     RETVAL
3551
3552 void
3553 sv_unmagic_foo(SV *sv)
3554 ALIAS:
3555     sv_unmagic_bar = 1
3556 CODE:
3557     sv_unmagicext(SvRV(sv), PERL_MAGIC_ext, ix ? &vtbl_bar : &vtbl_foo);
3558
3559 UV
3560 test_get_vtbl()
3561     PREINIT:
3562         MGVTBL *have;
3563         MGVTBL *want;
3564     CODE:
3565 #define test_get_this_vtable(name) \
3566         want = CAT2(&PL_vtbl_, name); \
3567         have = get_vtbl(CAT2(want_vtbl_, name)); \
3568         if (have != want) \
3569             croak("fail %p!=%p for get_vtbl(want_vtbl_" STRINGIFY(name) ") at " __FILE__ " line %d", have, want, __LINE__)
3570
3571         test_get_this_vtable(sv);
3572         test_get_this_vtable(env);
3573         test_get_this_vtable(envelem);
3574         test_get_this_vtable(sigelem);
3575         test_get_this_vtable(pack);
3576         test_get_this_vtable(packelem);
3577         test_get_this_vtable(dbline);
3578         test_get_this_vtable(isa);
3579         test_get_this_vtable(isaelem);
3580         test_get_this_vtable(arylen);
3581         test_get_this_vtable(mglob);
3582         test_get_this_vtable(nkeys);
3583         test_get_this_vtable(taint);
3584         test_get_this_vtable(substr);
3585         test_get_this_vtable(vec);
3586         test_get_this_vtable(pos);
3587         test_get_this_vtable(bm);
3588         test_get_this_vtable(fm);
3589         test_get_this_vtable(uvar);
3590         test_get_this_vtable(defelem);
3591         test_get_this_vtable(regexp);
3592         test_get_this_vtable(regdata);
3593         test_get_this_vtable(regdatum);
3594 #ifdef USE_LOCALE_COLLATE
3595         test_get_this_vtable(collxfrm);
3596 #endif
3597         test_get_this_vtable(backref);
3598         test_get_this_vtable(utf8);
3599
3600         RETVAL = PTR2UV(get_vtbl(-1));
3601     OUTPUT:
3602         RETVAL
3603
3604 bool
3605 test_isBLANK_uni(UV ord)
3606     CODE:
3607         RETVAL = isBLANK_uni(ord);
3608     OUTPUT:
3609         RETVAL
3610
3611 bool
3612 test_isBLANK_LC_uvchr(UV ord)
3613     CODE:
3614         RETVAL = isBLANK_LC_uvchr(ord);
3615     OUTPUT:
3616         RETVAL
3617
3618 bool
3619 test_isBLANK_A(UV ord)
3620     CODE:
3621         RETVAL = isBLANK_A(ord);
3622     OUTPUT:
3623         RETVAL
3624
3625 bool
3626 test_isBLANK_L1(UV ord)
3627     CODE:
3628         RETVAL = isBLANK_L1(ord);
3629     OUTPUT:
3630         RETVAL
3631
3632 bool
3633 test_isBLANK_LC(UV ord)
3634     CODE:
3635         RETVAL = isBLANK_LC(ord);
3636     OUTPUT:
3637         RETVAL
3638
3639 bool
3640 test_isBLANK_utf8(unsigned char * p)
3641     CODE:
3642         RETVAL = isBLANK_utf8(p);
3643     OUTPUT:
3644         RETVAL
3645
3646 bool
3647 test_isBLANK_LC_utf8(unsigned char * p)
3648     CODE:
3649         RETVAL = isBLANK_LC_utf8(p);
3650     OUTPUT:
3651         RETVAL
3652
3653 bool
3654 test_isVERTWS_uni(UV ord)
3655     CODE:
3656         RETVAL = isVERTWS_uni(ord);
3657     OUTPUT:
3658         RETVAL
3659
3660 bool
3661 test_isVERTWS_utf8(unsigned char * p)
3662     CODE:
3663         RETVAL = isVERTWS_utf8(p);
3664     OUTPUT:
3665         RETVAL
3666
3667 bool
3668 test_isUPPER_uni(UV ord)
3669     CODE:
3670         RETVAL = isUPPER_uni(ord);
3671     OUTPUT:
3672         RETVAL
3673
3674 bool
3675 test_isUPPER_LC_uvchr(UV ord)
3676     CODE:
3677         RETVAL = isUPPER_LC_uvchr(ord);
3678     OUTPUT:
3679         RETVAL
3680
3681 bool
3682 test_isUPPER_A(UV ord)
3683     CODE:
3684         RETVAL = isUPPER_A(ord);
3685     OUTPUT:
3686         RETVAL
3687
3688 bool
3689 test_isUPPER_L1(UV ord)
3690     CODE:
3691         RETVAL = isUPPER_L1(ord);
3692     OUTPUT:
3693         RETVAL
3694
3695 bool
3696 test_isUPPER_LC(UV ord)
3697     CODE:
3698         RETVAL = isUPPER_LC(ord);
3699     OUTPUT:
3700         RETVAL
3701
3702 bool
3703 test_isUPPER_utf8(unsigned char * p)
3704     CODE:
3705         RETVAL = isUPPER_utf8( p);
3706     OUTPUT:
3707         RETVAL
3708
3709 bool
3710 test_isUPPER_LC_utf8(unsigned char * p)
3711     CODE:
3712         RETVAL = isUPPER_LC_utf8( p);
3713     OUTPUT:
3714         RETVAL
3715
3716 bool
3717 test_isLOWER_uni(UV ord)
3718     CODE:
3719         RETVAL = isLOWER_uni(ord);
3720     OUTPUT:
3721         RETVAL
3722
3723 bool
3724 test_isLOWER_LC_uvchr(UV ord)
3725     CODE:
3726         RETVAL = isLOWER_LC_uvchr(ord);
3727     OUTPUT:
3728         RETVAL
3729
3730 bool
3731 test_isLOWER_A(UV ord)
3732     CODE:
3733         RETVAL = isLOWER_A(ord);
3734     OUTPUT:
3735         RETVAL
3736
3737 bool
3738 test_isLOWER_L1(UV ord)
3739     CODE:
3740         RETVAL = isLOWER_L1(ord);
3741     OUTPUT:
3742         RETVAL
3743
3744 bool
3745 test_isLOWER_LC(UV ord)
3746     CODE:
3747         RETVAL = isLOWER_LC(ord);
3748     OUTPUT:
3749         RETVAL
3750
3751 bool
3752 test_isLOWER_utf8(unsigned char * p)
3753     CODE:
3754         RETVAL = isLOWER_utf8( p);
3755     OUTPUT:
3756         RETVAL
3757
3758 bool
3759 test_isLOWER_LC_utf8(unsigned char * p)
3760     CODE:
3761         RETVAL = isLOWER_LC_utf8( p);
3762     OUTPUT:
3763         RETVAL
3764
3765 bool
3766 test_isALPHA_uni(UV ord)
3767     CODE:
3768         RETVAL = isALPHA_uni(ord);
3769     OUTPUT:
3770         RETVAL
3771
3772 bool
3773 test_isALPHA_LC_uvchr(UV ord)
3774     CODE:
3775         RETVAL = isALPHA_LC_uvchr(ord);
3776     OUTPUT:
3777         RETVAL
3778
3779 bool
3780 test_isALPHA_A(UV ord)
3781     CODE:
3782         RETVAL = isALPHA_A(ord);
3783     OUTPUT:
3784         RETVAL
3785
3786 bool
3787 test_isALPHA_L1(UV ord)
3788     CODE:
3789         RETVAL = isALPHA_L1(ord);
3790     OUTPUT:
3791         RETVAL
3792
3793 bool
3794 test_isALPHA_LC(UV ord)
3795     CODE:
3796         RETVAL = isALPHA_LC(ord);
3797     OUTPUT:
3798         RETVAL
3799
3800 bool
3801 test_isALPHA_utf8(unsigned char * p)
3802     CODE:
3803         RETVAL = isALPHA_utf8( p);
3804     OUTPUT:
3805         RETVAL
3806
3807 bool
3808 test_isALPHA_LC_utf8(unsigned char * p)
3809     CODE:
3810         RETVAL = isALPHA_LC_utf8( p);
3811     OUTPUT:
3812         RETVAL
3813
3814 bool
3815 test_isWORDCHAR_uni(UV ord)
3816     CODE:
3817         RETVAL = isWORDCHAR_uni(ord);
3818     OUTPUT:
3819         RETVAL
3820
3821 bool
3822 test_isWORDCHAR_LC_uvchr(UV ord)
3823     CODE:
3824         RETVAL = isWORDCHAR_LC_uvchr(ord);
3825     OUTPUT:
3826         RETVAL
3827
3828 bool
3829 test_isWORDCHAR_A(UV ord)
3830     CODE:
3831         RETVAL = isWORDCHAR_A(ord);
3832     OUTPUT:
3833         RETVAL
3834
3835 bool
3836 test_isWORDCHAR_L1(UV ord)
3837     CODE:
3838         RETVAL = isWORDCHAR_L1(ord);
3839     OUTPUT:
3840         RETVAL
3841
3842 bool
3843 test_isWORDCHAR_LC(UV ord)
3844     CODE:
3845         RETVAL = isWORDCHAR_LC(ord);
3846     OUTPUT:
3847         RETVAL
3848
3849 bool
3850 test_isWORDCHAR_utf8(unsigned char * p)
3851     CODE:
3852         RETVAL = isWORDCHAR_utf8( p);
3853     OUTPUT:
3854         RETVAL
3855
3856 bool
3857 test_isWORDCHAR_LC_utf8(unsigned char * p)
3858     CODE:
3859         RETVAL = isWORDCHAR_LC_utf8( p);
3860     OUTPUT:
3861         RETVAL
3862
3863 bool
3864 test_isALPHANUMERIC_uni(UV ord)
3865     CODE:
3866         RETVAL = isALPHANUMERIC_uni(ord);
3867     OUTPUT:
3868         RETVAL
3869
3870 bool
3871 test_isALPHANUMERIC_LC_uvchr(UV ord)
3872     CODE:
3873         RETVAL = isALPHANUMERIC_LC_uvchr(ord);
3874     OUTPUT:
3875         RETVAL
3876
3877 bool
3878 test_isALPHANUMERIC_A(UV ord)
3879     CODE:
3880         RETVAL = isALPHANUMERIC_A(ord);
3881     OUTPUT:
3882         RETVAL
3883
3884 bool
3885 test_isALPHANUMERIC_L1(UV ord)
3886     CODE:
3887         RETVAL = isALPHANUMERIC_L1(ord);
3888     OUTPUT:
3889         RETVAL
3890
3891 bool
3892 test_isALPHANUMERIC_LC(UV ord)
3893     CODE:
3894         RETVAL = isALPHANUMERIC_LC(ord);
3895     OUTPUT:
3896         RETVAL
3897
3898 bool
3899 test_isALPHANUMERIC_utf8(unsigned char * p)
3900     CODE:
3901         RETVAL = isALPHANUMERIC_utf8( p);
3902     OUTPUT:
3903         RETVAL
3904
3905 bool
3906 test_isALPHANUMERIC_LC_utf8(unsigned char * p)
3907     CODE:
3908         RETVAL = isALPHANUMERIC_LC_utf8( p);
3909     OUTPUT:
3910         RETVAL
3911
3912 bool
3913 test_isALNUM_uni(UV ord)
3914     CODE:
3915         RETVAL = isALNUM_uni(ord);
3916     OUTPUT:
3917         RETVAL
3918
3919 bool
3920 test_isALNUM_LC_uvchr(UV ord)
3921     CODE:
3922         RETVAL = isALNUM_LC_uvchr(ord);
3923     OUTPUT:
3924         RETVAL
3925
3926 bool
3927 test_isALNUM_LC(UV ord)
3928     CODE:
3929         RETVAL = isALNUM_LC(ord);
3930     OUTPUT:
3931         RETVAL
3932
3933 bool
3934 test_isALNUM_utf8(unsigned char * p)
3935     CODE:
3936         RETVAL = isALNUM_utf8( p);
3937     OUTPUT:
3938         RETVAL
3939
3940 bool
3941 test_isALNUM_LC_utf8(unsigned char * p)
3942     CODE:
3943         RETVAL = isALNUM_LC_utf8( p);
3944     OUTPUT:
3945         RETVAL
3946
3947 bool
3948 test_isDIGIT_uni(UV ord)
3949     CODE:
3950         RETVAL = isDIGIT_uni(ord);
3951     OUTPUT:
3952         RETVAL
3953
3954 bool
3955 test_isDIGIT_LC_uvchr(UV ord)
3956     CODE:
3957         RETVAL = isDIGIT_LC_uvchr(ord);
3958     OUTPUT:
3959         RETVAL
3960
3961 bool
3962 test_isDIGIT_utf8(unsigned char * p)
3963     CODE:
3964         RETVAL = isDIGIT_utf8( p);
3965     OUTPUT:
3966         RETVAL
3967
3968 bool
3969 test_isDIGIT_LC_utf8(unsigned char * p)
3970     CODE:
3971         RETVAL = isDIGIT_LC_utf8( p);
3972     OUTPUT:
3973         RETVAL
3974
3975 bool
3976 test_isDIGIT_A(UV ord)
3977     CODE:
3978         RETVAL = isDIGIT_A(ord);
3979     OUTPUT:
3980         RETVAL
3981
3982 bool
3983 test_isDIGIT_L1(UV ord)
3984     CODE:
3985         RETVAL = isDIGIT_L1(ord);
3986     OUTPUT:
3987         RETVAL
3988
3989 bool
3990 test_isDIGIT_LC(UV ord)
3991     CODE:
3992         RETVAL = isDIGIT_LC(ord);
3993     OUTPUT:
3994         RETVAL
3995
3996 bool
3997 test_isIDFIRST_uni(UV ord)
3998     CODE:
3999         RETVAL = isIDFIRST_uni(ord);
4000     OUTPUT:
4001         RETVAL
4002
4003 bool
4004 test_isIDFIRST_LC_uvchr(UV ord)
4005     CODE:
4006         RETVAL = isIDFIRST_LC_uvchr(ord);
4007     OUTPUT:
4008         RETVAL
4009
4010 bool
4011 test_isIDFIRST_A(UV ord)
4012     CODE:
4013         RETVAL = isIDFIRST_A(ord);
4014     OUTPUT:
4015         RETVAL
4016
4017 bool
4018 test_isIDFIRST_L1(UV ord)
4019     CODE:
4020         RETVAL = isIDFIRST_L1(ord);
4021     OUTPUT:
4022         RETVAL
4023
4024 bool
4025 test_isIDFIRST_LC(UV ord)
4026     CODE:
4027         RETVAL = isIDFIRST_LC(ord);
4028     OUTPUT:
4029         RETVAL
4030
4031 bool
4032 test_isIDFIRST_utf8(unsigned char * p)
4033     CODE:
4034         RETVAL = isIDFIRST_utf8( p);
4035     OUTPUT:
4036         RETVAL
4037
4038 bool
4039 test_isIDFIRST_LC_utf8(unsigned char * p)
4040     CODE:
4041         RETVAL = isIDFIRST_LC_utf8( p);
4042     OUTPUT:
4043         RETVAL
4044
4045 bool
4046 test_isIDCONT_uni(UV ord)
4047     CODE:
4048         RETVAL = isIDCONT_uni(ord);
4049     OUTPUT:
4050         RETVAL
4051
4052 bool
4053 test_isIDCONT_LC_uvchr(UV ord)
4054     CODE:
4055         RETVAL = isIDCONT_LC_uvchr(ord);
4056     OUTPUT:
4057         RETVAL
4058
4059 bool
4060 test_isIDCONT_A(UV ord)
4061     CODE:
4062         RETVAL = isIDCONT_A(ord);
4063     OUTPUT:
4064         RETVAL
4065
4066 bool
4067 test_isIDCONT_L1(UV ord)
4068     CODE:
4069         RETVAL = isIDCONT_L1(ord);
4070     OUTPUT:
4071         RETVAL
4072
4073 bool
4074 test_isIDCONT_LC(UV ord)
4075     CODE:
4076         RETVAL = isIDCONT_LC(ord);
4077     OUTPUT:
4078         RETVAL
4079
4080 bool
4081 test_isIDCONT_utf8(unsigned char * p)
4082     CODE:
4083         RETVAL = isIDCONT_utf8( p);
4084     OUTPUT:
4085         RETVAL
4086
4087 bool
4088 test_isIDCONT_LC_utf8(unsigned char * p)
4089     CODE:
4090         RETVAL = isIDCONT_LC_utf8( p);
4091     OUTPUT:
4092         RETVAL
4093
4094 bool
4095 test_isSPACE_uni(UV ord)
4096     CODE:
4097         RETVAL = isSPACE_uni(ord);
4098     OUTPUT:
4099         RETVAL
4100
4101 bool
4102 test_isSPACE_LC_uvchr(UV ord)
4103     CODE:
4104         RETVAL = isSPACE_LC_uvchr(ord);
4105     OUTPUT:
4106         RETVAL
4107
4108 bool
4109 test_isSPACE_A(UV ord)
4110     CODE:
4111         RETVAL = isSPACE_A(ord);
4112     OUTPUT:
4113         RETVAL
4114
4115 bool
4116 test_isSPACE_L1(UV ord)
4117     CODE:
4118         RETVAL = isSPACE_L1(ord);
4119     OUTPUT:
4120         RETVAL
4121
4122 bool
4123 test_isSPACE_LC(UV ord)
4124     CODE:
4125         RETVAL = isSPACE_LC(ord);
4126     OUTPUT:
4127         RETVAL
4128
4129 bool
4130 test_isSPACE_utf8(unsigned char * p)
4131     CODE:
4132         RETVAL = isSPACE_utf8( p);
4133     OUTPUT:
4134         RETVAL
4135
4136 bool
4137 test_isSPACE_LC_utf8(unsigned char * p)
4138     CODE:
4139         RETVAL = isSPACE_LC_utf8( p);
4140     OUTPUT:
4141         RETVAL
4142
4143 bool
4144 test_isASCII_uni(UV ord)
4145     CODE:
4146         RETVAL = isASCII_uni(ord);
4147     OUTPUT:
4148         RETVAL
4149
4150 bool
4151 test_isASCII_LC_uvchr(UV ord)
4152     CODE:
4153         RETVAL = isASCII_LC_uvchr(ord);
4154     OUTPUT:
4155         RETVAL
4156
4157 bool
4158 test_isASCII_A(UV ord)
4159     CODE:
4160         RETVAL = isASCII_A(ord);
4161     OUTPUT:
4162         RETVAL
4163
4164 bool
4165 test_isASCII_L1(UV ord)
4166     CODE:
4167         RETVAL = isASCII_L1(ord);
4168     OUTPUT:
4169         RETVAL
4170
4171 bool
4172 test_isASCII_LC(UV ord)
4173     CODE:
4174         RETVAL = isASCII_LC(ord);
4175     OUTPUT:
4176         RETVAL
4177
4178 bool
4179 test_isASCII_utf8(unsigned char * p)
4180     CODE:
4181         RETVAL = isASCII_utf8( p);
4182     OUTPUT:
4183         RETVAL
4184
4185 bool
4186 test_isASCII_LC_utf8(unsigned char * p)
4187     CODE:
4188         RETVAL = isASCII_LC_utf8( p);
4189     OUTPUT:
4190         RETVAL
4191
4192 bool
4193 test_isCNTRL_uni(UV ord)
4194     CODE:
4195         RETVAL = isCNTRL_uni(ord);
4196     OUTPUT:
4197         RETVAL
4198
4199 bool
4200 test_isCNTRL_LC_uvchr(UV ord)
4201     CODE:
4202         RETVAL = isCNTRL_LC_uvchr(ord);
4203     OUTPUT:
4204         RETVAL
4205
4206 bool
4207 test_isCNTRL_A(UV ord)
4208     CODE:
4209         RETVAL = isCNTRL_A(ord);
4210     OUTPUT:
4211         RETVAL
4212
4213 bool
4214 test_isCNTRL_L1(UV ord)
4215     CODE:
4216         RETVAL = isCNTRL_L1(ord);
4217     OUTPUT:
4218         RETVAL
4219
4220 bool
4221 test_isCNTRL_LC(UV ord)
4222     CODE:
4223         RETVAL = isCNTRL_LC(ord);
4224     OUTPUT:
4225         RETVAL
4226
4227 bool
4228 test_isCNTRL_utf8(unsigned char * p)
4229     CODE:
4230         RETVAL = isCNTRL_utf8( p);
4231     OUTPUT:
4232         RETVAL
4233
4234 bool
4235 test_isCNTRL_LC_utf8(unsigned char * p)
4236     CODE:
4237         RETVAL = isCNTRL_LC_utf8( p);
4238     OUTPUT:
4239         RETVAL
4240
4241 bool
4242 test_isPRINT_uni(UV ord)
4243     CODE:
4244         RETVAL = isPRINT_uni(ord);
4245     OUTPUT:
4246         RETVAL
4247
4248 bool
4249 test_isPRINT_LC_uvchr(UV ord)
4250     CODE:
4251         RETVAL = isPRINT_LC_uvchr(ord);
4252     OUTPUT:
4253         RETVAL
4254
4255 bool
4256 test_isPRINT_A(UV ord)
4257     CODE:
4258         RETVAL = isPRINT_A(ord);
4259     OUTPUT:
4260         RETVAL
4261
4262 bool
4263 test_isPRINT_L1(UV ord)
4264     CODE:
4265         RETVAL = isPRINT_L1(ord);
4266     OUTPUT:
4267         RETVAL
4268
4269 bool
4270 test_isPRINT_LC(UV ord)
4271     CODE:
4272         RETVAL = isPRINT_LC(ord);
4273     OUTPUT:
4274         RETVAL
4275
4276 bool
4277 test_isPRINT_utf8(unsigned char * p)
4278     CODE:
4279         RETVAL = isPRINT_utf8( p);
4280     OUTPUT:
4281         RETVAL
4282
4283 bool
4284 test_isPRINT_LC_utf8(unsigned char * p)
4285     CODE:
4286         RETVAL = isPRINT_LC_utf8( p);
4287     OUTPUT:
4288         RETVAL
4289
4290 bool
4291 test_isGRAPH_uni(UV ord)
4292     CODE:
4293         RETVAL = isGRAPH_uni(ord);
4294     OUTPUT:
4295         RETVAL
4296
4297 bool
4298 test_isGRAPH_LC_uvchr(UV ord)
4299     CODE:
4300         RETVAL = isGRAPH_LC_uvchr(ord);
4301     OUTPUT:
4302         RETVAL
4303
4304 bool
4305 test_isGRAPH_A(UV ord)
4306     CODE:
4307         RETVAL = isGRAPH_A(ord);
4308     OUTPUT:
4309         RETVAL
4310
4311 bool
4312 test_isGRAPH_L1(UV ord)
4313     CODE:
4314         RETVAL = isGRAPH_L1(ord);
4315     OUTPUT:
4316         RETVAL
4317
4318 bool
4319 test_isGRAPH_LC(UV ord)
4320     CODE:
4321         RETVAL = isGRAPH_LC(ord);
4322     OUTPUT:
4323         RETVAL
4324
4325 bool
4326 test_isGRAPH_utf8(unsigned char * p)
4327     CODE:
4328         RETVAL = isGRAPH_utf8( p);
4329     OUTPUT:
4330         RETVAL
4331
4332 bool
4333 test_isGRAPH_LC_utf8(unsigned char * p)
4334     CODE:
4335         RETVAL = isGRAPH_LC_utf8( p);
4336     OUTPUT:
4337         RETVAL
4338
4339 bool
4340 test_isPUNCT_uni(UV ord)
4341     CODE:
4342         RETVAL = isPUNCT_uni(ord);
4343     OUTPUT:
4344         RETVAL
4345
4346 bool
4347 test_isPUNCT_LC_uvchr(UV ord)
4348     CODE:
4349         RETVAL = isPUNCT_LC_uvchr(ord);
4350     OUTPUT:
4351         RETVAL
4352
4353 bool
4354 test_isPUNCT_A(UV ord)
4355     CODE:
4356         RETVAL = isPUNCT_A(ord);
4357     OUTPUT:
4358         RETVAL
4359
4360 bool
4361 test_isPUNCT_L1(UV ord)
4362     CODE:
4363         RETVAL = isPUNCT_L1(ord);
4364     OUTPUT:
4365         RETVAL
4366
4367 bool
4368 test_isPUNCT_LC(UV ord)
4369     CODE:
4370         RETVAL = isPUNCT_LC(ord);
4371     OUTPUT:
4372         RETVAL
4373
4374 bool
4375 test_isPUNCT_utf8(unsigned char * p)
4376     CODE:
4377         RETVAL = isPUNCT_utf8( p);
4378     OUTPUT:
4379         RETVAL
4380
4381 bool
4382 test_isPUNCT_LC_utf8(unsigned char * p)
4383     CODE:
4384         RETVAL = isPUNCT_LC_utf8( p);
4385     OUTPUT:
4386         RETVAL
4387
4388 bool
4389 test_isXDIGIT_uni(UV ord)
4390     CODE:
4391         RETVAL = isXDIGIT_uni(ord);
4392     OUTPUT:
4393         RETVAL
4394
4395 bool
4396 test_isXDIGIT_LC_uvchr(UV ord)
4397     CODE:
4398         RETVAL = isXDIGIT_LC_uvchr(ord);
4399     OUTPUT:
4400         RETVAL
4401
4402 bool
4403 test_isXDIGIT_A(UV ord)
4404     CODE:
4405         RETVAL = isXDIGIT_A(ord);
4406     OUTPUT:
4407         RETVAL
4408
4409 bool
4410 test_isXDIGIT_L1(UV ord)
4411     CODE:
4412         RETVAL = isXDIGIT_L1(ord);
4413     OUTPUT:
4414         RETVAL
4415
4416 bool
4417 test_isXDIGIT_LC(UV ord)
4418     CODE:
4419         RETVAL = isXDIGIT_LC(ord);
4420     OUTPUT:
4421         RETVAL
4422
4423 bool
4424 test_isXDIGIT_utf8(unsigned char * p)
4425     CODE:
4426         RETVAL = isXDIGIT_utf8( p);
4427     OUTPUT:
4428         RETVAL
4429
4430 bool
4431 test_isXDIGIT_LC_utf8(unsigned char * p)
4432     CODE:
4433         RETVAL = isXDIGIT_LC_utf8( p);
4434     OUTPUT:
4435         RETVAL
4436
4437 bool
4438 test_isPSXSPC_uni(UV ord)
4439     CODE:
4440         RETVAL = isPSXSPC_uni(ord);
4441     OUTPUT:
4442         RETVAL
4443
4444 bool
4445 test_isPSXSPC_LC_uvchr(UV ord)
4446     CODE:
4447         RETVAL = isPSXSPC_LC_uvchr(ord);
4448     OUTPUT:
4449         RETVAL
4450
4451 bool
4452 test_isPSXSPC_A(UV ord)
4453     CODE:
4454         RETVAL = isPSXSPC_A(ord);
4455     OUTPUT:
4456         RETVAL
4457
4458 bool
4459 test_isPSXSPC_L1(UV ord)
4460     CODE:
4461         RETVAL = isPSXSPC_L1(ord);
4462     OUTPUT:
4463         RETVAL
4464
4465 bool
4466 test_isPSXSPC_LC(UV ord)
4467     CODE:
4468         RETVAL = isPSXSPC_LC(ord);
4469     OUTPUT:
4470         RETVAL
4471
4472 bool
4473 test_isPSXSPC_utf8(unsigned char * p)
4474     CODE:
4475         RETVAL = isPSXSPC_utf8( p);
4476     OUTPUT:
4477         RETVAL
4478
4479 bool
4480 test_isPSXSPC_LC_utf8(unsigned char * p)
4481     CODE:
4482         RETVAL = isPSXSPC_LC_utf8( p);
4483     OUTPUT:
4484         RETVAL
4485
4486 bool
4487 test_isQUOTEMETA(UV ord)
4488     CODE:
4489         RETVAL = _isQUOTEMETA(ord);
4490     OUTPUT:
4491         RETVAL
4492
4493 UV
4494 test_toLOWER(UV ord)
4495     CODE:
4496         RETVAL = toLOWER(ord);
4497     OUTPUT:
4498         RETVAL
4499
4500 UV
4501 test_toLOWER_L1(UV ord)
4502     CODE:
4503         RETVAL = toLOWER_L1(ord);
4504     OUTPUT:
4505         RETVAL
4506
4507 UV
4508 test_toLOWER_LC(UV ord)
4509     CODE:
4510         RETVAL = toLOWER_LC(ord);
4511     OUTPUT:
4512         RETVAL
4513
4514 AV *
4515 test_toLOWER_uni(UV ord)
4516     PREINIT:
4517         U8 s[UTF8_MAXBYTES_CASE + 1];
4518         STRLEN len;
4519         AV *av;
4520         SV *utf8;
4521     CODE:
4522         av = newAV();
4523         av_push(av, newSVuv(toLOWER_uni(ord, s, &len)));
4524
4525         utf8 = newSVpvn((char *) s, len);
4526         SvUTF8_on(utf8);
4527         av_push(av, utf8);
4528
4529         av_push(av, newSVuv(len));
4530         RETVAL = av;
4531     OUTPUT:
4532         RETVAL
4533
4534 AV *
4535 test_toLOWER_utf8(SV * p)
4536     PREINIT:
4537         U8 *input;
4538         U8 s[UTF8_MAXBYTES_CASE + 1];
4539         STRLEN len;
4540         AV *av;
4541         SV *utf8;
4542     CODE:
4543         input = (U8 *) SvPV(p, len);
4544         av = newAV();
4545         av_push(av, newSVuv(toLOWER_utf8(input, s, &len)));
4546
4547         utf8 = newSVpvn((char *) s, len);
4548         SvUTF8_on(utf8);
4549         av_push(av, utf8);
4550
4551         av_push(av, newSVuv(len));
4552         RETVAL = av;
4553     OUTPUT:
4554         RETVAL
4555
4556 UV
4557 test_toFOLD(UV ord)
4558     CODE:
4559         RETVAL = toFOLD(ord);
4560     OUTPUT:
4561         RETVAL
4562
4563 UV
4564 test_toFOLD_LC(UV ord)
4565     CODE:
4566         RETVAL = toFOLD_LC(ord);
4567     OUTPUT:
4568         RETVAL
4569
4570 AV *
4571 test_toFOLD_uni(UV ord)
4572     PREINIT:
4573         U8 s[UTF8_MAXBYTES_CASE + 1];
4574         STRLEN len;
4575         AV *av;
4576         SV *utf8;
4577     CODE:
4578         av = newAV();
4579         av_push(av, newSVuv(toFOLD_uni(ord, s, &len)));
4580
4581         utf8 = newSVpvn((char *) s, len);
4582         SvUTF8_on(utf8);
4583         av_push(av, utf8);
4584
4585         av_push(av, newSVuv(len));
4586         RETVAL = av;
4587     OUTPUT:
4588         RETVAL
4589
4590 AV *
4591 test_toFOLD_utf8(SV * p)
4592     PREINIT:
4593         U8 *input;
4594         U8 s[UTF8_MAXBYTES_CASE + 1];
4595         STRLEN len;
4596         AV *av;
4597         SV *utf8;
4598     CODE:
4599         input = (U8 *) SvPV(p, len);
4600         av = newAV();
4601         av_push(av, newSVuv(toFOLD_utf8(input, s, &len)));
4602
4603         utf8 = newSVpvn((char *) s, len);
4604         SvUTF8_on(utf8);
4605         av_push(av, utf8);
4606
4607         av_push(av, newSVuv(len));
4608         RETVAL = av;
4609     OUTPUT:
4610         RETVAL
4611
4612 UV
4613 test_toUPPER(UV ord)
4614     CODE:
4615         RETVAL = toUPPER(ord);
4616     OUTPUT:
4617         RETVAL
4618
4619 UV
4620 test_toUPPER_LC(UV ord)
4621     CODE:
4622         RETVAL = toUPPER_LC(ord);
4623     OUTPUT:
4624         RETVAL
4625
4626 AV *
4627 test_toUPPER_uni(UV ord)
4628     PREINIT:
4629         U8 s[UTF8_MAXBYTES_CASE + 1];
4630         STRLEN len;
4631         AV *av;
4632         SV *utf8;
4633     CODE:
4634         av = newAV();
4635         av_push(av, newSVuv(toUPPER_uni(ord, s, &len)));
4636
4637         utf8 = newSVpvn((char *) s, len);
4638         SvUTF8_on(utf8);
4639         av_push(av, utf8);
4640
4641         av_push(av, newSVuv(len));
4642         RETVAL = av;
4643     OUTPUT:
4644         RETVAL
4645
4646 AV *
4647 test_toUPPER_utf8(SV * p)
4648     PREINIT:
4649         U8 *input;
4650         U8 s[UTF8_MAXBYTES_CASE + 1];
4651         STRLEN len;
4652         AV *av;
4653         SV *utf8;
4654     CODE:
4655         input = (U8 *) SvPV(p, len);
4656         av = newAV();
4657         av_push(av, newSVuv(toUPPER_utf8(input, s, &len)));
4658
4659         utf8 = newSVpvn((char *) s, len);
4660         SvUTF8_on(utf8);
4661         av_push(av, utf8);
4662
4663         av_push(av, newSVuv(len));
4664         RETVAL = av;
4665     OUTPUT:
4666         RETVAL
4667
4668 UV
4669 test_toTITLE(UV ord)
4670     CODE:
4671         RETVAL = toTITLE(ord);
4672     OUTPUT:
4673         RETVAL
4674
4675 AV *
4676 test_toTITLE_uni(UV ord)
4677     PREINIT:
4678         U8 s[UTF8_MAXBYTES_CASE + 1];
4679         STRLEN len;
4680         AV *av;
4681         SV *utf8;
4682     CODE:
4683         av = newAV();
4684         av_push(av, newSVuv(toTITLE_uni(ord, s, &len)));
4685
4686         utf8 = newSVpvn((char *) s, len);
4687         SvUTF8_on(utf8);
4688         av_push(av, utf8);
4689
4690         av_push(av, newSVuv(len));
4691         RETVAL = av;
4692     OUTPUT:
4693         RETVAL
4694
4695 AV *
4696 test_toTITLE_utf8(SV * p)
4697     PREINIT:
4698         U8 *input;
4699         U8 s[UTF8_MAXBYTES_CASE + 1];
4700         STRLEN len;
4701         AV *av;
4702         SV *utf8;
4703     CODE:
4704         input = (U8 *) SvPV(p, len);
4705         av = newAV();
4706         av_push(av, newSVuv(toTITLE_utf8(input, s, &len)));
4707
4708         utf8 = newSVpvn((char *) s, len);
4709         SvUTF8_on(utf8);
4710         av_push(av, utf8);
4711
4712         av_push(av, newSVuv(len));
4713         RETVAL = av;
4714     OUTPUT:
4715         RETVAL