################################################################################ ## ## $Revision: 8 $ ## $Author: mhx $ ## $Date: 2005/01/31 08:10:52 +0100 $ ## ################################################################################ ## ## Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz. ## Version 2.x, Copyright (C) 2001, Paul Marquess. ## Version 1.x, Copyright (C) 1999, Kenneth Albanowski. ## ## This program is free software; you can redistribute it and/or ## modify it under the same terms as Perl itself. ## ################################################################################ =provides __UNDEFINED__ /sv_\w+_mg/ =implementation __UNDEFINED__ SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END __UNDEFINED__ PERL_MAGIC_sv '\0' __UNDEFINED__ PERL_MAGIC_overload 'A' __UNDEFINED__ PERL_MAGIC_overload_elem 'a' __UNDEFINED__ PERL_MAGIC_overload_table 'c' __UNDEFINED__ PERL_MAGIC_bm 'B' __UNDEFINED__ PERL_MAGIC_regdata 'D' __UNDEFINED__ PERL_MAGIC_regdatum 'd' __UNDEFINED__ PERL_MAGIC_env 'E' __UNDEFINED__ PERL_MAGIC_envelem 'e' __UNDEFINED__ PERL_MAGIC_fm 'f' __UNDEFINED__ PERL_MAGIC_regex_global 'g' __UNDEFINED__ PERL_MAGIC_isa 'I' __UNDEFINED__ PERL_MAGIC_isaelem 'i' __UNDEFINED__ PERL_MAGIC_nkeys 'k' __UNDEFINED__ PERL_MAGIC_dbfile 'L' __UNDEFINED__ PERL_MAGIC_dbline 'l' __UNDEFINED__ PERL_MAGIC_mutex 'm' __UNDEFINED__ PERL_MAGIC_shared 'N' __UNDEFINED__ PERL_MAGIC_shared_scalar 'n' __UNDEFINED__ PERL_MAGIC_collxfrm 'o' __UNDEFINED__ PERL_MAGIC_tied 'P' __UNDEFINED__ PERL_MAGIC_tiedelem 'p' __UNDEFINED__ PERL_MAGIC_tiedscalar 'q' __UNDEFINED__ PERL_MAGIC_qr 'r' __UNDEFINED__ PERL_MAGIC_sig 'S' __UNDEFINED__ PERL_MAGIC_sigelem 's' __UNDEFINED__ PERL_MAGIC_taint 't' __UNDEFINED__ PERL_MAGIC_uvar 'U' __UNDEFINED__ PERL_MAGIC_uvar_elem 'u' __UNDEFINED__ PERL_MAGIC_vstring 'V' __UNDEFINED__ PERL_MAGIC_vec 'v' __UNDEFINED__ PERL_MAGIC_utf8 'w' __UNDEFINED__ PERL_MAGIC_substr 'x' __UNDEFINED__ PERL_MAGIC_defelem 'y' __UNDEFINED__ PERL_MAGIC_glob '*' __UNDEFINED__ PERL_MAGIC_arylen '#' __UNDEFINED__ PERL_MAGIC_pos '.' __UNDEFINED__ PERL_MAGIC_backref '<' __UNDEFINED__ PERL_MAGIC_ext '~' /* That's the best we can do... */ __UNDEFINED__ SvPV_force_nomg SvPV_force __UNDEFINED__ SvPV_nomg SvPV __UNDEFINED__ sv_catpvn_nomg sv_catpvn __UNDEFINED__ sv_catsv_nomg sv_catsv __UNDEFINED__ sv_setsv_nomg sv_setsv __UNDEFINED__ sv_pvn_nomg sv_pvn __UNDEFINED__ SvIV_nomg SvIV __UNDEFINED__ SvUV_nomg SvUV #ifndef sv_catpv_mg # define sv_catpv_mg(sv, ptr) \ STMT_START { \ SV *TeMpSv = sv; \ sv_catpv(TeMpSv,ptr); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_catpvn_mg # define sv_catpvn_mg(sv, ptr, len) \ STMT_START { \ SV *TeMpSv = sv; \ sv_catpvn(TeMpSv,ptr,len); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_catsv_mg # define sv_catsv_mg(dsv, ssv) \ STMT_START { \ SV *TeMpSv = dsv; \ sv_catsv(TeMpSv,ssv); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_setiv_mg # define sv_setiv_mg(sv, i) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setiv(TeMpSv,i); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_setnv_mg # define sv_setnv_mg(sv, num) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setnv(TeMpSv,num); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_setpv_mg # define sv_setpv_mg(sv, ptr) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setpv(TeMpSv,ptr); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_setpvn_mg # define sv_setpvn_mg(sv, ptr, len) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setpvn(TeMpSv,ptr,len); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_setsv_mg # define sv_setsv_mg(dsv, ssv) \ STMT_START { \ SV *TeMpSv = dsv; \ sv_setsv(TeMpSv,ssv); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_setuv_mg # define sv_setuv_mg(sv, i) \ STMT_START { \ SV *TeMpSv = sv; \ sv_setuv(TeMpSv,i); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif #ifndef sv_usepvn_mg # define sv_usepvn_mg(sv, ptr, len) \ STMT_START { \ SV *TeMpSv = sv; \ sv_usepvn(TeMpSv,ptr,len); \ SvSETMAGIC(TeMpSv); \ } STMT_END #endif =xsubs void sv_catpv_mg(sv, string) SV *sv; char *string; CODE: sv_catpv_mg(sv, string); void sv_catpvn_mg(sv, sv2) SV *sv; SV *sv2; PREINIT: char *str; STRLEN len; CODE: str = SvPV(sv2, len); sv_catpvn_mg(sv, str, len); void sv_catsv_mg(sv, sv2) SV *sv; SV *sv2; CODE: sv_catsv_mg(sv, sv2); void sv_setiv_mg(sv, iv) SV *sv; IV iv; CODE: sv_setiv_mg(sv, iv); void sv_setnv_mg(sv, nv) SV *sv; NV nv; CODE: sv_setnv_mg(sv, nv); void sv_setpv_mg(sv, pv) SV *sv; char *pv; CODE: sv_setpv_mg(sv, pv); void sv_setpvn_mg(sv, sv2) SV *sv; SV *sv2; PREINIT: char *str; STRLEN len; CODE: str = SvPV(sv2, len); sv_setpvn_mg(sv, str, len); void sv_setsv_mg(sv, sv2) SV *sv; SV *sv2; CODE: sv_setsv_mg(sv, sv2); void sv_setuv_mg(sv, uv) SV *sv; UV uv; CODE: sv_setuv_mg(sv, uv); void sv_usepvn_mg(sv, sv2) SV *sv; SV *sv2; PREINIT: char *str, *copy; STRLEN len; CODE: str = SvPV(sv2, len); New(42, copy, len+1, char); Copy(str, copy, len+1, char); sv_usepvn_mg(sv, copy, len); =tests plan => 10 use Tie::Hash; my %h; tie %h, 'Tie::StdHash'; $h{foo} = 'foo'; $h{bar} = ''; &Devel::PPPort::sv_catpv_mg($h{foo}, 'bar'); ok($h{foo}, 'foobar'); &Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz'); ok($h{bar}, 'baz'); &Devel::PPPort::sv_catsv_mg($h{foo}, '42'); ok($h{foo}, 'foobar42'); &Devel::PPPort::sv_setiv_mg($h{bar}, 42); ok($h{bar}, 42); &Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159); ok(abs($h{PI} - 3.14159) < 0.01); &Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx'); ok($h{mhx}, 'mhx'); &Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus'); ok($h{mhx}, 'Marcus'); &Devel::PPPort::sv_setsv_mg($h{sv}, 'SV'); ok($h{sv}, 'SV'); &Devel::PPPort::sv_setuv_mg($h{sv}, 4711); ok($h{sv}, 4711); &Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl'); ok($h{sv}, 'Perl');