This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
XS_Tie_Hash_NamedCapture_STORE should always croak on invalid parameters.
[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
36c2b1d0
NC
6typedef SV *SVREF;
7typedef PTR_TBL_t *XS__APItest__PtrTable;
85ce96a1
DM
8
9/* for my_cxt tests */
10
11#define MY_CXT_KEY "XS::APItest::_guts" XS_VERSION
12
13typedef struct {
14 int i;
15 SV *sv;
03569ecf
BM
16 GV *cscgv;
17 AV *cscav;
13b6b3bc
BM
18 AV *bhkav;
19 bool bhk_record;
201c7e1f
FR
20 peep_t orig_peep;
21 peep_t orig_rpeep;
22 int peep_recording;
23 AV *peep_recorder;
24 AV *rpeep_recorder;
85ce96a1
DM
25} my_cxt_t;
26
27START_MY_CXT
28
29/* indirect functions to test the [pa]MY_CXT macros */
f16dd614 30
85ce96a1
DM
31int
32my_cxt_getint_p(pMY_CXT)
33{
34 return MY_CXT.i;
35}
f16dd614 36
85ce96a1
DM
37void
38my_cxt_setint_p(pMY_CXT_ int i)
39{
40 MY_CXT.i = i;
41}
f16dd614
DM
42
43SV*
9568a123 44my_cxt_getsv_interp_context(void)
f16dd614 45{
f16dd614
DM
46 dTHX;
47 dMY_CXT_INTERP(my_perl);
9568a123
NC
48 return MY_CXT.sv;
49}
50
51SV*
52my_cxt_getsv_interp(void)
53{
f16dd614 54 dMY_CXT;
f16dd614
DM
55 return MY_CXT.sv;
56}
57
85ce96a1
DM
58void
59my_cxt_setsv_p(SV* sv _pMY_CXT)
60{
61 MY_CXT.sv = sv;
62}
63
64
9b5c3821 65/* from exception.c */
7a646707 66int apitest_exception(int);
0314122a 67
ff66e713
SH
68/* from core_or_not.inc */
69bool sv_setsv_cow_hashkey_core(void);
70bool sv_setsv_cow_hashkey_notcore(void);
71
2dc92170
NC
72/* A routine to test hv_delayfree_ent
73 (which itself is tested by testing on hv_free_ent */
74
75typedef void (freeent_function)(pTHX_ HV *, register HE *);
76
77void
78test_freeent(freeent_function *f) {
79 dTHX;
80 dSP;
81 HV *test_hash = newHV();
82 HE *victim;
83 SV *test_scalar;
84 U32 results[4];
85 int i;
86
8afd2d2e
NC
87#ifdef PURIFY
88 victim = (HE*)safemalloc(sizeof(HE));
89#else
2dc92170
NC
90 /* Storing then deleting something should ensure that a hash entry is
91 available. */
92 hv_store(test_hash, "", 0, &PL_sv_yes, 0);
93 hv_delete(test_hash, "", 0, 0);
94
95 /* We need to "inline" new_he here as it's static, and the functions we
96 test expect to be able to call del_HE on the HE */
6a93a7e5 97 if (!PL_body_roots[HE_SVSLOT])
2dc92170 98 croak("PL_he_root is 0");
8a722a80 99 victim = (HE*) PL_body_roots[HE_SVSLOT];
6a93a7e5 100 PL_body_roots[HE_SVSLOT] = HeNEXT(victim);
8afd2d2e 101#endif
2dc92170
NC
102
103 victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);
104
105 test_scalar = newSV(0);
106 SvREFCNT_inc(test_scalar);
de616631 107 HeVAL(victim) = test_scalar;
2dc92170
NC
108
109 /* Need this little game else we free the temps on the return stack. */
110 results[0] = SvREFCNT(test_scalar);
111 SAVETMPS;
112 results[1] = SvREFCNT(test_scalar);
113 f(aTHX_ test_hash, victim);
114 results[2] = SvREFCNT(test_scalar);
115 FREETMPS;
116 results[3] = SvREFCNT(test_scalar);
117
118 i = 0;
119 do {
120 mPUSHu(results[i]);
121 } while (++i < sizeof(results)/sizeof(results[0]));
122
123 /* Goodbye to our extra reference. */
124 SvREFCNT_dec(test_scalar);
125}
126
b54b4831
NC
127
128static I32
53c40a8f
NC
129bitflip_key(pTHX_ IV action, SV *field) {
130 MAGIC *mg = mg_find(field, PERL_MAGIC_uvar);
131 SV *keysv;
132 if (mg && (keysv = mg->mg_obj)) {
133 STRLEN len;
134 const char *p = SvPV(keysv, len);
135
136 if (len) {
137 SV *newkey = newSV(len);
138 char *new_p = SvPVX(newkey);
139
140 if (SvUTF8(keysv)) {
141 const char *const end = p + len;
142 while (p < end) {
143 STRLEN len;
a75fcbca
SP
144 UV chr = utf8_to_uvuni((U8 *)p, &len);
145 new_p = (char *)uvuni_to_utf8((U8 *)new_p, chr ^ 32);
53c40a8f
NC
146 p += len;
147 }
148 SvUTF8_on(newkey);
149 } else {
150 while (len--)
151 *new_p++ = *p++ ^ 32;
152 }
153 *new_p = '\0';
154 SvCUR_set(newkey, SvCUR(keysv));
155 SvPOK_on(newkey);
156
157 mg->mg_obj = newkey;
158 }
159 }
160 return 0;
161}
162
163static I32
b54b4831
NC
164rot13_key(pTHX_ IV action, SV *field) {
165 MAGIC *mg = mg_find(field, PERL_MAGIC_uvar);
166 SV *keysv;
167 if (mg && (keysv = mg->mg_obj)) {
168 STRLEN len;
169 const char *p = SvPV(keysv, len);
170
171 if (len) {
172 SV *newkey = newSV(len);
173 char *new_p = SvPVX(newkey);
174
175 /* There's a deliberate fencepost error here to loop len + 1 times
176 to copy the trailing \0 */
177 do {
178 char new_c = *p++;
179 /* Try doing this cleanly and clearly in EBCDIC another way: */
180 switch (new_c) {
181 case 'A': new_c = 'N'; break;
182 case 'B': new_c = 'O'; break;
183 case 'C': new_c = 'P'; break;
184 case 'D': new_c = 'Q'; break;
185 case 'E': new_c = 'R'; break;
186 case 'F': new_c = 'S'; break;
187 case 'G': new_c = 'T'; break;
188 case 'H': new_c = 'U'; break;
189 case 'I': new_c = 'V'; break;
190 case 'J': new_c = 'W'; break;
191 case 'K': new_c = 'X'; break;
192 case 'L': new_c = 'Y'; break;
193 case 'M': new_c = 'Z'; break;
194 case 'N': new_c = 'A'; break;
195 case 'O': new_c = 'B'; break;
196 case 'P': new_c = 'C'; break;
197 case 'Q': new_c = 'D'; break;
198 case 'R': new_c = 'E'; break;
199 case 'S': new_c = 'F'; break;
200 case 'T': new_c = 'G'; break;
201 case 'U': new_c = 'H'; break;
202 case 'V': new_c = 'I'; break;
203 case 'W': new_c = 'J'; break;
204 case 'X': new_c = 'K'; break;
205 case 'Y': new_c = 'L'; break;
206 case 'Z': new_c = 'M'; break;
207 case 'a': new_c = 'n'; break;
208 case 'b': new_c = 'o'; break;
209 case 'c': new_c = 'p'; break;
210 case 'd': new_c = 'q'; break;
211 case 'e': new_c = 'r'; break;
212 case 'f': new_c = 's'; break;
213 case 'g': new_c = 't'; break;
214 case 'h': new_c = 'u'; break;
215 case 'i': new_c = 'v'; break;
216 case 'j': new_c = 'w'; break;
217 case 'k': new_c = 'x'; break;
218 case 'l': new_c = 'y'; break;
219 case 'm': new_c = 'z'; break;
220 case 'n': new_c = 'a'; break;
221 case 'o': new_c = 'b'; break;
222 case 'p': new_c = 'c'; break;
223 case 'q': new_c = 'd'; break;
224 case 'r': new_c = 'e'; break;
225 case 's': new_c = 'f'; break;
226 case 't': new_c = 'g'; break;
227 case 'u': new_c = 'h'; break;
228 case 'v': new_c = 'i'; break;
229 case 'w': new_c = 'j'; break;
230 case 'x': new_c = 'k'; break;
231 case 'y': new_c = 'l'; break;
232 case 'z': new_c = 'm'; break;
233 }
234 *new_p++ = new_c;
235 } while (len--);
236 SvCUR_set(newkey, SvCUR(keysv));
237 SvPOK_on(newkey);
238 if (SvUTF8(keysv))
239 SvUTF8_on(newkey);
240
241 mg->mg_obj = newkey;
242 }
243 }
244 return 0;
245}
246
218787bd
VP
247STATIC I32
248rmagical_a_dummy(pTHX_ IV idx, SV *sv) {
249 return 0;
250}
251
252STATIC MGVTBL rmagical_b = { 0 };
253
03569ecf 254STATIC void
13b6b3bc 255blockhook_csc_start(pTHX_ int full)
03569ecf
BM
256{
257 dMY_CXT;
258 AV *const cur = GvAV(MY_CXT.cscgv);
259
260 SAVEGENERICSV(GvAV(MY_CXT.cscgv));
261
262 if (cur) {
263 I32 i;
d024465f 264 AV *const new_av = newAV();
03569ecf
BM
265
266 for (i = 0; i <= av_len(cur); i++) {
d024465f 267 av_store(new_av, i, newSVsv(*av_fetch(cur, i, 0)));
03569ecf
BM
268 }
269
d024465f 270 GvAV(MY_CXT.cscgv) = new_av;
03569ecf
BM
271 }
272}
273
274STATIC void
13b6b3bc 275blockhook_csc_pre_end(pTHX_ OP **o)
03569ecf
BM
276{
277 dMY_CXT;
278
279 /* if we hit the end of a scope we missed the start of, we need to
280 * unconditionally clear @CSC */
52db365a 281 if (GvAV(MY_CXT.cscgv) == MY_CXT.cscav && MY_CXT.cscav) {
03569ecf 282 av_clear(MY_CXT.cscav);
52db365a 283 }
03569ecf
BM
284
285}
286
13b6b3bc
BM
287STATIC void
288blockhook_test_start(pTHX_ int full)
289{
290 dMY_CXT;
291 AV *av;
292
293 if (MY_CXT.bhk_record) {
294 av = newAV();
295 av_push(av, newSVpvs("start"));
296 av_push(av, newSViv(full));
297 av_push(MY_CXT.bhkav, newRV_noinc(MUTABLE_SV(av)));
298 }
299}
300
301STATIC void
302blockhook_test_pre_end(pTHX_ OP **o)
303{
304 dMY_CXT;
305
306 if (MY_CXT.bhk_record)
307 av_push(MY_CXT.bhkav, newSVpvs("pre_end"));
308}
309
310STATIC void
311blockhook_test_post_end(pTHX_ OP **o)
312{
313 dMY_CXT;
314
315 if (MY_CXT.bhk_record)
316 av_push(MY_CXT.bhkav, newSVpvs("post_end"));
317}
318
319STATIC void
320blockhook_test_eval(pTHX_ OP *const o)
321{
322 dMY_CXT;
323 AV *av;
324
325 if (MY_CXT.bhk_record) {
326 av = newAV();
327 av_push(av, newSVpvs("eval"));
328 av_push(av, newSVpv(OP_NAME(o), 0));
329 av_push(MY_CXT.bhkav, newRV_noinc(MUTABLE_SV(av)));
330 }
331}
332
333STATIC BHK bhk_csc, bhk_test;
334
201c7e1f
FR
335STATIC void
336my_peep (pTHX_ OP *o)
337{
338 dMY_CXT;
339
340 if (!o)
341 return;
342
343 MY_CXT.orig_peep(aTHX_ o);
344
345 if (!MY_CXT.peep_recording)
346 return;
347
348 for (; o; o = o->op_next) {
349 if (o->op_type == OP_CONST && cSVOPx_sv(o) && SvPOK(cSVOPx_sv(o))) {
350 av_push(MY_CXT.peep_recorder, newSVsv(cSVOPx_sv(o)));
351 }
352 }
353}
354
355STATIC void
356my_rpeep (pTHX_ OP *o)
357{
358 dMY_CXT;
359
360 if (!o)
361 return;
362
363 MY_CXT.orig_rpeep(aTHX_ o);
364
365 if (!MY_CXT.peep_recording)
366 return;
367
368 for (; o; o = o->op_next) {
369 if (o->op_type == OP_CONST && cSVOPx_sv(o) && SvPOK(cSVOPx_sv(o))) {
370 av_push(MY_CXT.rpeep_recorder, newSVsv(cSVOPx_sv(o)));
371 }
372 }
373}
374
d9088386
Z
375STATIC OP *
376THX_ck_entersub_args_lists(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
377{
378 return ck_entersub_args_list(entersubop);
379}
380
381STATIC OP *
382THX_ck_entersub_args_scalars(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
383{
384 OP *aop = cUNOPx(entersubop)->op_first;
385 if (!aop->op_sibling)
386 aop = cUNOPx(aop)->op_first;
387 for (aop = aop->op_sibling; aop->op_sibling; aop = aop->op_sibling) {
388 op_contextualize(aop, G_SCALAR);
389 }
390 return entersubop;
391}
392
393STATIC OP *
394THX_ck_entersub_multi_sum(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
395{
396 OP *sumop = NULL;
397 OP *pushop = cUNOPx(entersubop)->op_first;
398 if (!pushop->op_sibling)
399 pushop = cUNOPx(pushop)->op_first;
400 while (1) {
401 OP *aop = pushop->op_sibling;
402 if (!aop->op_sibling)
403 break;
404 pushop->op_sibling = aop->op_sibling;
405 aop->op_sibling = NULL;
406 op_contextualize(aop, G_SCALAR);
407 if (sumop) {
408 sumop = newBINOP(OP_ADD, 0, sumop, aop);
409 } else {
410 sumop = aop;
411 }
412 }
413 if (!sumop)
414 sumop = newSVOP(OP_CONST, 0, newSViv(0));
415 op_free(entersubop);
416 return sumop;
417}
418
83f8bb56
Z
419/** RPN keyword parser **/
420
421#define sv_is_glob(sv) (SvTYPE(sv) == SVt_PVGV)
422#define sv_is_regexp(sv) (SvTYPE(sv) == SVt_REGEXP)
423#define sv_is_string(sv) \
424 (!sv_is_glob(sv) && !sv_is_regexp(sv) && \
425 (SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK)))
426
427static SV *hintkey_rpn_sv, *hintkey_calcrpn_sv, *hintkey_stufftest_sv;
07ffcb73 428static SV *hintkey_swaptwostmts_sv, *hintkey_looprest_sv;
83f8bb56
Z
429static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
430
431/* low-level parser helpers */
432
433#define PL_bufptr (PL_parser->bufptr)
434#define PL_bufend (PL_parser->bufend)
435
436/* RPN parser */
437
438#define parse_var() THX_parse_var(aTHX)
439static OP *THX_parse_var(pTHX)
440{
441 char *s = PL_bufptr;
442 char *start = s;
443 PADOFFSET varpos;
444 OP *padop;
445 if(*s != '$') croak("RPN syntax error");
446 while(1) {
447 char c = *++s;
448 if(!isALNUM(c)) break;
449 }
450 if(s-start < 2) croak("RPN syntax error");
451 lex_read_to(s);
452 {
453 /* because pad_findmy() doesn't really use length yet */
454 SV *namesv = sv_2mortal(newSVpvn(start, s-start));
455 varpos = pad_findmy(SvPVX(namesv), s-start, 0);
456 }
457 if(varpos == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(varpos))
458 croak("RPN only supports \"my\" variables");
459 padop = newOP(OP_PADSV, 0);
460 padop->op_targ = varpos;
461 return padop;
462}
463
464#define push_rpn_item(o) \
465 (tmpop = (o), tmpop->op_sibling = stack, stack = tmpop)
466#define pop_rpn_item() \
467 (!stack ? (croak("RPN stack underflow"), (OP*)NULL) : \
468 (tmpop = stack, stack = stack->op_sibling, \
469 tmpop->op_sibling = NULL, tmpop))
470
471#define parse_rpn_expr() THX_parse_rpn_expr(aTHX)
472static OP *THX_parse_rpn_expr(pTHX)
473{
474 OP *stack = NULL, *tmpop;
475 while(1) {
476 I32 c;
477 lex_read_space(0);
478 c = lex_peek_unichar(0);
479 switch(c) {
480 case /*(*/')': case /*{*/'}': {
481 OP *result = pop_rpn_item();
482 if(stack) croak("RPN expression must return a single value");
483 return result;
484 } break;
485 case '0': case '1': case '2': case '3': case '4':
486 case '5': case '6': case '7': case '8': case '9': {
487 UV val = 0;
488 do {
489 lex_read_unichar(0);
490 val = 10*val + (c - '0');
491 c = lex_peek_unichar(0);
492 } while(c >= '0' && c <= '9');
493 push_rpn_item(newSVOP(OP_CONST, 0, newSVuv(val)));
494 } break;
495 case '$': {
496 push_rpn_item(parse_var());
497 } break;
498 case '+': {
499 OP *b = pop_rpn_item();
500 OP *a = pop_rpn_item();
501 lex_read_unichar(0);
502 push_rpn_item(newBINOP(OP_I_ADD, 0, a, b));
503 } break;
504 case '-': {
505 OP *b = pop_rpn_item();
506 OP *a = pop_rpn_item();
507 lex_read_unichar(0);
508 push_rpn_item(newBINOP(OP_I_SUBTRACT, 0, a, b));
509 } break;
510 case '*': {
511 OP *b = pop_rpn_item();
512 OP *a = pop_rpn_item();
513 lex_read_unichar(0);
514 push_rpn_item(newBINOP(OP_I_MULTIPLY, 0, a, b));
515 } break;
516 case '/': {
517 OP *b = pop_rpn_item();
518 OP *a = pop_rpn_item();
519 lex_read_unichar(0);
520 push_rpn_item(newBINOP(OP_I_DIVIDE, 0, a, b));
521 } break;
522 case '%': {
523 OP *b = pop_rpn_item();
524 OP *a = pop_rpn_item();
525 lex_read_unichar(0);
526 push_rpn_item(newBINOP(OP_I_MODULO, 0, a, b));
527 } break;
528 default: {
529 croak("RPN syntax error");
530 } break;
531 }
532 }
533}
534
535#define parse_keyword_rpn() THX_parse_keyword_rpn(aTHX)
536static OP *THX_parse_keyword_rpn(pTHX)
537{
538 OP *op;
539 lex_read_space(0);
540 if(lex_peek_unichar(0) != '('/*)*/)
541 croak("RPN expression must be parenthesised");
542 lex_read_unichar(0);
543 op = parse_rpn_expr();
544 if(lex_peek_unichar(0) != /*(*/')')
545 croak("RPN expression must be parenthesised");
546 lex_read_unichar(0);
547 return op;
548}
549
550#define parse_keyword_calcrpn() THX_parse_keyword_calcrpn(aTHX)
551static OP *THX_parse_keyword_calcrpn(pTHX)
552{
553 OP *varop, *exprop;
554 lex_read_space(0);
555 varop = parse_var();
556 lex_read_space(0);
557 if(lex_peek_unichar(0) != '{'/*}*/)
558 croak("RPN expression must be braced");
559 lex_read_unichar(0);
560 exprop = parse_rpn_expr();
561 if(lex_peek_unichar(0) != /*{*/'}')
562 croak("RPN expression must be braced");
563 lex_read_unichar(0);
564 return newASSIGNOP(OPf_STACKED, varop, 0, exprop);
565}
566
567#define parse_keyword_stufftest() THX_parse_keyword_stufftest(aTHX)
568static OP *THX_parse_keyword_stufftest(pTHX)
569{
570 I32 c;
571 bool do_stuff;
572 lex_read_space(0);
573 do_stuff = lex_peek_unichar(0) == '+';
574 if(do_stuff) {
575 lex_read_unichar(0);
576 lex_read_space(0);
577 }
578 c = lex_peek_unichar(0);
579 if(c == ';') {
580 lex_read_unichar(0);
581 } else if(c != /*{*/'}') {
582 croak("syntax error");
583 }
584 if(do_stuff) lex_stuff_pvs(" ", 0);
585 return newOP(OP_NULL, 0);
586}
587
588#define parse_keyword_swaptwostmts() THX_parse_keyword_swaptwostmts(aTHX)
589static OP *THX_parse_keyword_swaptwostmts(pTHX)
590{
591 OP *a, *b;
592 a = parse_fullstmt(0);
593 b = parse_fullstmt(0);
594 if(a && b)
595 PL_hints |= HINT_BLOCK_SCOPE;
596 /* should use append_list(), but that's not part of the public API */
597 return !a ? b : !b ? a : newLISTOP(OP_LINESEQ, 0, b, a);
598}
599
07ffcb73
Z
600#define parse_keyword_looprest() THX_parse_keyword_looprest(aTHX)
601static OP *THX_parse_keyword_looprest(pTHX)
602{
603 I32 condline;
604 OP *body;
605 condline = CopLINE(PL_curcop);
606 body = parse_stmtseq(0);
607 return newWHILEOP(0, 1, NULL, condline, newSVOP(OP_CONST, 0, &PL_sv_yes),
608 body, NULL, 1);
609}
610
83f8bb56
Z
611/* plugin glue */
612
613#define keyword_active(hintkey_sv) THX_keyword_active(aTHX_ hintkey_sv)
614static int THX_keyword_active(pTHX_ SV *hintkey_sv)
615{
616 HE *he;
617 if(!GvHV(PL_hintgv)) return 0;
618 he = hv_fetch_ent(GvHV(PL_hintgv), hintkey_sv, 0,
619 SvSHARED_HASH(hintkey_sv));
620 return he && SvTRUE(HeVAL(he));
621}
622
623static int my_keyword_plugin(pTHX_
624 char *keyword_ptr, STRLEN keyword_len, OP **op_ptr)
625{
626 if(keyword_len == 3 && strnEQ(keyword_ptr, "rpn", 3) &&
627 keyword_active(hintkey_rpn_sv)) {
628 *op_ptr = parse_keyword_rpn();
629 return KEYWORD_PLUGIN_EXPR;
630 } else if(keyword_len == 7 && strnEQ(keyword_ptr, "calcrpn", 7) &&
631 keyword_active(hintkey_calcrpn_sv)) {
632 *op_ptr = parse_keyword_calcrpn();
633 return KEYWORD_PLUGIN_STMT;
634 } else if(keyword_len == 9 && strnEQ(keyword_ptr, "stufftest", 9) &&
635 keyword_active(hintkey_stufftest_sv)) {
636 *op_ptr = parse_keyword_stufftest();
637 return KEYWORD_PLUGIN_STMT;
638 } else if(keyword_len == 12 &&
639 strnEQ(keyword_ptr, "swaptwostmts", 12) &&
640 keyword_active(hintkey_swaptwostmts_sv)) {
641 *op_ptr = parse_keyword_swaptwostmts();
642 return KEYWORD_PLUGIN_STMT;
07ffcb73
Z
643 } else if(keyword_len == 8 && strnEQ(keyword_ptr, "looprest", 8) &&
644 keyword_active(hintkey_looprest_sv)) {
645 *op_ptr = parse_keyword_looprest();
646 return KEYWORD_PLUGIN_STMT;
83f8bb56
Z
647 } else {
648 return next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
649 }
650}
651
7b20c7cd 652XS(XS_XS__APItest__XSUB_XS_VERSION_undef);
f9cc56fa 653XS(XS_XS__APItest__XSUB_XS_VERSION_empty);
88c4b02d 654XS(XS_XS__APItest__XSUB_XS_APIVERSION_invalid);
7b20c7cd 655
55289a74
NC
656#include "const-c.inc"
657
ffe53d21 658MODULE = XS::APItest PACKAGE = XS::APItest
0314122a 659
55289a74
NC
660INCLUDE: const-xs.inc
661
ffe53d21
NC
662INCLUDE: numeric.xs
663
7b20c7cd
NC
664MODULE = XS::APItest PACKAGE = XS::APItest::XSUB
665
666BOOT:
667 newXS("XS::APItest::XSUB::XS_VERSION_undef", XS_XS__APItest__XSUB_XS_VERSION_undef, __FILE__);
f9cc56fa 668 newXS("XS::APItest::XSUB::XS_VERSION_empty", XS_XS__APItest__XSUB_XS_VERSION_empty, __FILE__);
88c4b02d 669 newXS("XS::APItest::XSUB::XS_APIVERSION_invalid", XS_XS__APItest__XSUB_XS_APIVERSION_invalid, __FILE__);
7b20c7cd
NC
670
671void
672XS_VERSION_defined(...)
673 PPCODE:
674 XS_VERSION_BOOTCHECK;
675 XSRETURN_EMPTY;
676
88c4b02d
NC
677void
678XS_APIVERSION_valid(...)
679 PPCODE:
680 XS_APIVERSION_BOOTCHECK;
681 XSRETURN_EMPTY;
682
ffe53d21
NC
683MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
684
b54b4831
NC
685void
686rot13_hash(hash)
687 HV *hash
688 CODE:
689 {
690 struct ufuncs uf;
691 uf.uf_val = rot13_key;
692 uf.uf_set = 0;
693 uf.uf_index = 0;
694
695 sv_magic((SV*)hash, NULL, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf));
696 }
697
53c40a8f
NC
698void
699bitflip_hash(hash)
700 HV *hash
701 CODE:
702 {
703 struct ufuncs uf;
704 uf.uf_val = bitflip_key;
705 uf.uf_set = 0;
706 uf.uf_index = 0;
707
708 sv_magic((SV*)hash, NULL, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf));
709 }
710
028f8eaa
MHM
711#define UTF8KLEN(sv, len) (SvUTF8(sv) ? -(I32)len : (I32)len)
712
0314122a
NC
713bool
714exists(hash, key_sv)
715 PREINIT:
716 STRLEN len;
717 const char *key;
718 INPUT:
719 HV *hash
720 SV *key_sv
721 CODE:
722 key = SvPV(key_sv, len);
028f8eaa 723 RETVAL = hv_exists(hash, key, UTF8KLEN(key_sv, len));
0314122a
NC
724 OUTPUT:
725 RETVAL
726
bdee33e4
NC
727bool
728exists_ent(hash, key_sv)
729 PREINIT:
730 INPUT:
731 HV *hash
732 SV *key_sv
733 CODE:
734 RETVAL = hv_exists_ent(hash, key_sv, 0);
735 OUTPUT:
736 RETVAL
737
b60cf05a 738SV *
55289a74 739delete(hash, key_sv, flags = 0)
b60cf05a
NC
740 PREINIT:
741 STRLEN len;
742 const char *key;
743 INPUT:
744 HV *hash
745 SV *key_sv
55289a74 746 I32 flags;
b60cf05a
NC
747 CODE:
748 key = SvPV(key_sv, len);
749 /* It's already mortal, so need to increase reference count. */
55289a74
NC
750 RETVAL
751 = SvREFCNT_inc(hv_delete(hash, key, UTF8KLEN(key_sv, len), flags));
752 OUTPUT:
753 RETVAL
754
755SV *
756delete_ent(hash, key_sv, flags = 0)
757 INPUT:
758 HV *hash
759 SV *key_sv
760 I32 flags;
761 CODE:
762 /* It's already mortal, so need to increase reference count. */
763 RETVAL = SvREFCNT_inc(hv_delete_ent(hash, key_sv, flags, 0));
b60cf05a
NC
764 OUTPUT:
765 RETVAL
766
767SV *
858117f8
NC
768store_ent(hash, key, value)
769 PREINIT:
770 SV *copy;
771 HE *result;
772 INPUT:
773 HV *hash
774 SV *key
775 SV *value
776 CODE:
777 copy = newSV(0);
778 result = hv_store_ent(hash, key, copy, 0);
779 SvSetMagicSV(copy, value);
780 if (!result) {
781 SvREFCNT_dec(copy);
782 XSRETURN_EMPTY;
783 }
784 /* It's about to become mortal, so need to increase reference count.
785 */
786 RETVAL = SvREFCNT_inc(HeVAL(result));
787 OUTPUT:
788 RETVAL
789
858117f8 790SV *
b60cf05a
NC
791store(hash, key_sv, value)
792 PREINIT:
793 STRLEN len;
794 const char *key;
795 SV *copy;
796 SV **result;
797 INPUT:
798 HV *hash
799 SV *key_sv
800 SV *value
801 CODE:
802 key = SvPV(key_sv, len);
803 copy = newSV(0);
028f8eaa 804 result = hv_store(hash, key, UTF8KLEN(key_sv, len), copy, 0);
858117f8 805 SvSetMagicSV(copy, value);
b60cf05a
NC
806 if (!result) {
807 SvREFCNT_dec(copy);
808 XSRETURN_EMPTY;
809 }
810 /* It's about to become mortal, so need to increase reference count.
811 */
812 RETVAL = SvREFCNT_inc(*result);
813 OUTPUT:
814 RETVAL
815
bdee33e4
NC
816SV *
817fetch_ent(hash, key_sv)
818 PREINIT:
819 HE *result;
820 INPUT:
821 HV *hash
822 SV *key_sv
823 CODE:
824 result = hv_fetch_ent(hash, key_sv, 0, 0);
825 if (!result) {
826 XSRETURN_EMPTY;
827 }
828 /* Force mg_get */
829 RETVAL = newSVsv(HeVAL(result));
830 OUTPUT:
831 RETVAL
b60cf05a
NC
832
833SV *
834fetch(hash, key_sv)
835 PREINIT:
836 STRLEN len;
837 const char *key;
838 SV **result;
839 INPUT:
840 HV *hash
841 SV *key_sv
842 CODE:
843 key = SvPV(key_sv, len);
028f8eaa 844 result = hv_fetch(hash, key, UTF8KLEN(key_sv, len), 0);
b60cf05a
NC
845 if (!result) {
846 XSRETURN_EMPTY;
847 }
848 /* Force mg_get */
849 RETVAL = newSVsv(*result);
850 OUTPUT:
851 RETVAL
2dc92170 852
9568a123
NC
853#if defined (hv_common)
854
6b4de907
NC
855SV *
856common(params)
857 INPUT:
858 HV *params
859 PREINIT:
860 HE *result;
861 HV *hv = NULL;
862 SV *keysv = NULL;
863 const char *key = NULL;
864 STRLEN klen = 0;
865 int flags = 0;
866 int action = 0;
867 SV *val = NULL;
868 U32 hash = 0;
869 SV **svp;
870 CODE:
871 if ((svp = hv_fetchs(params, "hv", 0))) {
872 SV *const rv = *svp;
873 if (!SvROK(rv))
874 croak("common passed a non-reference for parameter hv");
875 hv = (HV *)SvRV(rv);
876 }
877 if ((svp = hv_fetchs(params, "keysv", 0)))
878 keysv = *svp;
879 if ((svp = hv_fetchs(params, "keypv", 0))) {
880 key = SvPV_const(*svp, klen);
881 if (SvUTF8(*svp))
882 flags = HVhek_UTF8;
883 }
884 if ((svp = hv_fetchs(params, "action", 0)))
885 action = SvIV(*svp);
886 if ((svp = hv_fetchs(params, "val", 0)))
527df579 887 val = newSVsv(*svp);
6b4de907 888 if ((svp = hv_fetchs(params, "hash", 0)))
a44093a9 889 hash = SvUV(*svp);
6b4de907 890
527df579
NC
891 if ((svp = hv_fetchs(params, "hash_pv", 0))) {
892 PERL_HASH(hash, key, klen);
893 }
58ca560a
NC
894 if ((svp = hv_fetchs(params, "hash_sv", 0))) {
895 STRLEN len;
896 const char *const p = SvPV(keysv, len);
897 PERL_HASH(hash, p, len);
898 }
527df579 899
a75fcbca 900 result = (HE *)hv_common(hv, keysv, key, klen, flags, action, val, hash);
6b4de907
NC
901 if (!result) {
902 XSRETURN_EMPTY;
903 }
904 /* Force mg_get */
905 RETVAL = newSVsv(HeVAL(result));
906 OUTPUT:
907 RETVAL
908
9568a123
NC
909#endif
910
439efdfe 911void
2dc92170
NC
912test_hv_free_ent()
913 PPCODE:
914 test_freeent(&Perl_hv_free_ent);
915 XSRETURN(4);
916
439efdfe 917void
2dc92170
NC
918test_hv_delayfree_ent()
919 PPCODE:
920 test_freeent(&Perl_hv_delayfree_ent);
921 XSRETURN(4);
35ab5632
NC
922
923SV *
924test_share_unshare_pvn(input)
925 PREINIT:
35ab5632
NC
926 STRLEN len;
927 U32 hash;
928 char *pvx;
929 char *p;
930 INPUT:
931 SV *input
932 CODE:
933 pvx = SvPV(input, len);
934 PERL_HASH(hash, pvx, len);
935 p = sharepvn(pvx, len, hash);
936 RETVAL = newSVpvn(p, len);
937 unsharepvn(p, len, hash);
938 OUTPUT:
939 RETVAL
d8c5b3c5 940
9568a123
NC
941#if PERL_VERSION >= 9
942
d8c5b3c5
NC
943bool
944refcounted_he_exists(key, level=0)
945 SV *key
946 IV level
947 CODE:
948 if (level) {
949 croak("level must be zero, not %"IVdf, level);
950 }
951 RETVAL = (Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
952 key, NULL, 0, 0, 0)
953 != &PL_sv_placeholder);
954 OUTPUT:
955 RETVAL
956
d8c5b3c5
NC
957SV *
958refcounted_he_fetch(key, level=0)
959 SV *key
960 IV level
961 CODE:
962 if (level) {
963 croak("level must be zero, not %"IVdf, level);
964 }
965 RETVAL = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, key,
966 NULL, 0, 0, 0);
967 SvREFCNT_inc(RETVAL);
968 OUTPUT:
969 RETVAL
65bfe90c 970
9568a123 971#endif
65bfe90c 972
0314122a
NC
973=pod
974
975sub TIEHASH { bless {}, $_[0] }
976sub STORE { $_[0]->{$_[1]} = $_[2] }
977sub FETCH { $_[0]->{$_[1]} }
978sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
979sub NEXTKEY { each %{$_[0]} }
980sub EXISTS { exists $_[0]->{$_[1]} }
981sub DELETE { delete $_[0]->{$_[1]} }
982sub CLEAR { %{$_[0]} = () }
983
984=cut
985
e2fe06dd
EB
986MODULE = XS::APItest:TempLv PACKAGE = XS::APItest::TempLv
987
988void
989make_temp_mg_lv(sv)
990SV* sv
991 PREINIT:
992 SV * const lv = newSV_type(SVt_PVLV);
993 STRLEN len;
994 PPCODE:
995 SvPV(sv, len);
996
997 sv_magic(lv, NULL, PERL_MAGIC_substr, NULL, 0);
998 LvTYPE(lv) = 'x';
999 LvTARG(lv) = SvREFCNT_inc_simple(sv);
1000 LvTARGOFF(lv) = len == 0 ? 0 : 1;
1001 LvTARGLEN(lv) = len < 2 ? 0 : len-2;
1002
1003 EXTEND(SP, 1);
1004 ST(0) = sv_2mortal(lv);
1005 XSRETURN(1);
1006
1007
36c2b1d0
NC
1008MODULE = XS::APItest::PtrTable PACKAGE = XS::APItest::PtrTable PREFIX = ptr_table_
1009
1010void
1011ptr_table_new(classname)
1012const char * classname
1013 PPCODE:
1014 PUSHs(sv_setref_pv(sv_newmortal(), classname, (void*)ptr_table_new()));
1015
1016void
1017DESTROY(table)
1018XS::APItest::PtrTable table
1019 CODE:
1020 ptr_table_free(table);
1021
1022void
992b2363 1023ptr_table_store(table, from, to)
36c2b1d0 1024XS::APItest::PtrTable table
992b2363
NC
1025SVREF from
1026SVREF to
36c2b1d0 1027 CODE:
992b2363 1028 ptr_table_store(table, from, to);
36c2b1d0
NC
1029
1030UV
992b2363 1031ptr_table_fetch(table, from)
36c2b1d0 1032XS::APItest::PtrTable table
992b2363 1033SVREF from
36c2b1d0 1034 CODE:
992b2363 1035 RETVAL = PTR2UV(ptr_table_fetch(table, from));
36c2b1d0
NC
1036 OUTPUT:
1037 RETVAL
1038
1039void
1040ptr_table_split(table)
1041XS::APItest::PtrTable table
1042
1043void
1044ptr_table_clear(table)
1045XS::APItest::PtrTable table
1046
3e61d65a
JH
1047MODULE = XS::APItest PACKAGE = XS::APItest
1048
1049PROTOTYPES: DISABLE
1050
85ce96a1
DM
1051BOOT:
1052{
1053 MY_CXT_INIT;
03569ecf 1054
85ce96a1
DM
1055 MY_CXT.i = 99;
1056 MY_CXT.sv = newSVpv("initial",0);
13b6b3bc
BM
1057
1058 MY_CXT.bhkav = get_av("XS::APItest::bhkav", GV_ADDMULTI);
1059 MY_CXT.bhk_record = 0;
1060
a88d97bf
BM
1061 BhkENTRY_set(&bhk_test, bhk_start, blockhook_test_start);
1062 BhkENTRY_set(&bhk_test, bhk_pre_end, blockhook_test_pre_end);
1063 BhkENTRY_set(&bhk_test, bhk_post_end, blockhook_test_post_end);
1064 BhkENTRY_set(&bhk_test, bhk_eval, blockhook_test_eval);
13b6b3bc
BM
1065 Perl_blockhook_register(aTHX_ &bhk_test);
1066
65bfe90c 1067 MY_CXT.cscgv = gv_fetchpvs("XS::APItest::COMPILE_SCOPE_CONTAINER",
13b6b3bc 1068 GV_ADDMULTI, SVt_PVAV);
03569ecf
BM
1069 MY_CXT.cscav = GvAV(MY_CXT.cscgv);
1070
a88d97bf
BM
1071 BhkENTRY_set(&bhk_csc, bhk_start, blockhook_csc_start);
1072 BhkENTRY_set(&bhk_csc, bhk_pre_end, blockhook_csc_pre_end);
13b6b3bc 1073 Perl_blockhook_register(aTHX_ &bhk_csc);
201c7e1f
FR
1074
1075 MY_CXT.peep_recorder = newAV();
1076 MY_CXT.rpeep_recorder = newAV();
1077
1078 MY_CXT.orig_peep = PL_peepp;
1079 MY_CXT.orig_rpeep = PL_rpeepp;
1080 PL_peepp = my_peep;
1081 PL_rpeepp = my_rpeep;
65bfe90c 1082}
85ce96a1
DM
1083
1084void
1085CLONE(...)
1086 CODE:
1087 MY_CXT_CLONE;
1088 MY_CXT.sv = newSVpv("initial_clone",0);
65bfe90c 1089 MY_CXT.cscgv = gv_fetchpvs("XS::APItest::COMPILE_SCOPE_CONTAINER",
13b6b3bc 1090 GV_ADDMULTI, SVt_PVAV);
03569ecf 1091 MY_CXT.cscav = NULL;
13b6b3bc
BM
1092 MY_CXT.bhkav = get_av("XS::APItest::bhkav", GV_ADDMULTI);
1093 MY_CXT.bhk_record = 0;
201c7e1f
FR
1094 MY_CXT.peep_recorder = newAV();
1095 MY_CXT.rpeep_recorder = newAV();
85ce96a1 1096
3e61d65a
JH
1097void
1098print_double(val)
1099 double val
1100 CODE:
1101 printf("%5.3f\n",val);
1102
1103int
1104have_long_double()
1105 CODE:
1106#ifdef HAS_LONG_DOUBLE
1107 RETVAL = 1;
1108#else
1109 RETVAL = 0;
1110#endif
cabb36f0
CN
1111 OUTPUT:
1112 RETVAL
3e61d65a
JH
1113
1114void
1115print_long_double()
1116 CODE:
1117#ifdef HAS_LONG_DOUBLE
fc0bf671 1118# if defined(PERL_PRIfldbl) && (LONG_DOUBLESIZE > DOUBLESIZE)
3e61d65a
JH
1119 long double val = 7.0;
1120 printf("%5.3" PERL_PRIfldbl "\n",val);
1121# else
1122 double val = 7.0;
1123 printf("%5.3f\n",val);
1124# endif
1125#endif
1126
1127void
3e61d65a
JH
1128print_int(val)
1129 int val
1130 CODE:
1131 printf("%d\n",val);
1132
1133void
1134print_long(val)
1135 long val
1136 CODE:
1137 printf("%ld\n",val);
1138
1139void
1140print_float(val)
1141 float val
1142 CODE:
1143 printf("%5.3f\n",val);
9d911683
NIS
1144
1145void
1146print_flush()
1147 CODE:
1148 fflush(stdout);
d4b90eee
SH
1149
1150void
1151mpushp()
1152 PPCODE:
1153 EXTEND(SP, 3);
1154 mPUSHp("one", 3);
1155 mPUSHp("two", 3);
1156 mPUSHp("three", 5);
1157 XSRETURN(3);
1158
1159void
1160mpushn()
1161 PPCODE:
1162 EXTEND(SP, 3);
1163 mPUSHn(0.5);
1164 mPUSHn(-0.25);
1165 mPUSHn(0.125);
1166 XSRETURN(3);
1167
1168void
1169mpushi()
1170 PPCODE:
1171 EXTEND(SP, 3);
d75b63cf
MHM
1172 mPUSHi(-1);
1173 mPUSHi(2);
1174 mPUSHi(-3);
d4b90eee
SH
1175 XSRETURN(3);
1176
1177void
1178mpushu()
1179 PPCODE:
1180 EXTEND(SP, 3);
d75b63cf
MHM
1181 mPUSHu(1);
1182 mPUSHu(2);
1183 mPUSHu(3);
d4b90eee
SH
1184 XSRETURN(3);
1185
1186void
1187mxpushp()
1188 PPCODE:
1189 mXPUSHp("one", 3);
1190 mXPUSHp("two", 3);
1191 mXPUSHp("three", 5);
1192 XSRETURN(3);
1193
1194void
1195mxpushn()
1196 PPCODE:
1197 mXPUSHn(0.5);
1198 mXPUSHn(-0.25);
1199 mXPUSHn(0.125);
1200 XSRETURN(3);
1201
1202void
1203mxpushi()
1204 PPCODE:
d75b63cf
MHM
1205 mXPUSHi(-1);
1206 mXPUSHi(2);
1207 mXPUSHi(-3);
d4b90eee
SH
1208 XSRETURN(3);
1209
1210void
1211mxpushu()
1212 PPCODE:
d75b63cf
MHM
1213 mXPUSHu(1);
1214 mXPUSHu(2);
1215 mXPUSHu(3);
d4b90eee 1216 XSRETURN(3);
d1f347d7
DM
1217
1218
1219void
1220call_sv(sv, flags, ...)
1221 SV* sv
1222 I32 flags
1223 PREINIT:
1224 I32 i;
1225 PPCODE:
1226 for (i=0; i<items-2; i++)
1227 ST(i) = ST(i+2); /* pop first two args */
1228 PUSHMARK(SP);
1229 SP += items - 2;
1230 PUTBACK;
1231 i = call_sv(sv, flags);
1232 SPAGAIN;
1233 EXTEND(SP, 1);
1234 PUSHs(sv_2mortal(newSViv(i)));
1235
1236void
1237call_pv(subname, flags, ...)
1238 char* subname
1239 I32 flags
1240 PREINIT:
1241 I32 i;
1242 PPCODE:
1243 for (i=0; i<items-2; i++)
1244 ST(i) = ST(i+2); /* pop first two args */
1245 PUSHMARK(SP);
1246 SP += items - 2;
1247 PUTBACK;
1248 i = call_pv(subname, flags);
1249 SPAGAIN;
1250 EXTEND(SP, 1);
1251 PUSHs(sv_2mortal(newSViv(i)));
1252
1253void
1254call_method(methname, flags, ...)
1255 char* methname
1256 I32 flags
1257 PREINIT:
1258 I32 i;
1259 PPCODE:
1260 for (i=0; i<items-2; i++)
1261 ST(i) = ST(i+2); /* pop first two args */
1262 PUSHMARK(SP);
1263 SP += items - 2;
1264 PUTBACK;
1265 i = call_method(methname, flags);
1266 SPAGAIN;
1267 EXTEND(SP, 1);
1268 PUSHs(sv_2mortal(newSViv(i)));
1269
1270void
1271eval_sv(sv, flags)
1272 SV* sv
1273 I32 flags
1274 PREINIT:
1275 I32 i;
1276 PPCODE:
1277 PUTBACK;
1278 i = eval_sv(sv, flags);
1279 SPAGAIN;
1280 EXTEND(SP, 1);
1281 PUSHs(sv_2mortal(newSViv(i)));
1282
b8e65a9b 1283void
d1f347d7
DM
1284eval_pv(p, croak_on_error)
1285 const char* p
1286 I32 croak_on_error
d1f347d7
DM
1287 PPCODE:
1288 PUTBACK;
1289 EXTEND(SP, 1);
1290 PUSHs(eval_pv(p, croak_on_error));
1291
1292void
1293require_pv(pv)
1294 const char* pv
d1f347d7
DM
1295 PPCODE:
1296 PUTBACK;
1297 require_pv(pv);
1298
0ca3a874 1299int
7a646707 1300apitest_exception(throw_e)
0ca3a874
MHM
1301 int throw_e
1302 OUTPUT:
1303 RETVAL
d1f347d7 1304
ef469b03 1305void
7e7a3dfc
GA
1306mycroak(sv)
1307 SV* sv
ef469b03 1308 CODE:
7e7a3dfc
GA
1309 if (SvOK(sv)) {
1310 Perl_croak(aTHX_ "%s", SvPV_nolen(sv));
1311 }
1312 else {
1313 Perl_croak(aTHX_ NULL);
1314 }
5d2b1485
NC
1315
1316SV*
1317strtab()
1318 CODE:
1319 RETVAL = newRV_inc((SV*)PL_strtab);
1320 OUTPUT:
1321 RETVAL
85ce96a1
DM
1322
1323int
1324my_cxt_getint()
1325 CODE:
1326 dMY_CXT;
1327 RETVAL = my_cxt_getint_p(aMY_CXT);
1328 OUTPUT:
1329 RETVAL
1330
1331void
1332my_cxt_setint(i)
1333 int i;
1334 CODE:
1335 dMY_CXT;
1336 my_cxt_setint_p(aMY_CXT_ i);
1337
1338void
9568a123
NC
1339my_cxt_getsv(how)
1340 bool how;
85ce96a1 1341 PPCODE:
85ce96a1 1342 EXTEND(SP, 1);
9568a123 1343 ST(0) = how ? my_cxt_getsv_interp_context() : my_cxt_getsv_interp();
85ce96a1
DM
1344 XSRETURN(1);
1345
1346void
1347my_cxt_setsv(sv)
1348 SV *sv;
1349 CODE:
1350 dMY_CXT;
1351 SvREFCNT_dec(MY_CXT.sv);
1352 my_cxt_setsv_p(sv _aMY_CXT);
1353 SvREFCNT_inc(sv);
34482cd6
NC
1354
1355bool
1356sv_setsv_cow_hashkey_core()
1357
1358bool
1359sv_setsv_cow_hashkey_notcore()
84ac5fd7
NC
1360
1361void
218787bd
VP
1362rmagical_cast(sv, type)
1363 SV *sv;
1364 SV *type;
1365 PREINIT:
1366 struct ufuncs uf;
1367 PPCODE:
1368 if (!SvOK(sv) || !SvROK(sv) || !SvOK(type)) { XSRETURN_UNDEF; }
1369 sv = SvRV(sv);
1370 if (SvTYPE(sv) != SVt_PVHV) { XSRETURN_UNDEF; }
1371 uf.uf_val = rmagical_a_dummy;
1372 uf.uf_set = NULL;
1373 uf.uf_index = 0;
1374 if (SvTRUE(type)) { /* b */
1375 sv_magicext(sv, NULL, PERL_MAGIC_ext, &rmagical_b, NULL, 0);
1376 } else { /* a */
1377 sv_magic(sv, NULL, PERL_MAGIC_uvar, (char *) &uf, sizeof(uf));
1378 }
1379 XSRETURN_YES;
1380
1381void
1382rmagical_flags(sv)
1383 SV *sv;
1384 PPCODE:
1385 if (!SvOK(sv) || !SvROK(sv)) { XSRETURN_UNDEF; }
1386 sv = SvRV(sv);
1387 EXTEND(SP, 3);
1388 mXPUSHu(SvFLAGS(sv) & SVs_GMG);
1389 mXPUSHu(SvFLAGS(sv) & SVs_SMG);
1390 mXPUSHu(SvFLAGS(sv) & SVs_RMG);
1391 XSRETURN(3);
1392
1393void
90d1f214
BM
1394my_caller(level)
1395 I32 level
1396 PREINIT:
1397 const PERL_CONTEXT *cx, *dbcx;
1398 const char *pv;
1399 const GV *gv;
1400 HV *hv;
1401 PPCODE:
1402 cx = caller_cx(level, &dbcx);
1403 EXTEND(SP, 8);
1404
1405 pv = CopSTASHPV(cx->blk_oldcop);
1406 ST(0) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef;
1407 gv = CvGV(cx->blk_sub.cv);
1408 ST(1) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef;
1409
1410 pv = CopSTASHPV(dbcx->blk_oldcop);
1411 ST(2) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef;
1412 gv = CvGV(dbcx->blk_sub.cv);
1413 ST(3) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef;
1414
1415 ST(4) = cop_hints_fetchpvs(cx->blk_oldcop, "foo");
1416 ST(5) = cop_hints_fetchpvn(cx->blk_oldcop, "foo", 3, 0, 0);
1417 ST(6) = cop_hints_fetchsv(cx->blk_oldcop,
1418 sv_2mortal(newSVpvn("foo", 3)), 0);
1419
1420 hv = cop_hints_2hv(cx->blk_oldcop);
1421 ST(7) = hv ? sv_2mortal(newRV_noinc((SV *)hv)) : &PL_sv_undef;
1422
1423 XSRETURN(8);
1424
1425void
f9c17636
MB
1426DPeek (sv)
1427 SV *sv
1428
1429 PPCODE:
5b1f7359 1430 ST (0) = newSVpv (Perl_sv_peek (aTHX_ sv), 0);
f9c17636
MB
1431 XSRETURN (1);
1432
1433void
84ac5fd7
NC
1434BEGIN()
1435 CODE:
1436 sv_inc(get_sv("XS::APItest::BEGIN_called", GV_ADD|GV_ADDMULTI));
1437
1438void
1439CHECK()
1440 CODE:
1441 sv_inc(get_sv("XS::APItest::CHECK_called", GV_ADD|GV_ADDMULTI));
1442
1443void
1444UNITCHECK()
1445 CODE:
0932863f 1446 sv_inc(get_sv("XS::APItest::UNITCHECK_called", GV_ADD|GV_ADDMULTI));
84ac5fd7
NC
1447
1448void
1449INIT()
1450 CODE:
1451 sv_inc(get_sv("XS::APItest::INIT_called", GV_ADD|GV_ADDMULTI));
1452
1453void
1454END()
1455 CODE:
1456 sv_inc(get_sv("XS::APItest::END_called", GV_ADD|GV_ADDMULTI));
30685b56
NC
1457
1458void
1459utf16_to_utf8 (sv, ...)
1460 SV* sv
1461 ALIAS:
1462 utf16_to_utf8_reversed = 1
1463 PREINIT:
1464 STRLEN len;
1465 U8 *source;
1466 SV *dest;
1467 I32 got; /* Gah, badly thought out APIs */
1468 CODE:
1469 source = (U8 *)SvPVbyte(sv, len);
1470 /* Optionally only convert part of the buffer. */
1471 if (items > 1) {
1472 len = SvUV(ST(1));
1473 }
1474 /* Mortalise this right now, as we'll be testing croak()s */
1475 dest = sv_2mortal(newSV(len * 3 / 2 + 1));
1476 if (ix) {
25f2e844 1477 utf16_to_utf8_reversed(source, (U8 *)SvPVX(dest), len, &got);
30685b56 1478 } else {
25f2e844 1479 utf16_to_utf8(source, (U8 *)SvPVX(dest), len, &got);
30685b56
NC
1480 }
1481 SvCUR_set(dest, got);
1482 SvPVX(dest)[got] = '\0';
1483 SvPOK_on(dest);
1484 ST(0) = dest;
1485 XSRETURN(1);
879d0c72 1486
6bd7445c
GG
1487void
1488my_exit(int exitcode)
1489 PPCODE:
1490 my_exit(exitcode);
d97c33b5
DM
1491
1492I32
1493sv_count()
1494 CODE:
1495 RETVAL = PL_sv_count;
1496 OUTPUT:
1497 RETVAL
13b6b3bc
BM
1498
1499void
1500bhk_record(bool on)
1501 CODE:
1502 dMY_CXT;
1503 MY_CXT.bhk_record = on;
1504 if (on)
1505 av_clear(MY_CXT.bhkav);
65bfe90c 1506
defdfed5 1507void
d9088386
Z
1508test_magic_chain()
1509 PREINIT:
1510 SV *sv;
1511 MAGIC *callmg, *uvarmg;
1512 CODE:
1513 sv = sv_2mortal(newSV(0));
1514 if (SvTYPE(sv) >= SVt_PVMG) croak("fail");
1515 if (SvMAGICAL(sv)) croak("fail");
1516 sv_magic(sv, &PL_sv_yes, PERL_MAGIC_checkcall, (char*)&callmg, 0);
1517 if (SvTYPE(sv) < SVt_PVMG) croak("fail");
1518 if (!SvMAGICAL(sv)) croak("fail");
1519 if (mg_find(sv, PERL_MAGIC_uvar)) croak("fail");
1520 callmg = mg_find(sv, PERL_MAGIC_checkcall);
1521 if (!callmg) croak("fail");
1522 if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
1523 croak("fail");
1524 sv_magic(sv, &PL_sv_no, PERL_MAGIC_uvar, (char*)&uvarmg, 0);
1525 if (SvTYPE(sv) < SVt_PVMG) croak("fail");
1526 if (!SvMAGICAL(sv)) croak("fail");
1527 if (mg_find(sv, PERL_MAGIC_checkcall) != callmg) croak("fail");
1528 uvarmg = mg_find(sv, PERL_MAGIC_uvar);
1529 if (!uvarmg) croak("fail");
1530 if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
1531 croak("fail");
1532 if (uvarmg->mg_obj != &PL_sv_no || uvarmg->mg_ptr != (char*)&uvarmg)
1533 croak("fail");
1534 mg_free_type(sv, PERL_MAGIC_vec);
1535 if (SvTYPE(sv) < SVt_PVMG) croak("fail");
1536 if (!SvMAGICAL(sv)) croak("fail");
1537 if (mg_find(sv, PERL_MAGIC_checkcall) != callmg) croak("fail");
1538 if (mg_find(sv, PERL_MAGIC_uvar) != uvarmg) croak("fail");
1539 if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
1540 croak("fail");
1541 if (uvarmg->mg_obj != &PL_sv_no || uvarmg->mg_ptr != (char*)&uvarmg)
1542 croak("fail");
1543 mg_free_type(sv, PERL_MAGIC_uvar);
1544 if (SvTYPE(sv) < SVt_PVMG) croak("fail");
1545 if (!SvMAGICAL(sv)) croak("fail");
1546 if (mg_find(sv, PERL_MAGIC_checkcall) != callmg) croak("fail");
1547 if (mg_find(sv, PERL_MAGIC_uvar)) croak("fail");
1548 if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
1549 croak("fail");
1550 sv_magic(sv, &PL_sv_no, PERL_MAGIC_uvar, (char*)&uvarmg, 0);
1551 if (SvTYPE(sv) < SVt_PVMG) croak("fail");
1552 if (!SvMAGICAL(sv)) croak("fail");
1553 if (mg_find(sv, PERL_MAGIC_checkcall) != callmg) croak("fail");
1554 uvarmg = mg_find(sv, PERL_MAGIC_uvar);
1555 if (!uvarmg) croak("fail");
1556 if (callmg->mg_obj != &PL_sv_yes || callmg->mg_ptr != (char*)&callmg)
1557 croak("fail");
1558 if (uvarmg->mg_obj != &PL_sv_no || uvarmg->mg_ptr != (char*)&uvarmg)
1559 croak("fail");
1560 mg_free_type(sv, PERL_MAGIC_checkcall);
1561 if (SvTYPE(sv) < SVt_PVMG) croak("fail");
1562 if (!SvMAGICAL(sv)) croak("fail");
1563 if (mg_find(sv, PERL_MAGIC_uvar) != uvarmg) croak("fail");
1564 if (mg_find(sv, PERL_MAGIC_checkcall)) croak("fail");
1565 if (uvarmg->mg_obj != &PL_sv_no || uvarmg->mg_ptr != (char*)&uvarmg)
1566 croak("fail");
1567 mg_free_type(sv, PERL_MAGIC_uvar);
1568 if (SvMAGICAL(sv)) croak("fail");
1569 if (mg_find(sv, PERL_MAGIC_checkcall)) croak("fail");
1570 if (mg_find(sv, PERL_MAGIC_uvar)) croak("fail");
1571
1572void
1573test_op_contextualize()
1574 PREINIT:
1575 OP *o;
1576 CODE:
1577 o = newSVOP(OP_CONST, 0, newSViv(0));
1578 o->op_flags &= ~OPf_WANT;
1579 o = op_contextualize(o, G_SCALAR);
1580 if (o->op_type != OP_CONST ||
1581 (o->op_flags & OPf_WANT) != OPf_WANT_SCALAR)
1582 croak("fail");
1583 op_free(o);
1584 o = newSVOP(OP_CONST, 0, newSViv(0));
1585 o->op_flags &= ~OPf_WANT;
1586 o = op_contextualize(o, G_ARRAY);
1587 if (o->op_type != OP_CONST ||
1588 (o->op_flags & OPf_WANT) != OPf_WANT_LIST)
1589 croak("fail");
1590 op_free(o);
1591 o = newSVOP(OP_CONST, 0, newSViv(0));
1592 o->op_flags &= ~OPf_WANT;
1593 o = op_contextualize(o, G_VOID);
1594 if (o->op_type != OP_NULL) croak("fail");
1595 op_free(o);
1596
1597void
1598test_rv2cv_op_cv()
1599 PROTOTYPE:
1600 PREINIT:
1601 GV *troc_gv, *wibble_gv;
1602 CV *troc_cv;
1603 OP *o;
1604 CODE:
1605 troc_gv = gv_fetchpv("XS::APItest::test_rv2cv_op_cv", 0, SVt_PVGV);
1606 troc_cv = get_cv("XS::APItest::test_rv2cv_op_cv", 0);
1607 wibble_gv = gv_fetchpv("XS::APItest::wibble", 0, SVt_PVGV);
1608 o = newCVREF(0, newGVOP(OP_GV, 0, troc_gv));
1609 if (rv2cv_op_cv(o, 0) != troc_cv) croak("fail");
1610 if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV) != (CV*)troc_gv)
1611 croak("fail");
1612 o->op_private |= OPpENTERSUB_AMPER;
1613 if (rv2cv_op_cv(o, 0)) croak("fail");
1614 if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak("fail");
1615 o->op_private &= ~OPpENTERSUB_AMPER;
1616 if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak("fail");
1617 if (rv2cv_op_cv(o, RV2CVOPCV_MARK_EARLY) != troc_cv) croak("fail");
1618 if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak("fail");
1619 op_free(o);
1620 o = newSVOP(OP_CONST, 0, newSVpv("XS::APItest::test_rv2cv_op_cv", 0));
1621 o->op_private = OPpCONST_BARE;
1622 o = newCVREF(0, o);
1623 if (rv2cv_op_cv(o, 0) != troc_cv) croak("fail");
1624 if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV) != (CV*)troc_gv)
1625 croak("fail");
1626 o->op_private |= OPpENTERSUB_AMPER;
1627 if (rv2cv_op_cv(o, 0)) croak("fail");
1628 if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak("fail");
1629 op_free(o);
1630 o = newCVREF(0, newSVOP(OP_CONST, 0, newRV_inc((SV*)troc_cv)));
1631 if (rv2cv_op_cv(o, 0) != troc_cv) croak("fail");
1632 if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV) != (CV*)troc_gv)
1633 croak("fail");
1634 o->op_private |= OPpENTERSUB_AMPER;
1635 if (rv2cv_op_cv(o, 0)) croak("fail");
1636 if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak("fail");
1637 o->op_private &= ~OPpENTERSUB_AMPER;
1638 if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak("fail");
1639 if (rv2cv_op_cv(o, RV2CVOPCV_MARK_EARLY) != troc_cv) croak("fail");
1640 if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak("fail");
1641 op_free(o);
1642 o = newCVREF(0, newUNOP(OP_RAND, 0, newSVOP(OP_CONST, 0, newSViv(0))));
1643 if (rv2cv_op_cv(o, 0)) croak("fail");
1644 if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak("fail");
1645 o->op_private |= OPpENTERSUB_AMPER;
1646 if (rv2cv_op_cv(o, 0)) croak("fail");
1647 if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak("fail");
1648 o->op_private &= ~OPpENTERSUB_AMPER;
1649 if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak("fail");
1650 if (rv2cv_op_cv(o, RV2CVOPCV_MARK_EARLY)) croak("fail");
1651 if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak("fail");
1652 op_free(o);
1653 o = newUNOP(OP_RAND, 0, newSVOP(OP_CONST, 0, newSViv(0)));
1654 if (rv2cv_op_cv(o, 0)) croak("fail");
1655 if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak("fail");
1656 op_free(o);
1657
1658void
1659test_cv_getset_call_checker()
1660 PREINIT:
1661 CV *troc_cv, *tsh_cv;
1662 Perl_call_checker ckfun;
1663 SV *ckobj;
1664 CODE:
1665#define check_cc(cv, xckfun, xckobj) \
1666 do { \
1667 cv_get_call_checker((cv), &ckfun, &ckobj); \
1668 if (ckfun != (xckfun) || ckobj != (xckobj)) croak("fail"); \
1669 } while(0)
1670 troc_cv = get_cv("XS::APItest::test_rv2cv_op_cv", 0);
1671 tsh_cv = get_cv("XS::APItest::test_savehints", 0);
1672 check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv);
1673 check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv);
1674 cv_set_call_checker(tsh_cv, Perl_ck_entersub_args_proto_or_list,
1675 &PL_sv_yes);
1676 check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv);
1677 check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes);
1678 cv_set_call_checker(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no);
1679 check_cc(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no);
1680 check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, &PL_sv_yes);
1681 cv_set_call_checker(tsh_cv, Perl_ck_entersub_args_proto_or_list,
1682 (SV*)tsh_cv);
1683 check_cc(troc_cv, THX_ck_entersub_args_scalars, &PL_sv_no);
1684 check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv);
1685 cv_set_call_checker(troc_cv, Perl_ck_entersub_args_proto_or_list,
1686 (SV*)troc_cv);
1687 check_cc(troc_cv, Perl_ck_entersub_args_proto_or_list, (SV*)troc_cv);
1688 check_cc(tsh_cv, Perl_ck_entersub_args_proto_or_list, (SV*)tsh_cv);
1689 if (SvMAGICAL((SV*)troc_cv) || SvMAGIC((SV*)troc_cv)) croak("fail");
1690 if (SvMAGICAL((SV*)tsh_cv) || SvMAGIC((SV*)tsh_cv)) croak("fail");
1691#undef check_cc
1692
1693void
1694cv_set_call_checker_lists(CV *cv)
1695 CODE:
1696 cv_set_call_checker(cv, THX_ck_entersub_args_lists, &PL_sv_undef);
1697
1698void
1699cv_set_call_checker_scalars(CV *cv)
1700 CODE:
1701 cv_set_call_checker(cv, THX_ck_entersub_args_scalars, &PL_sv_undef);
1702
1703void
1704cv_set_call_checker_proto(CV *cv, SV *proto)
1705 CODE:
1706 if (SvROK(proto))
1707 proto = SvRV(proto);
1708 cv_set_call_checker(cv, Perl_ck_entersub_args_proto, proto);
1709
1710void
1711cv_set_call_checker_proto_or_list(CV *cv, SV *proto)
1712 CODE:
1713 if (SvROK(proto))
1714 proto = SvRV(proto);
1715 cv_set_call_checker(cv, Perl_ck_entersub_args_proto_or_list, proto);
1716
1717void
1718cv_set_call_checker_multi_sum(CV *cv)
1719 CODE:
1720 cv_set_call_checker(cv, THX_ck_entersub_multi_sum, &PL_sv_undef);
1721
1722void
defdfed5
Z
1723test_savehints()
1724 PREINIT:
1725 SV **svp, *sv;
1726 CODE:
1727#define store_hint(KEY, VALUE) \
1728 sv_setiv_mg(*hv_fetchs(GvHV(PL_hintgv), KEY, 1), (VALUE))
1729#define hint_ok(KEY, EXPECT) \
1730 ((svp = hv_fetchs(GvHV(PL_hintgv), KEY, 0)) && \
1731 (sv = *svp) && SvIV(sv) == (EXPECT) && \
1732 (sv = cop_hints_fetchpvs(&PL_compiling, KEY)) && \
1733 SvIV(sv) == (EXPECT))
1734#define check_hint(KEY, EXPECT) \
1735 do { if (!hint_ok(KEY, EXPECT)) croak("fail"); } while(0)
1736 PL_hints |= HINT_LOCALIZE_HH;
1737 ENTER;
1738 SAVEHINTS();
1739 PL_hints &= HINT_INTEGER;
1740 store_hint("t0", 123);
1741 store_hint("t1", 456);
1742 if (PL_hints & HINT_INTEGER) croak("fail");
1743 check_hint("t0", 123); check_hint("t1", 456);
1744 ENTER;
1745 SAVEHINTS();
1746 if (PL_hints & HINT_INTEGER) croak("fail");
1747 check_hint("t0", 123); check_hint("t1", 456);
1748 PL_hints |= HINT_INTEGER;
1749 store_hint("t0", 321);
1750 if (!(PL_hints & HINT_INTEGER)) croak("fail");
1751 check_hint("t0", 321); check_hint("t1", 456);
1752 LEAVE;
1753 if (PL_hints & HINT_INTEGER) croak("fail");
1754 check_hint("t0", 123); check_hint("t1", 456);
1755 ENTER;
1756 SAVEHINTS();
1757 if (PL_hints & HINT_INTEGER) croak("fail");
1758 check_hint("t0", 123); check_hint("t1", 456);
1759 store_hint("t1", 654);
1760 if (PL_hints & HINT_INTEGER) croak("fail");
1761 check_hint("t0", 123); check_hint("t1", 654);
1762 LEAVE;
1763 if (PL_hints & HINT_INTEGER) croak("fail");
1764 check_hint("t0", 123); check_hint("t1", 456);
1765 LEAVE;
1766#undef store_hint
1767#undef hint_ok
1768#undef check_hint
1769
1770void
1771test_copyhints()
1772 PREINIT:
1773 HV *a, *b;
1774 CODE:
1775 PL_hints |= HINT_LOCALIZE_HH;
1776 ENTER;
1777 SAVEHINTS();
1778 sv_setiv_mg(*hv_fetchs(GvHV(PL_hintgv), "t0", 1), 123);
1779 if (SvIV(cop_hints_fetchpvs(&PL_compiling, "t0")) != 123) croak("fail");
1780 a = newHVhv(GvHV(PL_hintgv));
1781 sv_2mortal((SV*)a);
1782 sv_setiv_mg(*hv_fetchs(a, "t0", 1), 456);
1783 if (SvIV(cop_hints_fetchpvs(&PL_compiling, "t0")) != 123) croak("fail");
1784 b = hv_copy_hints_hv(a);
1785 sv_2mortal((SV*)b);
1786 sv_setiv_mg(*hv_fetchs(b, "t0", 1), 789);
1787 if (SvIV(cop_hints_fetchpvs(&PL_compiling, "t0")) != 789) croak("fail");
1788 LEAVE;
1789
201c7e1f
FR
1790void
1791peep_enable ()
1792 PREINIT:
1793 dMY_CXT;
1794 CODE:
1795 av_clear(MY_CXT.peep_recorder);
1796 av_clear(MY_CXT.rpeep_recorder);
1797 MY_CXT.peep_recording = 1;
1798
1799void
1800peep_disable ()
1801 PREINIT:
1802 dMY_CXT;
1803 CODE:
1804 MY_CXT.peep_recording = 0;
1805
1806SV *
1807peep_record ()
1808 PREINIT:
1809 dMY_CXT;
1810 CODE:
95d2461a 1811 RETVAL = newRV_inc((SV *)MY_CXT.peep_recorder);
201c7e1f
FR
1812 OUTPUT:
1813 RETVAL
1814
1815SV *
1816rpeep_record ()
1817 PREINIT:
1818 dMY_CXT;
1819 CODE:
95d2461a 1820 RETVAL = newRV_inc((SV *)MY_CXT.rpeep_recorder);
201c7e1f
FR
1821 OUTPUT:
1822 RETVAL
1823
e2fe06dd
EB
1824BOOT:
1825 {
1826 HV* stash;
1827 SV** meth = NULL;
1828 CV* cv;
1829 stash = gv_stashpv("XS::APItest::TempLv", 0);
1830 if (stash)
1831 meth = hv_fetchs(stash, "make_temp_mg_lv", 0);
1832 if (!meth)
1833 croak("lost method 'make_temp_mg_lv'");
1834 cv = GvCV(*meth);
1835 CvLVALUE_on(cv);
1836 }
83f8bb56
Z
1837
1838BOOT:
1839{
1840 hintkey_rpn_sv = newSVpvs_share("XS::APItest/rpn");
1841 hintkey_calcrpn_sv = newSVpvs_share("XS::APItest/calcrpn");
1842 hintkey_stufftest_sv = newSVpvs_share("XS::APItest/stufftest");
1843 hintkey_swaptwostmts_sv = newSVpvs_share("XS::APItest/swaptwostmts");
07ffcb73 1844 hintkey_looprest_sv = newSVpvs_share("XS::APItest/looprest");
83f8bb56
Z
1845 next_keyword_plugin = PL_keyword_plugin;
1846 PL_keyword_plugin = my_keyword_plugin;
1847}