Commit | Line | Data |
---|---|---|
f2ab5a41 MHM |
1 | ################################################################################ |
2 | ## | |
b2049988 | 3 | ## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz. |
f2ab5a41 MHM |
4 | ## Version 2.x, Copyright (C) 2001, Paul Marquess. |
5 | ## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. | |
6 | ## | |
7 | ## This program is free software; you can redistribute it and/or | |
8 | ## modify it under the same terms as Perl itself. | |
9 | ## | |
10 | ################################################################################ | |
11 | ||
12 | =provides | |
13 | ||
14 | __UNDEFINED__ | |
15 | ||
16 | =implementation | |
17 | ||
18 | /* concatenating with "" ensures that only literal strings are accepted as argument | |
19 | * note that STR_WITH_LEN() can't be used as argument to macros or functions that | |
20 | * under some configurations might be macros | |
21 | */ | |
22 | ||
23 | __UNDEFINED__ STR_WITH_LEN(s) (s ""), (sizeof(s)-1) | |
24 | ||
25 | __UNDEFINED__ newSVpvs(str) newSVpvn(str "", sizeof(str) - 1) | |
c1a049cb | 26 | __UNDEFINED__ newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags) |
49ef49fe | 27 | __UNDEFINED__ newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0) |
f2ab5a41 MHM |
28 | __UNDEFINED__ sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1) |
29 | __UNDEFINED__ sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1) | |
c07deaaf MHM |
30 | __UNDEFINED__ hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) |
31 | __UNDEFINED__ hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0) | |
f2ab5a41 | 32 | |
8565c31a MHM |
33 | __UNDEFINED__ gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt) |
34 | __UNDEFINED__ gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags) | |
35 | ||
49ef49fe CBW |
36 | __UNDEFINED__ get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags) |
37 | ||
38 | =xsinit | |
39 | ||
40 | #define NEED_newSVpvn_share | |
41 | ||
f2ab5a41 MHM |
42 | =xsubs |
43 | ||
44 | void | |
45 | newSVpvs() | |
b2049988 MHM |
46 | PPCODE: |
47 | mXPUSHs(newSVpvs("newSVpvs")); | |
48 | XSRETURN(1); | |
c1a049cb MHM |
49 | |
50 | void | |
51 | newSVpvs_flags() | |
b2049988 MHM |
52 | PPCODE: |
53 | XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP)); | |
54 | XSRETURN(1); | |
f2ab5a41 | 55 | |
49ef49fe CBW |
56 | int |
57 | newSVpvs_share() | |
b2049988 MHM |
58 | PREINIT: |
59 | SV *sv; | |
60 | U32 hash; | |
61 | CODE: | |
62 | RETVAL = 0; | |
63 | PERL_HASH(hash, "pvs", 3); | |
64 | sv = newSVpvs_share("pvs"); | |
65 | RETVAL += strEQ(SvPV_nolen_const(sv), "pvs"); | |
66 | RETVAL += SvCUR(sv) == 3; | |
67 | RETVAL += SvSHARED_HASH(sv) == hash; | |
68 | SvREFCNT_dec(sv); | |
69 | OUTPUT: | |
70 | RETVAL | |
49ef49fe | 71 | |
f2ab5a41 MHM |
72 | void |
73 | sv_catpvs(sv) | |
b2049988 MHM |
74 | SV *sv |
75 | PPCODE: | |
76 | sv_catpvs(sv, "sv_catpvs"); | |
f2ab5a41 MHM |
77 | |
78 | void | |
79 | sv_setpvs(sv) | |
b2049988 MHM |
80 | SV *sv |
81 | PPCODE: | |
82 | sv_setpvs(sv, "sv_setpvs"); | |
f2ab5a41 MHM |
83 | |
84 | void | |
85 | hv_fetchs(hv) | |
b2049988 MHM |
86 | SV *hv |
87 | PREINIT: | |
88 | SV **s; | |
89 | PPCODE: | |
90 | s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0); | |
91 | XPUSHs(sv_mortalcopy(*s)); | |
92 | XSRETURN(1); | |
f2ab5a41 MHM |
93 | |
94 | void | |
95 | hv_stores(hv, sv) | |
b2049988 MHM |
96 | SV *hv |
97 | SV *sv | |
98 | PPCODE: | |
99 | (void) hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc_simple(sv)); | |
f2ab5a41 | 100 | |
8565c31a | 101 | SV* |
8565c31a | 102 | gv_fetchpvs() |
b2049988 MHM |
103 | CODE: |
104 | RETVAL = newRV_inc((SV*)gv_fetchpvs("Devel::PPPort::VERSION", 0, SVt_PV)); | |
105 | OUTPUT: | |
106 | RETVAL | |
8565c31a MHM |
107 | |
108 | SV* | |
109 | gv_stashpvs() | |
b2049988 MHM |
110 | CODE: |
111 | RETVAL = newRV_inc((SV*)gv_stashpvs("Devel::PPPort", 0)); | |
112 | OUTPUT: | |
113 | RETVAL | |
8565c31a | 114 | |
49ef49fe CBW |
115 | int |
116 | get_cvs() | |
b2049988 MHM |
117 | PREINIT: |
118 | CV* xv; | |
119 | CODE: | |
120 | RETVAL = 0; | |
121 | xv = get_cvs("Devel::PPPort::foobar", 0); | |
122 | if(xv == NULL) RETVAL++; | |
123 | xv = get_cvs("Devel::PPPort::foobar", GV_ADDMULTI); | |
124 | if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++; | |
125 | xv = get_cvs("Devel::PPPort::get_cvs", 0); | |
126 | if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++; | |
49ef49fe | 127 | OUTPUT: |
b2049988 | 128 | RETVAL |
8565c31a | 129 | |
49ef49fe CBW |
130 | |
131 | =tests plan => 12 | |
f2ab5a41 MHM |
132 | |
133 | my $x = 'foo'; | |
134 | ||
135 | ok(Devel::PPPort::newSVpvs(), "newSVpvs"); | |
c1a049cb | 136 | ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags"); |
49ef49fe | 137 | ok(Devel::PPPort::newSVpvs_share(), 3); |
f2ab5a41 MHM |
138 | |
139 | Devel::PPPort::sv_catpvs($x); | |
140 | ok($x, "foosv_catpvs"); | |
141 | ||
142 | Devel::PPPort::sv_setpvs($x); | |
143 | ok($x, "sv_setpvs"); | |
144 | ||
145 | my %h = ('hv_fetchs' => 42); | |
146 | Devel::PPPort::hv_stores(\%h, 4711); | |
147 | ok(scalar keys %h, 2); | |
148 | ok(exists $h{'hv_stores'}); | |
149 | ok($h{'hv_stores'}, 4711); | |
150 | ok(Devel::PPPort::hv_fetchs(\%h), 42); | |
49ef49fe CBW |
151 | ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION); |
152 | ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::); | |
153 | ||
154 | ok(Devel::PPPort::get_cvs(), 3); |