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