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
   7 /* for my_cxt tests */
   8
   9 #define MY_CXT_KEY "XS::APItest::_guts" XS_VERSION
  10
  11 typedef struct {
  12     int i;
  13     SV *sv;
  14 } my_cxt_t;
  15
  16 START_MY_CXT
  17
  18 /* indirect functions to test the [pa]MY_CXT macros */
  19
  20 int
  21 my_cxt_getint_p(pMY_CXT)
  22 {
  23     return MY_CXT.i;
  24 }
  25
  26 void
  27 my_cxt_setint_p(pMY_CXT_ int i)
  28 {
  29     MY_CXT.i = i;
  30 }
  31
  32 SV*
  33 my_cxt_getsv_interp(void)
  34 {
  35 #ifdef PERL_IMPLICIT_CONTEXT
  36     dTHX;
  37     dMY_CXT_INTERP(my_perl);
  38 #else
  39     dMY_CXT;
  40 #endif
  41     return MY_CXT.sv;
  42 }
  43
  44 void
  45 my_cxt_setsv_p(SV* sv _pMY_CXT)
  46 {
  47     MY_CXT.sv = sv;
  48 }
  49
  50
  51 /* from exception.c */
  52 int apitest_exception(int);
  53
  54 /* from core_or_not.inc */
  55 bool sv_setsv_cow_hashkey_core(void);
  56 bool sv_setsv_cow_hashkey_notcore(void);
  57
  58 /* A routine to test hv_delayfree_ent
  59    (which itself is tested by testing on hv_free_ent  */
  60
  61 typedef void (freeent_function)(pTHX_ HV *, register HE *);
  62
  63 void
  64 test_freeent(freeent_function *f) {
  65     dTHX;
  66     dSP;
  67     HV *test_hash = newHV();
  68     HE *victim;
  69     SV *test_scalar;
  70     U32 results[4];
  71     int i;
  72
  73 #ifdef PURIFY
  74     victim = (HE*)safemalloc(sizeof(HE));
  75 #else
  76     /* Storing then deleting something should ensure that a hash entry is
  77        available.  */
  78     hv_store(test_hash, "", 0, &PL_sv_yes, 0);
  79     hv_delete(test_hash, "", 0, 0);
  80
  81     /* We need to "inline" new_he here as it's static, and the functions we
  82        test expect to be able to call del_HE on the HE  */
  83     if (!PL_body_roots[HE_SVSLOT])
  84         croak("PL_he_root is 0");
  85     victim = (HE*) PL_body_roots[HE_SVSLOT];
  86     PL_body_roots[HE_SVSLOT] = HeNEXT(victim);
  87 #endif
  88
  89     victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);
  90
  91     test_scalar = newSV(0);
  92     SvREFCNT_inc(test_scalar);
  93     HeVAL(victim) = test_scalar;
  94
  95     /* Need this little game else we free the temps on the return stack.  */
  96     results[0] = SvREFCNT(test_scalar);
  97     SAVETMPS;
  98     results[1] = SvREFCNT(test_scalar);
  99     f(aTHX_ test_hash, victim);
 100     results[2] = SvREFCNT(test_scalar);
 101     FREETMPS;
 102     results[3] = SvREFCNT(test_scalar);
 103
 104     i = 0;
 105     do {
 106         mPUSHu(results[i]);
 107     } while (++i < sizeof(results)/sizeof(results[0]));
 108
 109     /* Goodbye to our extra reference.  */
 110     SvREFCNT_dec(test_scalar);
 111 }
 112
 113
 114 static I32
 115 bitflip_key(pTHX_ IV action, SV *field) {
 116     MAGIC *mg = mg_find(field, PERL_MAGIC_uvar);
 117     SV *keysv;
 118     if (mg && (keysv = mg->mg_obj)) {
 119         STRLEN len;
 120         const char *p = SvPV(keysv, len);
 121
 122         if (len) {
 123             SV *newkey = newSV(len);
 124             char *new_p = SvPVX(newkey);
 125
 126             if (SvUTF8(keysv)) {
 127                 const char *const end = p + len;
 128                 while (p < end) {
 129                     STRLEN len;
 130                     UV chr = utf8_to_uvuni(p, &len);
 131                     new_p = uvuni_to_utf8(new_p, chr ^ 32);
 132                     p += len;
 133                 }
 134                 SvUTF8_on(newkey);
 135             } else {
 136                 while (len--)
 137                     *new_p++ = *p++ ^ 32;
 138             }
 139             *new_p = '\0';
 140             SvCUR_set(newkey, SvCUR(keysv));
 141             SvPOK_on(newkey);
 142
 143             mg->mg_obj = newkey;
 144         }
 145     }
 146     return 0;
 147 }
 148
 149 static I32
 150 rot13_key(pTHX_ IV action, SV *field) {
 151     MAGIC *mg = mg_find(field, PERL_MAGIC_uvar);
 152     SV *keysv;
 153     if (mg && (keysv = mg->mg_obj)) {
 154         STRLEN len;
 155         const char *p = SvPV(keysv, len);
 156
 157         if (len) {
 158             SV *newkey = newSV(len);
 159             char *new_p = SvPVX(newkey);
 160
 161             /* There's a deliberate fencepost error here to loop len + 1 times
 162                to copy the trailing \0  */
 163             do {
 164                 char new_c = *p++;
 165                 /* Try doing this cleanly and clearly in EBCDIC another way: */
 166                 switch (new_c) {
 167                 case 'A': new_c = 'N'; break;
 168                 case 'B': new_c = 'O'; break;
 169                 case 'C': new_c = 'P'; break;
 170                 case 'D': new_c = 'Q'; break;
 171                 case 'E': new_c = 'R'; break;
 172                 case 'F': new_c = 'S'; break;
 173                 case 'G': new_c = 'T'; break;
 174                 case 'H': new_c = 'U'; break;
 175                 case 'I': new_c = 'V'; break;
 176                 case 'J': new_c = 'W'; break;
 177                 case 'K': new_c = 'X'; break;
 178                 case 'L': new_c = 'Y'; break;
 179                 case 'M': new_c = 'Z'; break;
 180                 case 'N': new_c = 'A'; break;
 181                 case 'O': new_c = 'B'; break;
 182                 case 'P': new_c = 'C'; break;
 183                 case 'Q': new_c = 'D'; break;
 184                 case 'R': new_c = 'E'; break;
 185                 case 'S': new_c = 'F'; break;
 186                 case 'T': new_c = 'G'; break;
 187                 case 'U': new_c = 'H'; break;
 188                 case 'V': new_c = 'I'; break;
 189                 case 'W': new_c = 'J'; break;
 190                 case 'X': new_c = 'K'; break;
 191                 case 'Y': new_c = 'L'; break;
 192                 case 'Z': new_c = 'M'; break;
 193                 case 'a': new_c = 'n'; break;
 194                 case 'b': new_c = 'o'; break;
 195                 case 'c': new_c = 'p'; break;
 196                 case 'd': new_c = 'q'; break;
 197                 case 'e': new_c = 'r'; break;
 198                 case 'f': new_c = 's'; break;
 199                 case 'g': new_c = 't'; break;
 200                 case 'h': new_c = 'u'; break;
 201                 case 'i': new_c = 'v'; break;
 202                 case 'j': new_c = 'w'; break;
 203                 case 'k': new_c = 'x'; break;
 204                 case 'l': new_c = 'y'; break;
 205                 case 'm': new_c = 'z'; break;
 206                 case 'n': new_c = 'a'; break;
 207                 case 'o': new_c = 'b'; break;
 208                 case 'p': new_c = 'c'; break;
 209                 case 'q': new_c = 'd'; break;
 210                 case 'r': new_c = 'e'; break;
 211                 case 's': new_c = 'f'; break;
 212                 case 't': new_c = 'g'; break;
 213                 case 'u': new_c = 'h'; break;
 214                 case 'v': new_c = 'i'; break;
 215                 case 'w': new_c = 'j'; break;
 216                 case 'x': new_c = 'k'; break;
 217                 case 'y': new_c = 'l'; break;
 218                 case 'z': new_c = 'm'; break;
 219                 }
 220                 *new_p++ = new_c;
 221             } while (len--);
 222             SvCUR_set(newkey, SvCUR(keysv));
 223             SvPOK_on(newkey);
 224             if (SvUTF8(keysv))
 225                 SvUTF8_on(newkey);
 226
 227             mg->mg_obj = newkey;
 228         }
 229     }
 230     return 0;
 231 }
 232
 233 #include "const-c.inc"
 234
 235 MODULE = XS::APItest:Hash               PACKAGE = XS::APItest::Hash
 236
 237 INCLUDE: const-xs.inc
 238
 239 void
 240 rot13_hash(hash)
 241         HV *hash
 242         CODE:
 243         {
 244             struct ufuncs uf;
 245             uf.uf_val = rot13_key;
 246             uf.uf_set = 0;
 247             uf.uf_index = 0;
 248
 249             sv_magic((SV*)hash, NULL, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf));
 250         }
 251
 252 void
 253 bitflip_hash(hash)
 254         HV *hash
 255         CODE:
 256         {
 257             struct ufuncs uf;
 258             uf.uf_val = bitflip_key;
 259             uf.uf_set = 0;
 260             uf.uf_index = 0;
 261
 262             sv_magic((SV*)hash, NULL, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf));
 263         }
 264
 265 #define UTF8KLEN(sv, len)   (SvUTF8(sv) ? -(I32)len : (I32)len)
 266
 267 bool
 268 exists(hash, key_sv)
 269         PREINIT:
 270         STRLEN len;
 271         const char *key;
 272         INPUT:
 273         HV *hash
 274         SV *key_sv
 275         CODE:
 276         key = SvPV(key_sv, len);
 277         RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
 278         OUTPUT:
 279         RETVAL
 280
 281 bool
 282 exists_ent(hash, key_sv)
 283         PREINIT:
 284         INPUT:
 285         HV *hash
 286         SV *key_sv
 287         CODE:
 288         RETVAL = hv_exists_ent(hash, key_sv, 0);
 289         OUTPUT:
 290         RETVAL
 291
 292 SV *
 293 delete(hash, key_sv, flags = 0)
 294         PREINIT:
 295         STRLEN len;
 296         const char *key;
 297         INPUT:
 298         HV *hash
 299         SV *key_sv
 300         I32 flags;
 301         CODE:
 302         key = SvPV(key_sv, len);
 303         /* It's already mortal, so need to increase reference count.  */
 304         RETVAL
 305             = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), flags));
 306         OUTPUT:
 307         RETVAL
 308
 309 SV *
 310 delete_ent(hash, key_sv, flags = 0)
 311         INPUT:
 312         HV *hash
 313         SV *key_sv
 314         I32 flags;
 315         CODE:
 316         /* It's already mortal, so need to increase reference count.  */
 317         RETVAL = SvREFCNT_inc(hv_delete_ent(hash, key_sv, flags, 0));
 318         OUTPUT:
 319         RETVAL
 320
 321 SV *
 322 store_ent(hash, key, value)
 323         PREINIT:
 324         SV *copy;
 325         HE *result;
 326         INPUT:
 327         HV *hash
 328         SV *key
 329         SV *value
 330         CODE:
 331         copy = newSV(0);
 332         result = hv_store_ent(hash, key, copy, 0);
 333         SvSetMagicSV(copy, value);
 334         if (!result) {
 335             SvREFCNT_dec(copy);
 336             XSRETURN_EMPTY;
 337         }
 338         /* It's about to become mortal, so need to increase reference count.
 339          */
 340         RETVAL = SvREFCNT_inc(HeVAL(result));
 341         OUTPUT:
 342         RETVAL
 343
 344 SV *
 345 store(hash, key_sv, value)
 346         PREINIT:
 347         STRLEN len;
 348         const char *key;
 349         SV *copy;
 350         SV **result;
 351         INPUT:
 352         HV *hash
 353         SV *key_sv
 354         SV *value
 355         CODE:
 356         key = SvPV(key_sv, len);
 357         copy = newSV(0);
 358         result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
 359         SvSetMagicSV(copy, value);
 360         if (!result) {
 361             SvREFCNT_dec(copy);
 362             XSRETURN_EMPTY;
 363         }
 364         /* It's about to become mortal, so need to increase reference count.
 365          */
 366         RETVAL = SvREFCNT_inc(*result);
 367         OUTPUT:
 368         RETVAL
 369
 370 SV *
 371 fetch_ent(hash, key_sv)
 372         PREINIT:
 373         HE *result;
 374         INPUT:
 375         HV *hash
 376         SV *key_sv
 377         CODE:
 378         result = hv_fetch_ent(hash, key_sv, 0, 0);
 379         if (!result) {
 380             XSRETURN_EMPTY;
 381         }
 382         /* Force mg_get  */
 383         RETVAL = newSVsv(HeVAL(result));
 384         OUTPUT:
 385         RETVAL
 386
 387 SV *
 388 fetch(hash, key_sv)
 389         PREINIT:
 390         STRLEN len;
 391         const char *key;
 392         SV **result;
 393         INPUT:
 394         HV *hash
 395         SV *key_sv
 396         CODE:
 397         key = SvPV(key_sv, len);
 398         result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
 399         if (!result) {
 400             XSRETURN_EMPTY;
 401         }
 402         /* Force mg_get  */
 403         RETVAL = newSVsv(*result);
 404         OUTPUT:
 405         RETVAL
 406
 407 void
 408 test_hv_free_ent()
 409         PPCODE:
 410         test_freeent(&Perl_hv_free_ent);
 411         XSRETURN(4);
 412
 413 void
 414 test_hv_delayfree_ent()
 415         PPCODE:
 416         test_freeent(&Perl_hv_delayfree_ent);
 417         XSRETURN(4);
 418
 419 SV *
 420 test_share_unshare_pvn(input)
 421         PREINIT:
 422         STRLEN len;
 423         U32 hash;
 424         char *pvx;
 425         char *p;
 426         INPUT:
 427         SV *input
 428         CODE:
 429         pvx = SvPV(input, len);
 430         PERL_HASH(hash, pvx, len);
 431         p = sharepvn(pvx, len, hash);
 432         RETVAL = newSVpvn(p, len);
 433         unsharepvn(p, len, hash);
 434         OUTPUT:
 435         RETVAL
 436
 437 bool
 438 refcounted_he_exists(key, level=0)
 439         SV *key
 440         IV level
 441         CODE:
 442         if (level) {
 443             croak("level must be zero, not %"IVdf, level);
 444         }
 445         RETVAL = (Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
 446                                            key, NULL, 0, 0, 0)
 447                   != &PL_sv_placeholder);
 448         OUTPUT:
 449         RETVAL
 450
 451
 452 SV *
 453 refcounted_he_fetch(key, level=0)
 454         SV *key
 455         IV level
 456         CODE:
 457         if (level) {
 458             croak("level must be zero, not %"IVdf, level);
 459         }
 460         RETVAL = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, key,
 461                                           NULL, 0, 0, 0);
 462         SvREFCNT_inc(RETVAL);
 463         OUTPUT:
 464         RETVAL
 465
 466
 467 =pod
 468
 469 sub TIEHASH  { bless {}, $_[0] }
 470 sub STORE    { $_[0]->{$_[1]} = $_[2] }
 471 sub FETCH    { $_[0]->{$_[1]} }
 472 sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
 473 sub NEXTKEY  { each %{$_[0]} }
 474 sub EXISTS   { exists $_[0]->{$_[1]} }
 475 sub DELETE   { delete $_[0]->{$_[1]} }
 476 sub CLEAR    { %{$_[0]} = () }
 477
 478 =cut
 479
 480 MODULE = XS::APItest            PACKAGE = XS::APItest
 481
 482 PROTOTYPES: DISABLE
 483
 484 BOOT:
 485 {
 486     MY_CXT_INIT;
 487     MY_CXT.i  = 99;
 488     MY_CXT.sv = newSVpv("initial",0);
 489 }
 490
 491 void
 492 CLONE(...)
 493     CODE:
 494     MY_CXT_CLONE;
 495     MY_CXT.sv = newSVpv("initial_clone",0);
 496
 497 void
 498 print_double(val)
 499         double val
 500         CODE:
 501         printf("%5.3f\n",val);
 502
 503 int
 504 have_long_double()
 505         CODE:
 506 #ifdef HAS_LONG_DOUBLE
 507         RETVAL = 1;
 508 #else
 509         RETVAL = 0;
 510 #endif
 511         OUTPUT:
 512         RETVAL
 513
 514 void
 515 print_long_double()
 516         CODE:
 517 #ifdef HAS_LONG_DOUBLE
 518 #   if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
 519         long double val = 7.0;
 520         printf("%5.3" PERL_PRIfldbl "\n",val);
 521 #   else
 522         double val = 7.0;
 523         printf("%5.3f\n",val);
 524 #   endif
 525 #endif
 526
 527 void
 528 print_int(val)
 529         int val
 530         CODE:
 531         printf("%d\n",val);
 532
 533 void
 534 print_long(val)
 535         long val
 536         CODE:
 537         printf("%ld\n",val);
 538
 539 void
 540 print_float(val)
 541         float val
 542         CODE:
 543         printf("%5.3f\n",val);
 544
 545 void
 546 print_flush()
 547         CODE:
 548         fflush(stdout);
 549
 550 void
 551 mpushp()
 552         PPCODE:
 553         EXTEND(SP, 3);
 554         mPUSHp("one", 3);
 555         mPUSHp("two", 3);
 556         mPUSHp("three", 5);
 557         XSRETURN(3);
 558
 559 void
 560 mpushn()
 561         PPCODE:
 562         EXTEND(SP, 3);
 563         mPUSHn(0.5);
 564         mPUSHn(-0.25);
 565         mPUSHn(0.125);
 566         XSRETURN(3);
 567
 568 void
 569 mpushi()
 570         PPCODE:
 571         EXTEND(SP, 3);
 572         mPUSHi(-1);
 573         mPUSHi(2);
 574         mPUSHi(-3);
 575         XSRETURN(3);
 576
 577 void
 578 mpushu()
 579         PPCODE:
 580         EXTEND(SP, 3);
 581         mPUSHu(1);
 582         mPUSHu(2);
 583         mPUSHu(3);
 584         XSRETURN(3);
 585
 586 void
 587 mxpushp()
 588         PPCODE:
 589         mXPUSHp("one", 3);
 590         mXPUSHp("two", 3);
 591         mXPUSHp("three", 5);
 592         XSRETURN(3);
 593
 594 void
 595 mxpushn()
 596         PPCODE:
 597         mXPUSHn(0.5);
 598         mXPUSHn(-0.25);
 599         mXPUSHn(0.125);
 600         XSRETURN(3);
 601
 602 void
 603 mxpushi()
 604         PPCODE:
 605         mXPUSHi(-1);
 606         mXPUSHi(2);
 607         mXPUSHi(-3);
 608         XSRETURN(3);
 609
 610 void
 611 mxpushu()
 612         PPCODE:
 613         mXPUSHu(1);
 614         mXPUSHu(2);
 615         mXPUSHu(3);
 616         XSRETURN(3);
 617
 618
 619 void
 620 call_sv(sv, flags, ...)
 621     SV* sv
 622     I32 flags
 623     PREINIT:
 624         I32 i;
 625     PPCODE:
 626         for (i=0; i<items-2; i++)
 627             ST(i) = ST(i+2); /* pop first two args */
 628         PUSHMARK(SP);
 629         SP += items - 2;
 630         PUTBACK;
 631         i = call_sv(sv, flags);
 632         SPAGAIN;
 633         EXTEND(SP, 1);
 634         PUSHs(sv_2mortal(newSViv(i)));
 635
 636 void
 637 call_pv(subname, flags, ...)
 638     char* subname
 639     I32 flags
 640     PREINIT:
 641         I32 i;
 642     PPCODE:
 643         for (i=0; i<items-2; i++)
 644             ST(i) = ST(i+2); /* pop first two args */
 645         PUSHMARK(SP);
 646         SP += items - 2;
 647         PUTBACK;
 648         i = call_pv(subname, flags);
 649         SPAGAIN;
 650         EXTEND(SP, 1);
 651         PUSHs(sv_2mortal(newSViv(i)));
 652
 653 void
 654 call_method(methname, flags, ...)
 655     char* methname
 656     I32 flags
 657     PREINIT:
 658         I32 i;
 659     PPCODE:
 660         for (i=0; i<items-2; i++)
 661             ST(i) = ST(i+2); /* pop first two args */
 662         PUSHMARK(SP);
 663         SP += items - 2;
 664         PUTBACK;
 665         i = call_method(methname, flags);
 666         SPAGAIN;
 667         EXTEND(SP, 1);
 668         PUSHs(sv_2mortal(newSViv(i)));
 669
 670 void
 671 eval_sv(sv, flags)
 672     SV* sv
 673     I32 flags
 674     PREINIT:
 675         I32 i;
 676     PPCODE:
 677         PUTBACK;
 678         i = eval_sv(sv, flags);
 679         SPAGAIN;
 680         EXTEND(SP, 1);
 681         PUSHs(sv_2mortal(newSViv(i)));
 682
 683 void
 684 eval_pv(p, croak_on_error)
 685     const char* p
 686     I32 croak_on_error
 687     PPCODE:
 688         PUTBACK;
 689         EXTEND(SP, 1);
 690         PUSHs(eval_pv(p, croak_on_error));
 691
 692 void
 693 require_pv(pv)
 694     const char* pv
 695     PPCODE:
 696         PUTBACK;
 697         require_pv(pv);
 698
 699 int
 700 apitest_exception(throw_e)
 701     int throw_e
 702     OUTPUT:
 703         RETVAL
 704
 705 void
 706 mycroak(sv)
 707     SV* sv
 708     CODE:
 709     if (SvOK(sv)) {
 710         Perl_croak(aTHX_ "%s", SvPV_nolen(sv));
 711     }
 712     else {
 713         Perl_croak(aTHX_ NULL);
 714     }
 715
 716 SV*
 717 strtab()
 718    CODE:
 719    RETVAL = newRV_inc((SV*)PL_strtab);
 720    OUTPUT:
 721    RETVAL
 722
 723 int
 724 my_cxt_getint()
 725     CODE:
 726         dMY_CXT;
 727         RETVAL = my_cxt_getint_p(aMY_CXT);
 728     OUTPUT:
 729         RETVAL
 730
 731 void
 732 my_cxt_setint(i)
 733     int i;
 734     CODE:
 735         dMY_CXT;
 736         my_cxt_setint_p(aMY_CXT_ i);
 737
 738 void
 739 my_cxt_getsv()
 740     PPCODE:
 741         EXTEND(SP, 1);
 742         ST(0) = my_cxt_getsv_interp();
 743         XSRETURN(1);
 744
 745 void
 746 my_cxt_setsv(sv)
 747     SV *sv;
 748     CODE:
 749         dMY_CXT;
 750         SvREFCNT_dec(MY_CXT.sv);
 751         my_cxt_setsv_p(sv _aMY_CXT);
 752         SvREFCNT_inc(sv);
 753
 754 bool
 755 sv_setsv_cow_hashkey_core()
 756
 757 bool
 758 sv_setsv_cow_hashkey_notcore()
 759
 760 void
 761 BEGIN()
 762     CODE:
 763         sv_inc(get_sv("XS::APItest::BEGIN_called", GV_ADD|GV_ADDMULTI));
 764
 765 void
 766 CHECK()
 767     CODE:
 768         sv_inc(get_sv("XS::APItest::CHECK_called", GV_ADD|GV_ADDMULTI));
 769
 770 void
 771 UNITCHECK()
 772     CODE:
 773         sv_inc(get_sv("XS::APItest::UNITCHECK_called", GV_ADD|GV_ADDMULTI));
 774
 775 void
 776 INIT()
 777     CODE:
 778         sv_inc(get_sv("XS::APItest::INIT_called", GV_ADD|GV_ADDMULTI));
 779
 780 void
 781 END()
 782     CODE:
 783         sv_inc(get_sv("XS::APItest::END_called", GV_ADD|GV_ADDMULTI));