[p5sagit/p5-mst-13.2.git] / cpan / Devel-PPPort / parts / inc / Sv_set

################################################################################
##
##  $Revision: 7 $
##  $Author: mhx $
##  $Date: 2009/01/18 14:10:53 +0100 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2009, 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' }
Commit	Line	Data
0d0f8426	1	################################################################################
0d0f8426	2	##
3f0c6e0c	3	## $Revision: 7 $
0d0f8426	4	## $Author: mhx $
3f0c6e0c	5	## $Date: 2009/01/18 14:10:53 +0100 $
0d0f8426	6	##
	7	################################################################################
	8	##
3f0c6e0c	9	## Version 3.x, Copyright (C) 2004-2009, 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' }