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 / parts / inc / magic
CommitLineData
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
171void
172sv_catpv_mg(sv, string)
173 SV *sv;
174 char *string;
175 CODE:
176 sv_catpv_mg(sv, string);
177
178void
179sv_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
189void
190sv_catsv_mg(sv, sv2)
191 SV *sv;
192 SV *sv2;
193 CODE:
194 sv_catsv_mg(sv, sv2);
195
196void
197sv_setiv_mg(sv, iv)
198 SV *sv;
199 IV iv;
200 CODE:
201 sv_setiv_mg(sv, iv);
202
203void
204sv_setnv_mg(sv, nv)
205 SV *sv;
206 NV nv;
207 CODE:
208 sv_setnv_mg(sv, nv);
209
210void
211sv_setpv_mg(sv, pv)
212 SV *sv;
213 char *pv;
214 CODE:
215 sv_setpv_mg(sv, pv);
216
217void
218sv_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
228void
229sv_setsv_mg(sv, sv2)
230 SV *sv;
231 SV *sv2;
232 CODE:
233 sv_setsv_mg(sv, sv2);
234
235void
236sv_setuv_mg(sv, uv)
237 SV *sv;
238 UV uv;
239 CODE:
240 sv_setuv_mg(sv, uv);
241
242void
243sv_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 255int
256SvVSTRING_mg(sv)
257 SV *sv;
258 CODE:
259 RETVAL = SvVSTRING_mg(sv) != NULL;
260 OUTPUT:
261 RETVAL
262
263=tests plan => 13
adfe19db 264
265use Tie::Hash;
266my %h;
267tie %h, 'Tie::StdHash';
268$h{foo} = 'foo';
269$h{bar} = '';
270
271&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar');
272ok($h{foo}, 'foobar');
273
274&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz');
275ok($h{bar}, 'baz');
276
277&Devel::PPPort::sv_catsv_mg($h{foo}, '42');
278ok($h{foo}, 'foobar42');
279
280&Devel::PPPort::sv_setiv_mg($h{bar}, 42);
281ok($h{bar}, 42);
282
283&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159);
284ok(abs($h{PI} - 3.14159) < 0.01);
285
286&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx');
287ok($h{mhx}, 'mhx');
288
289&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus');
290ok($h{mhx}, 'Marcus');
291
292&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV');
293ok($h{sv}, 'SV');
294
295&Devel::PPPort::sv_setuv_mg($h{sv}, 4711);
296ok($h{sv}, 4711);
297
298&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl');
299ok($h{sv}, 'Perl');
300
f2ab5a41 301my $ver = eval qq[qv("v1.2.0")];
302ok($[ < 5.009 || $@ eq '');
303ok($@ || Devel::PPPort::SvVSTRING_mg($ver));
304ok(!Devel::PPPort::SvVSTRING_mg(4711));
305
Unnamed repository; edit this file to name it for gitweb.