dist/Devel-PPPort/parts/inc/Sv_set

   1 ################################################################################
   2 ##
   3 ##  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
   4 ##  Version 2.x, Copyright (C) 2001, Paul Marquess.
   5 ##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
   6 ##
   7 ##  This program is free software; you can redistribute it and/or
   8 ##  modify it under the same terms as Perl itself.
   9 ##
  10 ################################################################################
  11
  12 =provides
  13
  14 __UNDEFINED__
  15
  16 =implementation
  17
  18 __UNDEFINED__ SvMAGIC_set(sv, val) \
  19                 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
  20                 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
  21
  22 #if { VERSION < 5.9.3 }
  23
  24 __UNDEFINED__ SvPVX_const(sv)     ((const char*) (0 + SvPVX(sv)))
  25 __UNDEFINED__ SvPVX_mutable(sv)   (0 + SvPVX(sv))
  26
  27 __UNDEFINED__ SvRV_set(sv, val) \
  28                 STMT_START { assert(SvTYPE(sv) >=  SVt_RV); \
  29                 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
  30
  31 #else
  32
  33 __UNDEFINED__ SvPVX_const(sv)     ((const char*)((sv)->sv_u.svu_pv))
  34 __UNDEFINED__ SvPVX_mutable(sv)   ((sv)->sv_u.svu_pv)
  35
  36 __UNDEFINED__ SvRV_set(sv, val) \
  37                 STMT_START { assert(SvTYPE(sv) >=  SVt_RV); \
  38                 ((sv)->sv_u.svu_rv = (val)); } STMT_END
  39
  40 #endif
  41
  42 __UNDEFINED__ SvSTASH_set(sv, val) \
  43                 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
  44                 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
  45
  46 #if { VERSION < 5.004 }
  47
  48 __UNDEFINED__ SvUV_set(sv, val) \
  49                 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
  50                 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
  51
  52 #else
  53
  54 __UNDEFINED__ SvUV_set(sv, val) \
  55                 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
  56                 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
  57
  58 #endif
  59
  60 =xsubs
  61
  62 IV
  63 TestSvUV_set(sv, val)
  64         SV *sv
  65         UV val
  66         CODE:
  67                 SvUV_set(sv, val);
  68                 RETVAL = SvUVX(sv) == val ? 42 : -1;
  69         OUTPUT:
  70                 RETVAL
  71
  72 IV
  73 TestSvPVX_const(sv)
  74         SV *sv
  75         CODE:
  76                 RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1;
  77         OUTPUT:
  78                 RETVAL
  79
  80 IV
  81 TestSvPVX_mutable(sv)
  82         SV *sv
  83         CODE:
  84                 RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1;
  85         OUTPUT:
  86                 RETVAL
  87
  88 void
  89 TestSvSTASH_set(sv, name)
  90         SV *sv
  91         char *name
  92         CODE:
  93                 sv = SvRV(sv);
  94                 SvREFCNT_dec(SvSTASH(sv));
  95                 SvSTASH_set(sv, (HV*) SvREFCNT_inc(gv_stashpv(name, 0)));
  96
  97 =tests plan => 5
  98
  99 my $foo = 5;
 100 ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42);
 101 ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43);
 102 ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44);
 103
 104 my $bar = [];
 105
 106 bless $bar, 'foo';
 107 ok($bar->x(), 'foobar');
 108
 109 Devel::PPPort::TestSvSTASH_set($bar, 'bar');
 110 ok($bar->x(), 'hacker');
 111
 112 package foo;
 113
 114 sub x { 'foobar' }
 115
 116 package bar;
 117
 118 sub x { 'hacker' }