ext/Devel/PPPort/parts/inc/magic

   1 ################################################################################
   2 ##
   3 ##  $Revision: 7 $
   4 ##  $Author: mhx $
   5 ##  $Date: 2004/08/13 12:45:55 +0200 $
   6 ##
   7 ################################################################################
   8 ##
   9 ##  Version 3.x, Copyright (C) 2004, Marcus Holland-Moritz.
  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