Commit | Line | Data |
0d0f8426 |
1 | ################################################################################ |
2 | ## |
bfc37ff7 |
3 | ## $Revision: 8 $ |
0d0f8426 |
4 | ## $Author: mhx $ |
bfc37ff7 |
5 | ## $Date: 2010/03/07 13:15:46 +0100 $ |
0d0f8426 |
6 | ## |
7 | ################################################################################ |
8 | ## |
bfc37ff7 |
9 | ## Version 3.x, Copyright (C) 2004-2010, Marcus Holland-Moritz. |
0d0f8426 |
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 | |
22 | =implementation |
23 | |
24 | __UNDEFINED__ SvMAGIC_set(sv, val) \ |
25 | STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ |
26 | (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END |
27 | |
28 | #if { VERSION < 5.9.3 } |
29 | |
30 | __UNDEFINED__ SvPVX_const(sv) ((const char*) (0 + SvPVX(sv))) |
31 | __UNDEFINED__ SvPVX_mutable(sv) (0 + SvPVX(sv)) |
32 | |
33 | __UNDEFINED__ SvRV_set(sv, val) \ |
34 | STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ |
35 | (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END |
36 | |
37 | #else |
38 | |
39 | __UNDEFINED__ SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) |
40 | __UNDEFINED__ SvPVX_mutable(sv) ((sv)->sv_u.svu_pv) |
41 | |
42 | __UNDEFINED__ SvRV_set(sv, val) \ |
43 | STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ |
44 | ((sv)->sv_u.svu_rv = (val)); } STMT_END |
45 | |
46 | #endif |
47 | |
48 | __UNDEFINED__ SvSTASH_set(sv, val) \ |
49 | STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ |
50 | (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END |
51 | |
52 | #if { VERSION < 5.004 } |
53 | |
54 | __UNDEFINED__ SvUV_set(sv, val) \ |
55 | STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ |
56 | (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END |
57 | |
58 | #else |
59 | |
60 | __UNDEFINED__ SvUV_set(sv, val) \ |
61 | STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ |
62 | (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END |
63 | |
64 | #endif |
65 | |
66 | =xsubs |
67 | |
68 | IV |
69 | TestSvUV_set(sv, val) |
70 | SV *sv |
71 | UV val |
72 | CODE: |
73 | SvUV_set(sv, val); |
74 | RETVAL = SvUVX(sv) == val ? 42 : -1; |
75 | OUTPUT: |
76 | RETVAL |
77 | |
78 | IV |
79 | TestSvPVX_const(sv) |
80 | SV *sv |
81 | CODE: |
82 | RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1; |
83 | OUTPUT: |
84 | RETVAL |
85 | |
86 | IV |
87 | TestSvPVX_mutable(sv) |
88 | SV *sv |
89 | CODE: |
90 | RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1; |
91 | OUTPUT: |
92 | RETVAL |
93 | |
f2ab5a41 |
94 | void |
95 | TestSvSTASH_set(sv, name) |
96 | SV *sv |
97 | char *name |
98 | CODE: |
99 | sv = SvRV(sv); |
100 | SvREFCNT_dec(SvSTASH(sv)); |
101 | SvSTASH_set(sv, (HV*) SvREFCNT_inc(gv_stashpv(name, 0))); |
102 | |
103 | =tests plan => 5 |
0d0f8426 |
104 | |
105 | my $foo = 5; |
106 | ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42); |
107 | ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43); |
108 | ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44); |
f2ab5a41 |
109 | |
110 | my $bar = []; |
111 | |
112 | bless $bar, 'foo'; |
113 | ok($bar->x(), 'foobar'); |
114 | |
115 | Devel::PPPort::TestSvSTASH_set($bar, 'bar'); |
116 | ok($bar->x(), 'hacker'); |
117 | |
118 | package foo; |
119 | |
120 | sub x { 'foobar' } |
121 | |
122 | package bar; |
123 | |
124 | sub x { 'hacker' } |