[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / parts / inc / pvs

################################################################################
##
##  $Revision: 8 $
##  $Author: mhx $
##  $Date: 2008/01/04 12:02:59 +0100 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2008, 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

/* concatenating with "" ensures that only literal strings are accepted as argument
 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
 * under some configurations might be macros
 */

__UNDEFINED__  STR_WITH_LEN(s)             (s ""), (sizeof(s)-1)

__UNDEFINED__  newSVpvs(str)               newSVpvn(str "", sizeof(str) - 1)
__UNDEFINED__  newSVpvs_flags(str, flags)  newSVpvn_flags(str "", sizeof(str) - 1, flags)
__UNDEFINED__  sv_catpvs(sv, str)          sv_catpvn(sv, str "", sizeof(str) - 1)
__UNDEFINED__  sv_setpvs(sv, str)          sv_setpvn(sv, str "", sizeof(str) - 1)
__UNDEFINED__  hv_fetchs(hv, key, lval)    hv_fetch(hv, key "", sizeof(key) - 1, lval)
__UNDEFINED__  hv_stores(hv, key, val)     hv_store(hv, key "", sizeof(key) - 1, val, 0)

=xsubs

void
newSVpvs()
	PPCODE:
		mXPUSHs(newSVpvs("newSVpvs"));
		XSRETURN(1);

void
newSVpvs_flags()
	PPCODE:
		XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP));
		XSRETURN(1);

void
sv_catpvs(sv)
	SV *sv
	PPCODE:
		sv_catpvs(sv, "sv_catpvs");

void
sv_setpvs(sv)
	SV *sv
	PPCODE:
		sv_setpvs(sv, "sv_setpvs");

void
hv_fetchs(hv)
	SV *hv
	PREINIT:
		SV **s;
	PPCODE:
		s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0);
		XPUSHs(sv_mortalcopy(*s));
		XSRETURN(1);

void
hv_stores(hv, sv)
	SV *hv
	SV *sv
	PPCODE:
		(void) hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc_simple(sv));

=tests plan => 8

my $x = 'foo';

ok(Devel::PPPort::newSVpvs(), "newSVpvs");
ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");

Devel::PPPort::sv_catpvs($x);
ok($x, "foosv_catpvs");

Devel::PPPort::sv_setpvs($x);
ok($x, "sv_setpvs");

my %h = ('hv_fetchs' => 42);
Devel::PPPort::hv_stores(\%h, 4711);
ok(scalar keys %h, 2);
ok(exists $h{'hv_stores'});
ok($h{'hv_stores'}, 4711);
ok(Devel::PPPort::hv_fetchs(\%h), 42);
Commit	Line	Data
f2ab5a41	1	################################################################################
f2ab5a41	2	##
c1a049cb	3	## $Revision: 8 $
f2ab5a41	4	## $Author: mhx $
c1a049cb	5	## $Date: 2008/01/04 12:02:59 +0100 $
f2ab5a41	6	##
	7	################################################################################
	8	##
c1a049cb	9	## Version 3.x, Copyright (C) 2004-2008, Marcus Holland-Moritz.
f2ab5a41	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	/* concatenating with "" ensures that only literal strings are accepted as argument
	25	* note that STR_WITH_LEN() can't be used as argument to macros or functions that
	26	* under some configurations might be macros
	27	*/
	28
	29	__UNDEFINED__ STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
	30
	31	__UNDEFINED__ newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
c1a049cb	32	__UNDEFINED__ newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
f2ab5a41	33	__UNDEFINED__ sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
f2ab5a41	34	__UNDEFINED__ sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
c07deaaf	35	__UNDEFINED__ hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
c07deaaf	36	__UNDEFINED__ hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
f2ab5a41	37
	38	=xsubs
	39
	40	void
	41	newSVpvs()
	42	PPCODE:
c1a049cb	43	mXPUSHs(newSVpvs("newSVpvs"));
	44	XSRETURN(1);
	45
	46	void
	47	newSVpvs_flags()
	48	PPCODE:
	49	XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP));
f2ab5a41	50	XSRETURN(1);
	51
	52	void
	53	sv_catpvs(sv)
	54	SV *sv
	55	PPCODE:
	56	sv_catpvs(sv, "sv_catpvs");
	57
	58	void
	59	sv_setpvs(sv)
	60	SV *sv
	61	PPCODE:
	62	sv_setpvs(sv, "sv_setpvs");
	63
	64	void
	65	hv_fetchs(hv)
	66	SV *hv
	67	PREINIT:
	68	SV **s;
	69	PPCODE:
	70	s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0);
	71	XPUSHs(sv_mortalcopy(*s));
	72	XSRETURN(1);
	73
	74	void
	75	hv_stores(hv, sv)
	76	SV *hv
	77	SV *sv
	78	PPCODE:
c58e738a	79	(void) hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc_simple(sv));
f2ab5a41	80
c1a049cb	81	=tests plan => 8
f2ab5a41	82
	83	my $x = 'foo';
	84
	85	ok(Devel::PPPort::newSVpvs(), "newSVpvs");
c1a049cb	86	ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
f2ab5a41	87
	88	Devel::PPPort::sv_catpvs($x);
	89	ok($x, "foosv_catpvs");
	90
	91	Devel::PPPort::sv_setpvs($x);
	92	ok($x, "sv_setpvs");
	93
	94	my %h = ('hv_fetchs' => 42);
	95	Devel::PPPort::hv_stores(\%h, 4711);
	96	ok(scalar keys %h, 2);
	97	ok(exists $h{'hv_stores'});
	98	ok($h{'hv_stores'}, 4711);
	99	ok(Devel::PPPort::hv_fetchs(\%h), 42);