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