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