| 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 | |
projects / p5sagit/p5-mst-13.2.git / blame