Commit | Line | Data |
adfe19db |
1 | ################################################################################ |
2 | ## |
f2ab5a41 |
3 | ## $Revision: 10 $ |
adfe19db |
4 | ## $Author: mhx $ |
f2ab5a41 |
5 | ## $Date: 2006/05/18 23:10:24 +0200 $ |
adfe19db |
6 | ## |
7 | ################################################################################ |
8 | ## |
0d0f8426 |
9 | ## Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz. |
adfe19db |
10 | ## Version 2.x, Copyright (C) 2001, Paul Marquess. |
11 | ## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. |
12 | ## |
13 | ## This program is free software; you can redistribute it and/or |
14 | ## modify it under the same terms as Perl itself. |
15 | ## |
16 | ################################################################################ |
17 | |
18 | =provides |
19 | |
20 | __UNDEFINED__ |
21 | /sv_\w+_mg/ |
22 | |
23 | =implementation |
24 | |
25 | __UNDEFINED__ SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END |
26 | |
27 | __UNDEFINED__ PERL_MAGIC_sv '\0' |
28 | __UNDEFINED__ PERL_MAGIC_overload 'A' |
29 | __UNDEFINED__ PERL_MAGIC_overload_elem 'a' |
30 | __UNDEFINED__ PERL_MAGIC_overload_table 'c' |
31 | __UNDEFINED__ PERL_MAGIC_bm 'B' |
32 | __UNDEFINED__ PERL_MAGIC_regdata 'D' |
33 | __UNDEFINED__ PERL_MAGIC_regdatum 'd' |
34 | __UNDEFINED__ PERL_MAGIC_env 'E' |
35 | __UNDEFINED__ PERL_MAGIC_envelem 'e' |
36 | __UNDEFINED__ PERL_MAGIC_fm 'f' |
37 | __UNDEFINED__ PERL_MAGIC_regex_global 'g' |
38 | __UNDEFINED__ PERL_MAGIC_isa 'I' |
39 | __UNDEFINED__ PERL_MAGIC_isaelem 'i' |
40 | __UNDEFINED__ PERL_MAGIC_nkeys 'k' |
41 | __UNDEFINED__ PERL_MAGIC_dbfile 'L' |
42 | __UNDEFINED__ PERL_MAGIC_dbline 'l' |
43 | __UNDEFINED__ PERL_MAGIC_mutex 'm' |
44 | __UNDEFINED__ PERL_MAGIC_shared 'N' |
45 | __UNDEFINED__ PERL_MAGIC_shared_scalar 'n' |
46 | __UNDEFINED__ PERL_MAGIC_collxfrm 'o' |
47 | __UNDEFINED__ PERL_MAGIC_tied 'P' |
48 | __UNDEFINED__ PERL_MAGIC_tiedelem 'p' |
49 | __UNDEFINED__ PERL_MAGIC_tiedscalar 'q' |
50 | __UNDEFINED__ PERL_MAGIC_qr 'r' |
51 | __UNDEFINED__ PERL_MAGIC_sig 'S' |
52 | __UNDEFINED__ PERL_MAGIC_sigelem 's' |
53 | __UNDEFINED__ PERL_MAGIC_taint 't' |
54 | __UNDEFINED__ PERL_MAGIC_uvar 'U' |
55 | __UNDEFINED__ PERL_MAGIC_uvar_elem 'u' |
56 | __UNDEFINED__ PERL_MAGIC_vstring 'V' |
57 | __UNDEFINED__ PERL_MAGIC_vec 'v' |
58 | __UNDEFINED__ PERL_MAGIC_utf8 'w' |
59 | __UNDEFINED__ PERL_MAGIC_substr 'x' |
60 | __UNDEFINED__ PERL_MAGIC_defelem 'y' |
61 | __UNDEFINED__ PERL_MAGIC_glob '*' |
62 | __UNDEFINED__ PERL_MAGIC_arylen '#' |
63 | __UNDEFINED__ PERL_MAGIC_pos '.' |
64 | __UNDEFINED__ PERL_MAGIC_backref '<' |
65 | __UNDEFINED__ PERL_MAGIC_ext '~' |
66 | |
67 | /* That's the best we can do... */ |
68 | __UNDEFINED__ SvPV_force_nomg SvPV_force |
69 | __UNDEFINED__ SvPV_nomg SvPV |
70 | __UNDEFINED__ sv_catpvn_nomg sv_catpvn |
71 | __UNDEFINED__ sv_catsv_nomg sv_catsv |
72 | __UNDEFINED__ sv_setsv_nomg sv_setsv |
73 | __UNDEFINED__ sv_pvn_nomg sv_pvn |
74 | __UNDEFINED__ SvIV_nomg SvIV |
75 | __UNDEFINED__ SvUV_nomg SvUV |
76 | |
77 | #ifndef sv_catpv_mg |
78 | # define sv_catpv_mg(sv, ptr) \ |
79 | STMT_START { \ |
80 | SV *TeMpSv = sv; \ |
81 | sv_catpv(TeMpSv,ptr); \ |
82 | SvSETMAGIC(TeMpSv); \ |
83 | } STMT_END |
84 | #endif |
85 | |
86 | #ifndef sv_catpvn_mg |
87 | # define sv_catpvn_mg(sv, ptr, len) \ |
88 | STMT_START { \ |
89 | SV *TeMpSv = sv; \ |
90 | sv_catpvn(TeMpSv,ptr,len); \ |
91 | SvSETMAGIC(TeMpSv); \ |
92 | } STMT_END |
93 | #endif |
94 | |
95 | #ifndef sv_catsv_mg |
96 | # define sv_catsv_mg(dsv, ssv) \ |
97 | STMT_START { \ |
98 | SV *TeMpSv = dsv; \ |
99 | sv_catsv(TeMpSv,ssv); \ |
100 | SvSETMAGIC(TeMpSv); \ |
101 | } STMT_END |
102 | #endif |
103 | |
104 | #ifndef sv_setiv_mg |
105 | # define sv_setiv_mg(sv, i) \ |
106 | STMT_START { \ |
107 | SV *TeMpSv = sv; \ |
108 | sv_setiv(TeMpSv,i); \ |
109 | SvSETMAGIC(TeMpSv); \ |
110 | } STMT_END |
111 | #endif |
112 | |
113 | #ifndef sv_setnv_mg |
114 | # define sv_setnv_mg(sv, num) \ |
115 | STMT_START { \ |
116 | SV *TeMpSv = sv; \ |
117 | sv_setnv(TeMpSv,num); \ |
118 | SvSETMAGIC(TeMpSv); \ |
119 | } STMT_END |
120 | #endif |
121 | |
122 | #ifndef sv_setpv_mg |
123 | # define sv_setpv_mg(sv, ptr) \ |
124 | STMT_START { \ |
125 | SV *TeMpSv = sv; \ |
126 | sv_setpv(TeMpSv,ptr); \ |
127 | SvSETMAGIC(TeMpSv); \ |
128 | } STMT_END |
129 | #endif |
130 | |
131 | #ifndef sv_setpvn_mg |
132 | # define sv_setpvn_mg(sv, ptr, len) \ |
133 | STMT_START { \ |
134 | SV *TeMpSv = sv; \ |
135 | sv_setpvn(TeMpSv,ptr,len); \ |
136 | SvSETMAGIC(TeMpSv); \ |
137 | } STMT_END |
138 | #endif |
139 | |
140 | #ifndef sv_setsv_mg |
141 | # define sv_setsv_mg(dsv, ssv) \ |
142 | STMT_START { \ |
143 | SV *TeMpSv = dsv; \ |
144 | sv_setsv(TeMpSv,ssv); \ |
145 | SvSETMAGIC(TeMpSv); \ |
146 | } STMT_END |
147 | #endif |
148 | |
149 | #ifndef sv_setuv_mg |
150 | # define sv_setuv_mg(sv, i) \ |
151 | STMT_START { \ |
152 | SV *TeMpSv = sv; \ |
153 | sv_setuv(TeMpSv,i); \ |
154 | SvSETMAGIC(TeMpSv); \ |
155 | } STMT_END |
156 | #endif |
157 | |
158 | #ifndef sv_usepvn_mg |
159 | # define sv_usepvn_mg(sv, ptr, len) \ |
160 | STMT_START { \ |
161 | SV *TeMpSv = sv; \ |
162 | sv_usepvn(TeMpSv,ptr,len); \ |
163 | SvSETMAGIC(TeMpSv); \ |
164 | } STMT_END |
165 | #endif |
166 | |
f2ab5a41 |
167 | __UNDEFINED__ SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL) |
168 | |
adfe19db |
169 | =xsubs |
170 | |
171 | void |
172 | sv_catpv_mg(sv, string) |
173 | SV *sv; |
174 | char *string; |
175 | CODE: |
176 | sv_catpv_mg(sv, string); |
177 | |
178 | void |
179 | sv_catpvn_mg(sv, sv2) |
180 | SV *sv; |
181 | SV *sv2; |
182 | PREINIT: |
183 | char *str; |
184 | STRLEN len; |
185 | CODE: |
186 | str = SvPV(sv2, len); |
187 | sv_catpvn_mg(sv, str, len); |
188 | |
189 | void |
190 | sv_catsv_mg(sv, sv2) |
191 | SV *sv; |
192 | SV *sv2; |
193 | CODE: |
194 | sv_catsv_mg(sv, sv2); |
195 | |
196 | void |
197 | sv_setiv_mg(sv, iv) |
198 | SV *sv; |
199 | IV iv; |
200 | CODE: |
201 | sv_setiv_mg(sv, iv); |
202 | |
203 | void |
204 | sv_setnv_mg(sv, nv) |
205 | SV *sv; |
206 | NV nv; |
207 | CODE: |
208 | sv_setnv_mg(sv, nv); |
209 | |
210 | void |
211 | sv_setpv_mg(sv, pv) |
212 | SV *sv; |
213 | char *pv; |
214 | CODE: |
215 | sv_setpv_mg(sv, pv); |
216 | |
217 | void |
218 | sv_setpvn_mg(sv, sv2) |
219 | SV *sv; |
220 | SV *sv2; |
221 | PREINIT: |
222 | char *str; |
223 | STRLEN len; |
224 | CODE: |
225 | str = SvPV(sv2, len); |
226 | sv_setpvn_mg(sv, str, len); |
227 | |
228 | void |
229 | sv_setsv_mg(sv, sv2) |
230 | SV *sv; |
231 | SV *sv2; |
232 | CODE: |
233 | sv_setsv_mg(sv, sv2); |
234 | |
235 | void |
236 | sv_setuv_mg(sv, uv) |
237 | SV *sv; |
238 | UV uv; |
239 | CODE: |
240 | sv_setuv_mg(sv, uv); |
241 | |
242 | void |
243 | sv_usepvn_mg(sv, sv2) |
244 | SV *sv; |
245 | SV *sv2; |
246 | PREINIT: |
247 | char *str, *copy; |
248 | STRLEN len; |
249 | CODE: |
250 | str = SvPV(sv2, len); |
251 | New(42, copy, len+1, char); |
252 | Copy(str, copy, len+1, char); |
253 | sv_usepvn_mg(sv, copy, len); |
254 | |
f2ab5a41 |
255 | int |
256 | SvVSTRING_mg(sv) |
257 | SV *sv; |
258 | CODE: |
259 | RETVAL = SvVSTRING_mg(sv) != NULL; |
260 | OUTPUT: |
261 | RETVAL |
262 | |
263 | =tests plan => 13 |
adfe19db |
264 | |
265 | use Tie::Hash; |
266 | my %h; |
267 | tie %h, 'Tie::StdHash'; |
268 | $h{foo} = 'foo'; |
269 | $h{bar} = ''; |
270 | |
271 | &Devel::PPPort::sv_catpv_mg($h{foo}, 'bar'); |
272 | ok($h{foo}, 'foobar'); |
273 | |
274 | &Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz'); |
275 | ok($h{bar}, 'baz'); |
276 | |
277 | &Devel::PPPort::sv_catsv_mg($h{foo}, '42'); |
278 | ok($h{foo}, 'foobar42'); |
279 | |
280 | &Devel::PPPort::sv_setiv_mg($h{bar}, 42); |
281 | ok($h{bar}, 42); |
282 | |
283 | &Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159); |
284 | ok(abs($h{PI} - 3.14159) < 0.01); |
285 | |
286 | &Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx'); |
287 | ok($h{mhx}, 'mhx'); |
288 | |
289 | &Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus'); |
290 | ok($h{mhx}, 'Marcus'); |
291 | |
292 | &Devel::PPPort::sv_setsv_mg($h{sv}, 'SV'); |
293 | ok($h{sv}, 'SV'); |
294 | |
295 | &Devel::PPPort::sv_setuv_mg($h{sv}, 4711); |
296 | ok($h{sv}, 4711); |
297 | |
298 | &Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl'); |
299 | ok($h{sv}, 'Perl'); |
300 | |
f2ab5a41 |
301 | my $ver = eval qq[qv("v1.2.0")]; |
302 | ok($[ < 5.009 || $@ eq ''); |
303 | ok($@ || Devel::PPPort::SvVSTRING_mg($ver)); |
304 | ok(!Devel::PPPort::SvVSTRING_mg(4711)); |
305 | |