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
62IV
63TestSvUV_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
72IV
73TestSvPVX_const(sv)
74        SV *sv
75        CODE:
76                RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1;
77        OUTPUT:
78                RETVAL
79
80IV
81TestSvPVX_mutable(sv)
82        SV *sv
83        CODE:
84                RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1;
85        OUTPUT:
86                RETVAL
87
88void
89TestSvSTASH_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
99my $foo = 5;
100ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42);
101ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43);
102ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44);
103
104my $bar = [];
105
106bless $bar, 'foo';
107ok($bar->x(), 'foobar');
108
109Devel::PPPort::TestSvSTASH_set($bar, 'bar');
110ok($bar->x(), 'hacker');
111
112package foo;
113
114sub x { 'foobar' }
115
116package bar;
117
118sub x { 'hacker' }
119