This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate:
[perl5.git] / ext / XS / APItest / APItest.xs
CommitLineData
6a93a7e5 1#define PERL_IN_XS_APITEST
3e61d65a
JH
2#include "EXTERN.h"
3#include "perl.h"
4#include "XSUB.h"
5
85ce96a1
DM
6
7/* for my_cxt tests */
8
9#define MY_CXT_KEY "XS::APItest::_guts" XS_VERSION
10
11typedef struct {
12 int i;
13 SV *sv;
14} my_cxt_t;
15
16START_MY_CXT
17
18/* indirect functions to test the [pa]MY_CXT macros */
f16dd614 19
85ce96a1
DM
20int
21my_cxt_getint_p(pMY_CXT)
22{
23 return MY_CXT.i;
24}
f16dd614 25
85ce96a1
DM
26void
27my_cxt_setint_p(pMY_CXT_ int i)
28{
29 MY_CXT.i = i;
30}
f16dd614
DM
31
32SV*
5d477a6d 33my_cxt_getsv_interp(void)
f16dd614
DM
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
85ce96a1
DM
44void
45my_cxt_setsv_p(SV* sv _pMY_CXT)
46{
47 MY_CXT.sv = sv;
48}
49
50
9b5c3821 51/* from exception.c */
7a646707 52int apitest_exception(int);
0314122a 53
ff66e713
SH
54/* from core_or_not.inc */
55bool sv_setsv_cow_hashkey_core(void);
56bool sv_setsv_cow_hashkey_notcore(void);
57
2dc92170
NC
58/* A routine to test hv_delayfree_ent
59 (which itself is tested by testing on hv_free_ent */
60
61typedef void (freeent_function)(pTHX_ HV *, register HE *);
62
63void
64test_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
8afd2d2e
NC
73#ifdef PURIFY
74 victim = (HE*)safemalloc(sizeof(HE));
75#else
2dc92170
NC
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 */
6a93a7e5 83 if (!PL_body_roots[HE_SVSLOT])
2dc92170 84 croak("PL_he_root is 0");
8a722a80 85 victim = (HE*) PL_body_roots[HE_SVSLOT];
6a93a7e5 86 PL_body_roots[HE_SVSLOT] = HeNEXT(victim);
8afd2d2e 87#endif
2dc92170
NC
88
89 victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);
90
91 test_scalar = newSV(0);
92 SvREFCNT_inc(test_scalar);
de616631 93 HeVAL(victim) = test_scalar;
2dc92170
NC
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
b54b4831
NC
113
114static I32
53c40a8f
NC
115bitflip_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;
a75fcbca
SP
130 UV chr = utf8_to_uvuni((U8 *)p, &len);
131 new_p = (char *)uvuni_to_utf8((U8 *)new_p, chr ^ 32);
53c40a8f
NC
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
149static I32
b54b4831
NC
150rot13_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
55289a74
NC
233#include "const-c.inc"
234
0314122a
NC
235MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
236
55289a74
NC
237INCLUDE: const-xs.inc
238
b54b4831
NC
239void
240rot13_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
53c40a8f
NC
252void
253bitflip_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
028f8eaa
MHM
265#define UTF8KLEN(sv, len) (SvUTF8(sv) ? -(I32)len : (I32)len)
266
0314122a
NC
267bool
268exists(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);
028f8eaa 277 RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
0314122a
NC
278 OUTPUT:
279 RETVAL
280
bdee33e4
NC
281bool
282exists_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
b60cf05a 292SV *
55289a74 293delete(hash, key_sv, flags = 0)
b60cf05a
NC
294 PREINIT:
295 STRLEN len;
296 const char *key;
297 INPUT:
298 HV *hash
299 SV *key_sv
55289a74 300 I32 flags;
b60cf05a
NC
301 CODE:
302 key = SvPV(key_sv, len);
303 /* It's already mortal, so need to increase reference count. */
55289a74
NC
304 RETVAL
305 = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), flags));
306 OUTPUT:
307 RETVAL
308
309SV *
310delete_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));
b60cf05a
NC
318 OUTPUT:
319 RETVAL
320
321SV *
858117f8
NC
322store_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
858117f8 344SV *
b60cf05a
NC
345store(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);
028f8eaa 358 result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
858117f8 359 SvSetMagicSV(copy, value);
b60cf05a
NC
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
bdee33e4
NC
370SV *
371fetch_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
b60cf05a
NC
386
387SV *
388fetch(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);
028f8eaa 398 result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
b60cf05a
NC
399 if (!result) {
400 XSRETURN_EMPTY;
401 }
402 /* Force mg_get */
403 RETVAL = newSVsv(*result);
404 OUTPUT:
405 RETVAL
2dc92170 406
6b4de907
NC
407SV *
408common(params)
409 INPUT:
410 HV *params
411 PREINIT:
412 HE *result;
413 HV *hv = NULL;
414 SV *keysv = NULL;
415 const char *key = NULL;
416 STRLEN klen = 0;
417 int flags = 0;
418 int action = 0;
419 SV *val = NULL;
420 U32 hash = 0;
421 SV **svp;
422 CODE:
423 if ((svp = hv_fetchs(params, "hv", 0))) {
424 SV *const rv = *svp;
425 if (!SvROK(rv))
426 croak("common passed a non-reference for parameter hv");
427 hv = (HV *)SvRV(rv);
428 }
429 if ((svp = hv_fetchs(params, "keysv", 0)))
430 keysv = *svp;
431 if ((svp = hv_fetchs(params, "keypv", 0))) {
432 key = SvPV_const(*svp, klen);
433 if (SvUTF8(*svp))
434 flags = HVhek_UTF8;
435 }
436 if ((svp = hv_fetchs(params, "action", 0)))
437 action = SvIV(*svp);
438 if ((svp = hv_fetchs(params, "val", 0)))
439 val = *svp;
440 if ((svp = hv_fetchs(params, "hash", 0)))
441 action = SvUV(*svp);
442
a75fcbca 443 result = (HE *)hv_common(hv, keysv, key, klen, flags, action, val, hash);
6b4de907
NC
444 if (!result) {
445 XSRETURN_EMPTY;
446 }
447 /* Force mg_get */
448 RETVAL = newSVsv(HeVAL(result));
449 OUTPUT:
450 RETVAL
451
439efdfe 452void
2dc92170
NC
453test_hv_free_ent()
454 PPCODE:
455 test_freeent(&Perl_hv_free_ent);
456 XSRETURN(4);
457
439efdfe 458void
2dc92170
NC
459test_hv_delayfree_ent()
460 PPCODE:
461 test_freeent(&Perl_hv_delayfree_ent);
462 XSRETURN(4);
35ab5632
NC
463
464SV *
465test_share_unshare_pvn(input)
466 PREINIT:
35ab5632
NC
467 STRLEN len;
468 U32 hash;
469 char *pvx;
470 char *p;
471 INPUT:
472 SV *input
473 CODE:
474 pvx = SvPV(input, len);
475 PERL_HASH(hash, pvx, len);
476 p = sharepvn(pvx, len, hash);
477 RETVAL = newSVpvn(p, len);
478 unsharepvn(p, len, hash);
479 OUTPUT:
480 RETVAL
d8c5b3c5
NC
481
482bool
483refcounted_he_exists(key, level=0)
484 SV *key
485 IV level
486 CODE:
487 if (level) {
488 croak("level must be zero, not %"IVdf, level);
489 }
490 RETVAL = (Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
491 key, NULL, 0, 0, 0)
492 != &PL_sv_placeholder);
493 OUTPUT:
494 RETVAL
495
496
497SV *
498refcounted_he_fetch(key, level=0)
499 SV *key
500 IV level
501 CODE:
502 if (level) {
503 croak("level must be zero, not %"IVdf, level);
504 }
505 RETVAL = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, key,
506 NULL, 0, 0, 0);
507 SvREFCNT_inc(RETVAL);
508 OUTPUT:
509 RETVAL
510
35ab5632 511
0314122a
NC
512=pod
513
514sub TIEHASH { bless {}, $_[0] }
515sub STORE { $_[0]->{$_[1]} = $_[2] }
516sub FETCH { $_[0]->{$_[1]} }
517sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
518sub NEXTKEY { each %{$_[0]} }
519sub EXISTS { exists $_[0]->{$_[1]} }
520sub DELETE { delete $_[0]->{$_[1]} }
521sub CLEAR { %{$_[0]} = () }
522
523=cut
524
3e61d65a
JH
525MODULE = XS::APItest PACKAGE = XS::APItest
526
527PROTOTYPES: DISABLE
528
85ce96a1
DM
529BOOT:
530{
531 MY_CXT_INIT;
532 MY_CXT.i = 99;
533 MY_CXT.sv = newSVpv("initial",0);
534}
535
536void
537CLONE(...)
538 CODE:
539 MY_CXT_CLONE;
540 MY_CXT.sv = newSVpv("initial_clone",0);
541
3e61d65a
JH
542void
543print_double(val)
544 double val
545 CODE:
546 printf("%5.3f\n",val);
547
548int
549have_long_double()
550 CODE:
551#ifdef HAS_LONG_DOUBLE
552 RETVAL = 1;
553#else
554 RETVAL = 0;
555#endif
cabb36f0
CN
556 OUTPUT:
557 RETVAL
3e61d65a
JH
558
559void
560print_long_double()
561 CODE:
562#ifdef HAS_LONG_DOUBLE
fc0bf671 563# if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
3e61d65a
JH
564 long double val = 7.0;
565 printf("%5.3" PERL_PRIfldbl "\n",val);
566# else
567 double val = 7.0;
568 printf("%5.3f\n",val);
569# endif
570#endif
571
572void
3e61d65a
JH
573print_int(val)
574 int val
575 CODE:
576 printf("%d\n",val);
577
578void
579print_long(val)
580 long val
581 CODE:
582 printf("%ld\n",val);
583
584void
585print_float(val)
586 float val
587 CODE:
588 printf("%5.3f\n",val);
9d911683
NIS
589
590void
591print_flush()
592 CODE:
593 fflush(stdout);
d4b90eee
SH
594
595void
596mpushp()
597 PPCODE:
598 EXTEND(SP, 3);
599 mPUSHp("one", 3);
600 mPUSHp("two", 3);
601 mPUSHp("three", 5);
602 XSRETURN(3);
603
604void
605mpushn()
606 PPCODE:
607 EXTEND(SP, 3);
608 mPUSHn(0.5);
609 mPUSHn(-0.25);
610 mPUSHn(0.125);
611 XSRETURN(3);
612
613void
614mpushi()
615 PPCODE:
616 EXTEND(SP, 3);
d75b63cf
MHM
617 mPUSHi(-1);
618 mPUSHi(2);
619 mPUSHi(-3);
d4b90eee
SH
620 XSRETURN(3);
621
622void
623mpushu()
624 PPCODE:
625 EXTEND(SP, 3);
d75b63cf
MHM
626 mPUSHu(1);
627 mPUSHu(2);
628 mPUSHu(3);
d4b90eee
SH
629 XSRETURN(3);
630
631void
632mxpushp()
633 PPCODE:
634 mXPUSHp("one", 3);
635 mXPUSHp("two", 3);
636 mXPUSHp("three", 5);
637 XSRETURN(3);
638
639void
640mxpushn()
641 PPCODE:
642 mXPUSHn(0.5);
643 mXPUSHn(-0.25);
644 mXPUSHn(0.125);
645 XSRETURN(3);
646
647void
648mxpushi()
649 PPCODE:
d75b63cf
MHM
650 mXPUSHi(-1);
651 mXPUSHi(2);
652 mXPUSHi(-3);
d4b90eee
SH
653 XSRETURN(3);
654
655void
656mxpushu()
657 PPCODE:
d75b63cf
MHM
658 mXPUSHu(1);
659 mXPUSHu(2);
660 mXPUSHu(3);
d4b90eee 661 XSRETURN(3);
d1f347d7
DM
662
663
664void
665call_sv(sv, flags, ...)
666 SV* sv
667 I32 flags
668 PREINIT:
669 I32 i;
670 PPCODE:
671 for (i=0; i<items-2; i++)
672 ST(i) = ST(i+2); /* pop first two args */
673 PUSHMARK(SP);
674 SP += items - 2;
675 PUTBACK;
676 i = call_sv(sv, flags);
677 SPAGAIN;
678 EXTEND(SP, 1);
679 PUSHs(sv_2mortal(newSViv(i)));
680
681void
682call_pv(subname, flags, ...)
683 char* subname
684 I32 flags
685 PREINIT:
686 I32 i;
687 PPCODE:
688 for (i=0; i<items-2; i++)
689 ST(i) = ST(i+2); /* pop first two args */
690 PUSHMARK(SP);
691 SP += items - 2;
692 PUTBACK;
693 i = call_pv(subname, flags);
694 SPAGAIN;
695 EXTEND(SP, 1);
696 PUSHs(sv_2mortal(newSViv(i)));
697
698void
699call_method(methname, flags, ...)
700 char* methname
701 I32 flags
702 PREINIT:
703 I32 i;
704 PPCODE:
705 for (i=0; i<items-2; i++)
706 ST(i) = ST(i+2); /* pop first two args */
707 PUSHMARK(SP);
708 SP += items - 2;
709 PUTBACK;
710 i = call_method(methname, flags);
711 SPAGAIN;
712 EXTEND(SP, 1);
713 PUSHs(sv_2mortal(newSViv(i)));
714
715void
716eval_sv(sv, flags)
717 SV* sv
718 I32 flags
719 PREINIT:
720 I32 i;
721 PPCODE:
722 PUTBACK;
723 i = eval_sv(sv, flags);
724 SPAGAIN;
725 EXTEND(SP, 1);
726 PUSHs(sv_2mortal(newSViv(i)));
727
b8e65a9b 728void
d1f347d7
DM
729eval_pv(p, croak_on_error)
730 const char* p
731 I32 croak_on_error
d1f347d7
DM
732 PPCODE:
733 PUTBACK;
734 EXTEND(SP, 1);
735 PUSHs(eval_pv(p, croak_on_error));
736
737void
738require_pv(pv)
739 const char* pv
d1f347d7
DM
740 PPCODE:
741 PUTBACK;
742 require_pv(pv);
743
0ca3a874 744int
7a646707 745apitest_exception(throw_e)
0ca3a874
MHM
746 int throw_e
747 OUTPUT:
748 RETVAL
d1f347d7 749
ef469b03 750void
7e7a3dfc
GA
751mycroak(sv)
752 SV* sv
ef469b03 753 CODE:
7e7a3dfc
GA
754 if (SvOK(sv)) {
755 Perl_croak(aTHX_ "%s", SvPV_nolen(sv));
756 }
757 else {
758 Perl_croak(aTHX_ NULL);
759 }
5d2b1485
NC
760
761SV*
762strtab()
763 CODE:
764 RETVAL = newRV_inc((SV*)PL_strtab);
765 OUTPUT:
766 RETVAL
85ce96a1
DM
767
768int
769my_cxt_getint()
770 CODE:
771 dMY_CXT;
772 RETVAL = my_cxt_getint_p(aMY_CXT);
773 OUTPUT:
774 RETVAL
775
776void
777my_cxt_setint(i)
778 int i;
779 CODE:
780 dMY_CXT;
781 my_cxt_setint_p(aMY_CXT_ i);
782
783void
784my_cxt_getsv()
785 PPCODE:
85ce96a1 786 EXTEND(SP, 1);
f16dd614 787 ST(0) = my_cxt_getsv_interp();
85ce96a1
DM
788 XSRETURN(1);
789
790void
791my_cxt_setsv(sv)
792 SV *sv;
793 CODE:
794 dMY_CXT;
795 SvREFCNT_dec(MY_CXT.sv);
796 my_cxt_setsv_p(sv _aMY_CXT);
797 SvREFCNT_inc(sv);
34482cd6
NC
798
799bool
800sv_setsv_cow_hashkey_core()
801
802bool
803sv_setsv_cow_hashkey_notcore()
84ac5fd7
NC
804
805void
806BEGIN()
807 CODE:
808 sv_inc(get_sv("XS::APItest::BEGIN_called", GV_ADD|GV_ADDMULTI));
809
810void
811CHECK()
812 CODE:
813 sv_inc(get_sv("XS::APItest::CHECK_called", GV_ADD|GV_ADDMULTI));
814
815void
816UNITCHECK()
817 CODE:
0932863f 818 sv_inc(get_sv("XS::APItest::UNITCHECK_called", GV_ADD|GV_ADDMULTI));
84ac5fd7
NC
819
820void
821INIT()
822 CODE:
823 sv_inc(get_sv("XS::APItest::INIT_called", GV_ADD|GV_ADDMULTI));
824
825void
826END()
827 CODE:
828 sv_inc(get_sv("XS::APItest::END_called", GV_ADD|GV_ADDMULTI));