Upgrade to Devel::PPPort 3.07
[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / PPPort.xs
CommitLineData
adfe19db 1/*******************************************************************************
2*
3* !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
4*
5********************************************************************************
6*
7* Perl/Pollution/Portability
8*
9********************************************************************************
10*
0d0f8426 11* $Revision: 9 $
adfe19db 12* $Author: mhx $
0d0f8426 13* $Date: 2006/01/14 18:07:55 +0100 $
adfe19db 14*
15********************************************************************************
16*
0d0f8426 17* Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
adfe19db 18* Version 2.x, Copyright (C) 2001, Paul Marquess.
19* Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
20*
21* This program is free software; you can redistribute it and/or
22* modify it under the same terms as Perl itself.
23*
24*******************************************************************************/
25
26/* ========== BEGIN XSHEAD ================================================== */
27
28
29
30/* =========== END XSHEAD =================================================== */
0a7c7f4f 31
32#include "EXTERN.h"
33#include "perl.h"
34#include "XSUB.h"
35
adfe19db 36/* ========== BEGIN XSINIT ================================================== */
37
38/* ---- from parts/inc/call ---- */
39#define NEED_eval_pv
40
41/* ---- from parts/inc/grok ---- */
42#define NEED_grok_number
43#define NEED_grok_numeric_radix
44#define NEED_grok_bin
45#define NEED_grok_hex
46#define NEED_grok_oct
47
48/* ---- from parts/inc/newCONSTSUB ---- */
0a7c7f4f 49#define NEED_newCONSTSUB
adfe19db 50
51/* ---- from parts/inc/newRV ---- */
52#define NEED_newRV_noinc
53
96ad942f 54/* ---- from parts/inc/sv_xpvf ---- */
55#define NEED_vnewSVpvf
56#define NEED_sv_catpvf_mg
57#define NEED_sv_catpvf_mg_nocontext
58#define NEED_sv_setpvf_mg
59#define NEED_sv_setpvf_mg_nocontext
60
adfe19db 61/* ---- from parts/inc/SvPV ---- */
62#define NEED_sv_2pv_nolen
63#define NEED_sv_2pvbyte
64
0d0f8426 65/* ---- from parts/inc/variables ---- */
66#define NEED_PL_signals
67
adfe19db 68/* =========== END XSINIT =================================================== */
69
0a7c7f4f 70#include "ppport.h"
71
adfe19db 72/* ========== BEGIN XSMISC ================================================== */
73
9132e1a3 74/* ---- from parts/inc/exception ---- */
2dd69576 75/* defined in module3.c */
76int exception(int throw_e);
9132e1a3 77
78/* ---- from parts/inc/misc ---- */
79XS(XS_Devel__PPPort_dXSTARG); /* prototype */
80XS(XS_Devel__PPPort_dXSTARG)
81{
82 dXSARGS;
83 dXSTARG;
f8952f9c 84 IV iv;
9132e1a3 85 SP -= items;
f8952f9c 86 iv = SvIV(ST(0)) + 1;
9132e1a3 87 PUSHi(iv);
88 XSRETURN(1);
89}
90
0d0f8426 91XS(XS_Devel__PPPort_dAXMARK); /* prototype */
92XS(XS_Devel__PPPort_dAXMARK)
93{
94 dSP;
95 dAXMARK;
96 dITEMS;
97 IV iv;
98 SP -= items;
99 iv = SvIV(ST(0)) - 1;
100 PUSHs(sv_2mortal(newSViv(iv)));
101 XSRETURN(1);
102}
103
adfe19db 104/* ---- from parts/inc/MY_CXT ---- */
44284200 105#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION
4a582685 106
0a7c7f4f 107typedef struct {
adfe19db 108 /* Put Global Data in here */
4a582685 109 int dummy;
0a7c7f4f 110} my_cxt_t;
4a582685 111
112START_MY_CXT
0a7c7f4f 113
adfe19db 114/* ---- from parts/inc/newCONSTSUB ---- */
115void call_newCONSTSUB_1(void)
0a7c7f4f 116{
adfe19db 117#ifdef PERL_NO_GET_CONTEXT
118 dTHX;
119#endif
44284200 120 newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
0a7c7f4f 121}
122
adfe19db 123extern void call_newCONSTSUB_2(void);
124extern void call_newCONSTSUB_3(void);
125
96ad942f 126/* ---- from parts/inc/sv_xpvf ---- */
127static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
128{
129 SV *sv;
130 va_list args;
131 va_start(args, pat);
132#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
133 sv = vnewSVpvf(pat, &args);
134#else
135 sv = newSVpv(pat, 0);
136#endif
137 va_end(args);
138 return sv;
139}
140
141static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
142{
143 va_list args;
144 va_start(args, pat);
145#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
146 sv_vcatpvf(sv, pat, &args);
147#else
148 sv_catpv(sv, pat);
149#endif
150 va_end(args);
151}
152
153static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
154{
155 va_list args;
156 va_start(args, pat);
157#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
158 sv_vsetpvf(sv, pat, &args);
159#else
160 sv_setpv(sv, pat);
161#endif
162 va_end(args);
163}
164
0d0f8426 165/* ---- from parts/inc/variables ---- */
166U32 get_PL_signals_1(void)
167{
168 return PL_signals;
169}
170
171extern U32 get_PL_signals_2(void);
172extern U32 get_PL_signals_3(void);
173
adfe19db 174/* =========== END XSMISC =================================================== */
0a7c7f4f 175
44284200 176MODULE = Devel::PPPort PACKAGE = Devel::PPPort
0a7c7f4f 177
178BOOT:
9132e1a3 179 /* ---- from parts/inc/misc ---- */
180 newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file);
0d0f8426 181 newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file);
9132e1a3 182
adfe19db 183 /* ---- from parts/inc/MY_CXT ---- */
184 {
185 MY_CXT_INIT;
186 /* If any of the fields in the my_cxt_t struct need
187 * to be initialised, do it here.
188 */
189 MY_CXT.dummy = 42;
190 }
191
192
193##----------------------------------------------------------------------
194## XSUBs from parts/inc/call
195##----------------------------------------------------------------------
196
197I32
198G_SCALAR()
199 CODE:
200 RETVAL = G_SCALAR;
201 OUTPUT:
202 RETVAL
203
204I32
205G_ARRAY()
206 CODE:
207 RETVAL = G_ARRAY;
208 OUTPUT:
209 RETVAL
210
211I32
212G_DISCARD()
213 CODE:
214 RETVAL = G_DISCARD;
215 OUTPUT:
216 RETVAL
217
218void
219eval_sv(sv, flags)
220 SV* sv
221 I32 flags
222 PREINIT:
223 I32 i;
224 PPCODE:
225 PUTBACK;
226 i = eval_sv(sv, flags);
227 SPAGAIN;
228 EXTEND(SP, 1);
229 PUSHs(sv_2mortal(newSViv(i)));
230
231void
232eval_pv(p, croak_on_error)
233 char* p
234 I32 croak_on_error
235 PPCODE:
236 PUTBACK;
237 EXTEND(SP, 1);
238 PUSHs(eval_pv(p, croak_on_error));
239
240void
241call_sv(sv, flags, ...)
242 SV* sv
243 I32 flags
244 PREINIT:
245 I32 i;
246 PPCODE:
247 for (i=0; i<items-2; i++)
248 ST(i) = ST(i+2); /* pop first two args */
249 PUSHMARK(SP);
250 SP += items - 2;
251 PUTBACK;
252 i = call_sv(sv, flags);
253 SPAGAIN;
254 EXTEND(SP, 1);
255 PUSHs(sv_2mortal(newSViv(i)));
256
0a7c7f4f 257void
adfe19db 258call_pv(subname, flags, ...)
259 char* subname
260 I32 flags
261 PREINIT:
262 I32 i;
263 PPCODE:
264 for (i=0; i<items-2; i++)
265 ST(i) = ST(i+2); /* pop first two args */
266 PUSHMARK(SP);
267 SP += items - 2;
268 PUTBACK;
269 i = call_pv(subname, flags);
270 SPAGAIN;
271 EXTEND(SP, 1);
272 PUSHs(sv_2mortal(newSViv(i)));
0a7c7f4f 273
274void
adfe19db 275call_argv(subname, flags, ...)
276 char* subname
277 I32 flags
278 PREINIT:
279 I32 i;
280 char *args[8];
281 PPCODE:
282 if (items > 8) /* play safe */
283 XSRETURN_UNDEF;
284 for (i=2; i<items; i++)
285 args[i-2] = SvPV_nolen(ST(i));
286 args[items-2] = NULL;
287 PUTBACK;
288 i = call_argv(subname, flags, args);
289 SPAGAIN;
290 EXTEND(SP, 1);
291 PUSHs(sv_2mortal(newSViv(i)));
0a7c7f4f 292
293void
adfe19db 294call_method(methname, flags, ...)
295 char* methname
296 I32 flags
297 PREINIT:
298 I32 i;
299 PPCODE:
300 for (i=0; i<items-2; i++)
301 ST(i) = ST(i+2); /* pop first two args */
302 PUSHMARK(SP);
303 SP += items - 2;
304 PUTBACK;
305 i = call_method(methname, flags);
306 SPAGAIN;
307 EXTEND(SP, 1);
308 PUSHs(sv_2mortal(newSViv(i)));
309
310##----------------------------------------------------------------------
311## XSUBs from parts/inc/cop
312##----------------------------------------------------------------------
313
314char *
315CopSTASHPV()
316 CODE:
317 RETVAL = CopSTASHPV(PL_curcop);
318 OUTPUT:
319 RETVAL
320
321char *
322CopFILE()
323 CODE:
324 RETVAL = CopFILE(PL_curcop);
325 OUTPUT:
326 RETVAL
327
328##----------------------------------------------------------------------
9132e1a3 329## XSUBs from parts/inc/exception
330##----------------------------------------------------------------------
331
332int
333exception(throw_e)
334 int throw_e
335 OUTPUT:
336 RETVAL
337
338##----------------------------------------------------------------------
adfe19db 339## XSUBs from parts/inc/grok
340##----------------------------------------------------------------------
341
342UV
343grok_number(string)
344 SV *string
345 PREINIT:
346 const char *pv;
347 STRLEN len;
348 CODE:
349 pv = SvPV(string, len);
350 if (!grok_number(pv, len, &RETVAL))
351 XSRETURN_UNDEF;
352 OUTPUT:
353 RETVAL
354
355UV
356grok_bin(string)
357 SV *string
358 PREINIT:
359 char *pv;
360 I32 flags;
361 STRLEN len;
362 CODE:
363 pv = SvPV(string, len);
364 RETVAL = grok_bin(pv, &len, &flags, NULL);
365 OUTPUT:
366 RETVAL
367
368UV
369grok_hex(string)
370 SV *string
371 PREINIT:
372 char *pv;
373 I32 flags;
374 STRLEN len;
375 CODE:
376 pv = SvPV(string, len);
377 RETVAL = grok_hex(pv, &len, &flags, NULL);
378 OUTPUT:
379 RETVAL
380
381UV
382grok_oct(string)
383 SV *string
384 PREINIT:
385 char *pv;
386 I32 flags;
387 STRLEN len;
388 CODE:
389 pv = SvPV(string, len);
390 RETVAL = grok_oct(pv, &len, &flags, NULL);
391 OUTPUT:
392 RETVAL
393
394UV
395Perl_grok_number(string)
396 SV *string
397 PREINIT:
398 const char *pv;
399 STRLEN len;
400 CODE:
401 pv = SvPV(string, len);
402 if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
403 XSRETURN_UNDEF;
404 OUTPUT:
405 RETVAL
406
407UV
408Perl_grok_bin(string)
409 SV *string
410 PREINIT:
411 char *pv;
412 I32 flags;
413 STRLEN len;
414 CODE:
415 pv = SvPV(string, len);
416 RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
417 OUTPUT:
418 RETVAL
419
420UV
421Perl_grok_hex(string)
422 SV *string
423 PREINIT:
424 char *pv;
425 I32 flags;
426 STRLEN len;
427 CODE:
428 pv = SvPV(string, len);
429 RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
430 OUTPUT:
431 RETVAL
432
433UV
434Perl_grok_oct(string)
435 SV *string
436 PREINIT:
437 char *pv;
438 I32 flags;
439 STRLEN len;
440 CODE:
441 pv = SvPV(string, len);
442 RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
443 OUTPUT:
444 RETVAL
445
446##----------------------------------------------------------------------
447## XSUBs from parts/inc/limits
448##----------------------------------------------------------------------
449
450IV
451iv_size()
452 CODE:
453 RETVAL = IVSIZE == sizeof(IV);
454 OUTPUT:
455 RETVAL
456
457IV
458uv_size()
459 CODE:
460 RETVAL = UVSIZE == sizeof(UV);
461 OUTPUT:
462 RETVAL
463
464IV
465iv_type()
466 CODE:
467 RETVAL = sizeof(IVTYPE) == sizeof(IV);
468 OUTPUT:
469 RETVAL
470
471IV
472uv_type()
473 CODE:
474 RETVAL = sizeof(UVTYPE) == sizeof(UV);
475 OUTPUT:
476 RETVAL
477
478##----------------------------------------------------------------------
479## XSUBs from parts/inc/magic
480##----------------------------------------------------------------------
481
482void
483sv_catpv_mg(sv, string)
484 SV *sv;
485 char *string;
486 CODE:
487 sv_catpv_mg(sv, string);
488
489void
490sv_catpvn_mg(sv, sv2)
491 SV *sv;
492 SV *sv2;
493 PREINIT:
494 char *str;
495 STRLEN len;
496 CODE:
497 str = SvPV(sv2, len);
498 sv_catpvn_mg(sv, str, len);
499
500void
501sv_catsv_mg(sv, sv2)
502 SV *sv;
503 SV *sv2;
504 CODE:
505 sv_catsv_mg(sv, sv2);
506
507void
508sv_setiv_mg(sv, iv)
509 SV *sv;
510 IV iv;
511 CODE:
512 sv_setiv_mg(sv, iv);
513
514void
515sv_setnv_mg(sv, nv)
516 SV *sv;
517 NV nv;
518 CODE:
519 sv_setnv_mg(sv, nv);
520
521void
522sv_setpv_mg(sv, pv)
523 SV *sv;
524 char *pv;
525 CODE:
526 sv_setpv_mg(sv, pv);
527
528void
529sv_setpvn_mg(sv, sv2)
530 SV *sv;
531 SV *sv2;
532 PREINIT:
533 char *str;
534 STRLEN len;
535 CODE:
536 str = SvPV(sv2, len);
537 sv_setpvn_mg(sv, str, len);
538
539void
540sv_setsv_mg(sv, sv2)
541 SV *sv;
542 SV *sv2;
543 CODE:
544 sv_setsv_mg(sv, sv2);
545
546void
547sv_setuv_mg(sv, uv)
548 SV *sv;
549 UV uv;
550 CODE:
551 sv_setuv_mg(sv, uv);
552
553void
554sv_usepvn_mg(sv, sv2)
555 SV *sv;
556 SV *sv2;
557 PREINIT:
558 char *str, *copy;
559 STRLEN len;
560 CODE:
561 str = SvPV(sv2, len);
562 New(42, copy, len+1, char);
563 Copy(str, copy, len+1, char);
564 sv_usepvn_mg(sv, copy, len);
565
566##----------------------------------------------------------------------
0d0f8426 567## XSUBs from parts/inc/memory
568##----------------------------------------------------------------------
569
570int
571checkmem()
572 PREINIT:
573 char *p;
574
575 CODE:
576 RETVAL = 0;
577 Newx(p, 6, char);
578 CopyD("Hello", p, 6, char);
579 if (memEQ(p, "Hello", 6))
580 RETVAL++;
581 ZeroD(p, 6, char);
582 if (memEQ(p, "\0\0\0\0\0\0", 6))
583 RETVAL++;
584 Poison(p, 6, char);
585 if (memNE(p, "\0\0\0\0\0\0", 6))
586 RETVAL++;
587 Safefree(p);
588
589 Newxz(p, 6, char);
590 if (memEQ(p, "\0\0\0\0\0\0", 6))
591 RETVAL++;
592 Safefree(p);
593
594 Newxc(p, 3, short, char);
595 Safefree(p);
596
597 OUTPUT:
598 RETVAL
599
600##----------------------------------------------------------------------
adfe19db 601## XSUBs from parts/inc/misc
602##----------------------------------------------------------------------
0a7c7f4f 603
604int
adfe19db 605gv_stashpvn(name, create)
606 char *name
607 I32 create
0a7c7f4f 608 CODE:
adfe19db 609 RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
0a7c7f4f 610 OUTPUT:
adfe19db 611 RETVAL
0a7c7f4f 612
613int
adfe19db 614get_sv(name, create)
615 char *name
616 I32 create
0a7c7f4f 617 CODE:
adfe19db 618 RETVAL = get_sv(name, create) != NULL;
619 OUTPUT:
620 RETVAL
621
622int
623get_av(name, create)
624 char *name
625 I32 create
626 CODE:
627 RETVAL = get_av(name, create) != NULL;
628 OUTPUT:
629 RETVAL
630
631int
632get_hv(name, create)
633 char *name
634 I32 create
635 CODE:
636 RETVAL = get_hv(name, create) != NULL;
637 OUTPUT:
638 RETVAL
639
640int
641get_cv(name, create)
642 char *name
643 I32 create
644 CODE:
645 RETVAL = get_cv(name, create) != NULL;
0a7c7f4f 646 OUTPUT:
adfe19db 647 RETVAL
648
649void
650newSVpvn()
651 PPCODE:
652 XPUSHs(newSVpvn("test", 4));
653 XPUSHs(newSVpvn("test", 2));
654 XPUSHs(newSVpvn("test", 0));
655 XPUSHs(newSVpvn(NULL, 2));
656 XPUSHs(newSVpvn(NULL, 0));
657 XSRETURN(5);
0a7c7f4f 658
0d0f8426 659void
660xsreturn(two)
661 int two
662 PPCODE:
663 XPUSHs(newSVpvn("test1", 5));
664 if (two)
665 XPUSHs(newSVpvn("test2", 5));
666 if (two)
667 XSRETURN(2);
668 else
669 XSRETURN(1);
670
0a7c7f4f 671SV *
adfe19db 672PL_sv_undef()
0a7c7f4f 673 CODE:
adfe19db 674 RETVAL = newSVsv(&PL_sv_undef);
0a7c7f4f 675 OUTPUT:
adfe19db 676 RETVAL
0a7c7f4f 677
678SV *
adfe19db 679PL_sv_yes()
0a7c7f4f 680 CODE:
adfe19db 681 RETVAL = newSVsv(&PL_sv_yes);
0a7c7f4f 682 OUTPUT:
adfe19db 683 RETVAL
0a7c7f4f 684
685SV *
adfe19db 686PL_sv_no()
0a7c7f4f 687 CODE:
adfe19db 688 RETVAL = newSVsv(&PL_sv_no);
0a7c7f4f 689 OUTPUT:
adfe19db 690 RETVAL
0a7c7f4f 691
692int
adfe19db 693PL_na(string)
694 char *string
0a7c7f4f 695 CODE:
0a7c7f4f 696 PL_na = strlen(string);
697 RETVAL = PL_na;
0a7c7f4f 698 OUTPUT:
adfe19db 699 RETVAL
0a7c7f4f 700
701SV*
adfe19db 702boolSV(value)
0a7c7f4f 703 int value
704 CODE:
adfe19db 705 RETVAL = newSVsv(boolSV(value));
0a7c7f4f 706 OUTPUT:
adfe19db 707 RETVAL
0a7c7f4f 708
709SV*
adfe19db 710DEFSV()
0a7c7f4f 711 CODE:
0a7c7f4f 712 RETVAL = newSVsv(DEFSV);
0a7c7f4f 713 OUTPUT:
adfe19db 714 RETVAL
0a7c7f4f 715
716int
adfe19db 717ERRSV()
0a7c7f4f 718 CODE:
0a7c7f4f 719 RETVAL = SvTRUE(ERRSV);
0a7c7f4f 720 OUTPUT:
adfe19db 721 RETVAL
722
723SV*
724UNDERBAR()
725 CODE:
726 {
727 dUNDERBAR;
728 RETVAL = newSVsv(UNDERBAR);
729 }
730 OUTPUT:
731 RETVAL
732
0d0f8426 733void
734prepush()
735 CODE:
736 {
737 dXSTARG;
738 XSprePUSH;
739 PUSHi(42);
740 XSRETURN(1);
741 }
742
adfe19db 743##----------------------------------------------------------------------
744## XSUBs from parts/inc/mPUSH
745##----------------------------------------------------------------------
746
747void
748mPUSHp()
749 PPCODE:
750 EXTEND(SP, 3);
751 mPUSHp("one", 3);
752 mPUSHp("two", 3);
753 mPUSHp("three", 5);
754 XSRETURN(3);
755
756void
757mPUSHn()
758 PPCODE:
759 EXTEND(SP, 3);
760 mPUSHn(0.5);
761 mPUSHn(-0.25);
762 mPUSHn(0.125);
763 XSRETURN(3);
764
765void
766mPUSHi()
767 PPCODE:
768 EXTEND(SP, 3);
769 mPUSHi(-1);
770 mPUSHi(2);
771 mPUSHi(-3);
772 XSRETURN(3);
773
774void
775mPUSHu()
776 PPCODE:
777 EXTEND(SP, 3);
778 mPUSHu(1);
779 mPUSHu(2);
780 mPUSHu(3);
781 XSRETURN(3);
782
783void
784mXPUSHp()
785 PPCODE:
786 mXPUSHp("one", 3);
787 mXPUSHp("two", 3);
788 mXPUSHp("three", 5);
789 XSRETURN(3);
790
791void
792mXPUSHn()
793 PPCODE:
794 mXPUSHn(0.5);
795 mXPUSHn(-0.25);
796 mXPUSHn(0.125);
797 XSRETURN(3);
798
799void
800mXPUSHi()
801 PPCODE:
802 mXPUSHi(-1);
803 mXPUSHi(2);
804 mXPUSHi(-3);
805 XSRETURN(3);
806
807void
808mXPUSHu()
809 PPCODE:
810 mXPUSHu(1);
811 mXPUSHu(2);
812 mXPUSHu(3);
813 XSRETURN(3);
814
815##----------------------------------------------------------------------
816## XSUBs from parts/inc/MY_CXT
817##----------------------------------------------------------------------
0a7c7f4f 818
819int
adfe19db 820MY_CXT_1()
0a7c7f4f 821 CODE:
0a7c7f4f 822 dMY_CXT;
adfe19db 823 RETVAL = MY_CXT.dummy == 42;
824 ++MY_CXT.dummy;
0a7c7f4f 825 OUTPUT:
adfe19db 826 RETVAL
0a7c7f4f 827
828int
adfe19db 829MY_CXT_2()
0a7c7f4f 830 CODE:
0a7c7f4f 831 dMY_CXT;
adfe19db 832 RETVAL = MY_CXT.dummy == 43;
833 OUTPUT:
834 RETVAL
835
e4c28a9f 836int
837MY_CXT_CLONE()
838 CODE:
839 MY_CXT_CLONE;
840 RETVAL = 42;
841 OUTPUT:
842 RETVAL
843
adfe19db 844##----------------------------------------------------------------------
845## XSUBs from parts/inc/newCONSTSUB
846##----------------------------------------------------------------------
847
848void
849call_newCONSTSUB_1()
850
851void
852call_newCONSTSUB_2()
853
854void
855call_newCONSTSUB_3()
856
857##----------------------------------------------------------------------
858## XSUBs from parts/inc/newRV
859##----------------------------------------------------------------------
860
861U32
862newRV_inc_REFCNT()
863 PREINIT:
864 SV *sv, *rv;
865 CODE:
866 sv = newSViv(42);
867 rv = newRV_inc(sv);
868 SvREFCNT_dec(sv);
869 RETVAL = SvREFCNT(sv);
870 sv_2mortal(rv);
0a7c7f4f 871 OUTPUT:
adfe19db 872 RETVAL
0a7c7f4f 873
adfe19db 874U32
875newRV_noinc_REFCNT()
876 PREINIT:
877 SV *sv, *rv;
878 CODE:
879 sv = newSViv(42);
880 rv = newRV_noinc(sv);
881 RETVAL = SvREFCNT(sv);
882 sv_2mortal(rv);
883 OUTPUT:
884 RETVAL
885
886##----------------------------------------------------------------------
0d0f8426 887## XSUBs from parts/inc/Sv_set
888##----------------------------------------------------------------------
889
890IV
891TestSvUV_set(sv, val)
892 SV *sv
893 UV val
894 CODE:
895 SvUV_set(sv, val);
896 RETVAL = SvUVX(sv) == val ? 42 : -1;
897 OUTPUT:
898 RETVAL
899
900IV
901TestSvPVX_const(sv)
902 SV *sv
903 CODE:
904 RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1;
905 OUTPUT:
906 RETVAL
907
908IV
909TestSvPVX_mutable(sv)
910 SV *sv
911 CODE:
912 RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1;
913 OUTPUT:
914 RETVAL
915
916##----------------------------------------------------------------------
96ad942f 917## XSUBs from parts/inc/sv_xpvf
918##----------------------------------------------------------------------
919
920SV *
921vnewSVpvf()
922 CODE:
923 RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
924 OUTPUT:
925 RETVAL
926
927SV *
928sv_vcatpvf(sv)
929 SV *sv
930 CODE:
931 RETVAL = newSVsv(sv);
932 test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
933 OUTPUT:
934 RETVAL
935
936SV *
937sv_vsetpvf(sv)
938 SV *sv
939 CODE:
940 RETVAL = newSVsv(sv);
941 test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
942 OUTPUT:
943 RETVAL
944
945void
946sv_catpvf_mg(sv)
947 SV *sv
948 CODE:
949#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
950 sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
951#endif
952
953void
954Perl_sv_catpvf_mg(sv)
955 SV *sv
956 CODE:
957#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
958 Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
959#endif
960
961void
962sv_catpvf_mg_nocontext(sv)
963 SV *sv
964 CODE:
965#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
966#ifdef PERL_IMPLICIT_CONTEXT
967 sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
968#else
969 sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
970#endif
971#endif
972
973void
974sv_setpvf_mg(sv)
975 SV *sv
976 CODE:
977#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
978 sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
979#endif
980
981void
982Perl_sv_setpvf_mg(sv)
983 SV *sv
984 CODE:
985#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
986 Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
987#endif
988
989void
990sv_setpvf_mg_nocontext(sv)
991 SV *sv
992 CODE:
993#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
994#ifdef PERL_IMPLICIT_CONTEXT
995 sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
996#else
997 sv_setpvf_mg(sv, "%s-%d", "bar", 44);
998#endif
999#endif
1000
1001##----------------------------------------------------------------------
adfe19db 1002## XSUBs from parts/inc/SvPV
1003##----------------------------------------------------------------------
1004
1005IV
1006SvPVbyte(sv)
1007 SV *sv
1008 PREINIT:
1009 STRLEN len;
1010 const char *str;
1011 CODE:
1012 str = SvPVbyte(sv, len);
0d0f8426 1013 RETVAL = strEQ(str, "mhx") ? (IV) len : (IV) -1;
adfe19db 1014 OUTPUT:
1015 RETVAL
1016
1017IV
1018SvPV_nolen(sv)
1019 SV *sv
1020 PREINIT:
1021 const char *str;
1022 CODE:
1023 str = SvPV_nolen(sv);
9132e1a3 1024 RETVAL = strEQ(str, "mhx") ? 42 : 0;
adfe19db 1025 OUTPUT:
1026 RETVAL
1027
1028##----------------------------------------------------------------------
1029## XSUBs from parts/inc/threads
1030##----------------------------------------------------------------------
1031
1032IV
1033no_THX_arg(sv)
1034 SV *sv
1035 CODE:
1036 RETVAL = 1 + sv_2iv(sv);
1037 OUTPUT:
1038 RETVAL
1039
1040void
1041with_THX_arg(error)
1042 char *error
1043 PPCODE:
1044 Perl_croak(aTHX_ "%s", error);
1045
1046##----------------------------------------------------------------------
1047## XSUBs from parts/inc/uv
1048##----------------------------------------------------------------------
1049
1050SV *
1051sv_setuv(uv)
1052 UV uv
1053 CODE:
1054 RETVAL = newSViv(1);
1055 sv_setuv(RETVAL, uv);
1056 OUTPUT:
1057 RETVAL
1058
1059SV *
1060newSVuv(uv)
1061 UV uv
1062 CODE:
1063 RETVAL = newSVuv(uv);
1064 OUTPUT:
1065 RETVAL
1066
1067UV
1068sv_2uv(sv)
1069 SV *sv
1070 CODE:
1071 RETVAL = sv_2uv(sv);
1072 OUTPUT:
1073 RETVAL
1074
1075UV
1076SvUVx(sv)
1077 SV *sv
1078 CODE:
1079 sv--;
1080 RETVAL = SvUVx(++sv);
1081 OUTPUT:
1082 RETVAL
1083
1084void
1085XSRETURN_UV()
1086 PPCODE:
1087 XSRETURN_UV(42);
96ad942f 1088
1089void
1090PUSHu()
1091 PREINIT:
1092 dTARG;
1093 PPCODE:
1094 TARG = sv_newmortal();
1095 EXTEND(SP, 1);
1096 PUSHu(42);
1097 XSRETURN(1);
1098
1099void
1100XPUSHu()
1101 PREINIT:
1102 dTARG;
1103 PPCODE:
1104 TARG = sv_newmortal();
1105 XPUSHu(43);
1106 XSRETURN(1);
0d0f8426 1107
1108##----------------------------------------------------------------------
1109## XSUBs from parts/inc/variables
1110##----------------------------------------------------------------------
1111
1112int
1113compare_PL_signals()
1114 CODE:
1115 {
1116 U32 ref = get_PL_signals_1();
1117 RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3();
1118 }
1119 OUTPUT:
1120 RETVAL