Commit | Line | Data |
adfe19db |
1 | ################################################################################ |
2 | ## |
0d0f8426 |
3 | ## $Revision: 9 $ |
adfe19db |
4 | ## $Author: mhx $ |
0d0f8426 |
5 | ## $Date: 2006/01/14 18:08:03 +0100 $ |
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 | |
167 | =xsubs |
168 | |
169 | void |
170 | sv_catpv_mg(sv, string) |
171 | SV *sv; |
172 | char *string; |
173 | CODE: |
174 | sv_catpv_mg(sv, string); |
175 | |
176 | void |
177 | sv_catpvn_mg(sv, sv2) |
178 | SV *sv; |
179 | SV *sv2; |
180 | PREINIT: |
181 | char *str; |
182 | STRLEN len; |
183 | CODE: |
184 | str = SvPV(sv2, len); |
185 | sv_catpvn_mg(sv, str, len); |
186 | |
187 | void |
188 | sv_catsv_mg(sv, sv2) |
189 | SV *sv; |
190 | SV *sv2; |
191 | CODE: |
192 | sv_catsv_mg(sv, sv2); |
193 | |
194 | void |
195 | sv_setiv_mg(sv, iv) |
196 | SV *sv; |
197 | IV iv; |
198 | CODE: |
199 | sv_setiv_mg(sv, iv); |
200 | |
201 | void |
202 | sv_setnv_mg(sv, nv) |
203 | SV *sv; |
204 | NV nv; |
205 | CODE: |
206 | sv_setnv_mg(sv, nv); |
207 | |
208 | void |
209 | sv_setpv_mg(sv, pv) |
210 | SV *sv; |
211 | char *pv; |
212 | CODE: |
213 | sv_setpv_mg(sv, pv); |
214 | |
215 | void |
216 | sv_setpvn_mg(sv, sv2) |
217 | SV *sv; |
218 | SV *sv2; |
219 | PREINIT: |
220 | char *str; |
221 | STRLEN len; |
222 | CODE: |
223 | str = SvPV(sv2, len); |
224 | sv_setpvn_mg(sv, str, len); |
225 | |
226 | void |
227 | sv_setsv_mg(sv, sv2) |
228 | SV *sv; |
229 | SV *sv2; |
230 | CODE: |
231 | sv_setsv_mg(sv, sv2); |
232 | |
233 | void |
234 | sv_setuv_mg(sv, uv) |
235 | SV *sv; |
236 | UV uv; |
237 | CODE: |
238 | sv_setuv_mg(sv, uv); |
239 | |
240 | void |
241 | sv_usepvn_mg(sv, sv2) |
242 | SV *sv; |
243 | SV *sv2; |
244 | PREINIT: |
245 | char *str, *copy; |
246 | STRLEN len; |
247 | CODE: |
248 | str = SvPV(sv2, len); |
249 | New(42, copy, len+1, char); |
250 | Copy(str, copy, len+1, char); |
251 | sv_usepvn_mg(sv, copy, len); |
252 | |
253 | =tests plan => 10 |
254 | |
255 | use Tie::Hash; |
256 | my %h; |
257 | tie %h, 'Tie::StdHash'; |
258 | $h{foo} = 'foo'; |
259 | $h{bar} = ''; |
260 | |
261 | &Devel::PPPort::sv_catpv_mg($h{foo}, 'bar'); |
262 | ok($h{foo}, 'foobar'); |
263 | |
264 | &Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz'); |
265 | ok($h{bar}, 'baz'); |
266 | |
267 | &Devel::PPPort::sv_catsv_mg($h{foo}, '42'); |
268 | ok($h{foo}, 'foobar42'); |
269 | |
270 | &Devel::PPPort::sv_setiv_mg($h{bar}, 42); |
271 | ok($h{bar}, 42); |
272 | |
273 | &Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159); |
274 | ok(abs($h{PI} - 3.14159) < 0.01); |
275 | |
276 | &Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx'); |
277 | ok($h{mhx}, 'mhx'); |
278 | |
279 | &Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus'); |
280 | ok($h{mhx}, 'Marcus'); |
281 | |
282 | &Devel::PPPort::sv_setsv_mg($h{sv}, 'SV'); |
283 | ok($h{sv}, 'SV'); |
284 | |
285 | &Devel::PPPort::sv_setuv_mg($h{sv}, 4711); |
286 | ok($h{sv}, 4711); |
287 | |
288 | &Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl'); |
289 | ok($h{sv}, 'Perl'); |
290 | |