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