| ################################################################################ |
| ## |
| ## $Revision: 8 $ |
| ## $Author: mhx $ |
| ## $Date: 2010/03/07 13:15:46 +0100 $ |
| ## |
| ################################################################################ |
| ## |
| ## Version 3.x, Copyright (C) 2004-2010, 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__ |
| |
| =implementation |
| |
| __UNDEFINED__ SvMAGIC_set(sv, val) \ |
| STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ |
| (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END |
| |
| #if { VERSION < 5.9.3 } |
| |
| __UNDEFINED__ SvPVX_const(sv) ((const char*) (0 + SvPVX(sv))) |
| __UNDEFINED__ SvPVX_mutable(sv) (0 + SvPVX(sv)) |
| |
| __UNDEFINED__ SvRV_set(sv, val) \ |
| STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ |
| (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END |
| |
| #else |
| |
| __UNDEFINED__ SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) |
| __UNDEFINED__ SvPVX_mutable(sv) ((sv)->sv_u.svu_pv) |
| |
| __UNDEFINED__ SvRV_set(sv, val) \ |
| STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ |
| ((sv)->sv_u.svu_rv = (val)); } STMT_END |
| |
| #endif |
| |
| __UNDEFINED__ SvSTASH_set(sv, val) \ |
| STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ |
| (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END |
| |
| #if { VERSION < 5.004 } |
| |
| __UNDEFINED__ SvUV_set(sv, val) \ |
| STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ |
| (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END |
| |
| #else |
| |
| __UNDEFINED__ SvUV_set(sv, val) \ |
| STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ |
| (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END |
| |
| #endif |
| |
| =xsubs |
| |
| IV |
| TestSvUV_set(sv, val) |
| SV *sv |
| UV val |
| CODE: |
| SvUV_set(sv, val); |
| RETVAL = SvUVX(sv) == val ? 42 : -1; |
| OUTPUT: |
| RETVAL |
| |
| IV |
| TestSvPVX_const(sv) |
| SV *sv |
| CODE: |
| RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1; |
| OUTPUT: |
| RETVAL |
| |
| IV |
| TestSvPVX_mutable(sv) |
| SV *sv |
| CODE: |
| RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1; |
| OUTPUT: |
| RETVAL |
| |
| void |
| TestSvSTASH_set(sv, name) |
| SV *sv |
| char *name |
| CODE: |
| sv = SvRV(sv); |
| SvREFCNT_dec(SvSTASH(sv)); |
| SvSTASH_set(sv, (HV*) SvREFCNT_inc(gv_stashpv(name, 0))); |
| |
| =tests plan => 5 |
| |
| my $foo = 5; |
| ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42); |
| ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43); |
| ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44); |
| |
| my $bar = []; |
| |
| bless $bar, 'foo'; |
| ok($bar->x(), 'foobar'); |
| |
| Devel::PPPort::TestSvSTASH_set($bar, 'bar'); |
| ok($bar->x(), 'hacker'); |
| |
| package foo; |
| |
| sub x { 'foobar' } |
| |
| package bar; |
| |
| sub x { 'hacker' } |