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

################################################################################
##
##  $Revision: 14 $
##  $Author: mhx $
##  $Date: 2010/03/07 13:15:45 +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

/* 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__  newSVpvs_share(str)         newSVpvn_share(str "", sizeof(str) - 1, 0)
__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)

__UNDEFINED__  gv_fetchpvs(name, flags, svt)            gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
__UNDEFINED__  gv_stashpvs(name, flags)                 gv_stashpvn(name "", sizeof(name) - 1, flags)

__UNDEFINED__  get_cvs(name, flags)                     get_cvn_flags(name "", sizeof(name)-1, flags)

=xsinit

#define NEED_newSVpvn_share

=xsubs

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

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

int
newSVpvs_share()
	PREINIT:
		SV *sv;
		U32 hash;
	CODE:
		RETVAL = 0;
		PERL_HASH(hash, "pvs", 3);
		sv = newSVpvs_share("pvs");
		RETVAL += strEQ(SvPV_nolen_const(sv), "pvs");
		RETVAL += SvCUR(sv) == 3;
		RETVAL += SvSHARED_HASH(sv) == hash;
		SvREFCNT_dec(sv);
	OUTPUT:
		RETVAL

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));

SV*
gv_fetchpvs()
	CODE:
		RETVAL = newRV_inc((SV*)gv_fetchpvs("Devel::PPPort::VERSION", 0, SVt_PV));
	OUTPUT:
		RETVAL

SV*
gv_stashpvs()
	CODE:
		RETVAL = newRV_inc((SV*)gv_stashpvs("Devel::PPPort", 0));
	OUTPUT:
		RETVAL

int
get_cvs()
	PREINIT:
		CV* xv;
	CODE:
		RETVAL = 0;
		xv = get_cvs("Devel::PPPort::foobar", 0);
		if(xv == NULL) RETVAL++;
		xv = get_cvs("Devel::PPPort::foobar", GV_ADDMULTI);
		if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
		xv = get_cvs("Devel::PPPort::get_cvs", 0);
		if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
OUTPUT:
	RETVAL


=tests plan => 12

my $x = 'foo';

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

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);
ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);

ok(Devel::PPPort::get_cvs(), 3);
Commit	Line	Data
f2ab5a41	1	################################################################################
f2ab5a41	2	##
bfc37ff7	3	## $Revision: 14 $
f2ab5a41	4	## $Author: mhx $
bfc37ff7	5	## $Date: 2010/03/07 13:15:45 +0100 $
f2ab5a41	6	##
	7	################################################################################
	8	##
bfc37ff7	9	## Version 3.x, Copyright (C) 2004-2010, 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)
bfc37ff7	33	__UNDEFINED__ newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
f2ab5a41	34	__UNDEFINED__ sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
f2ab5a41	35	__UNDEFINED__ sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
c07deaaf	36	__UNDEFINED__ hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
c07deaaf	37	__UNDEFINED__ hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
f2ab5a41	38
8565c31a	39	__UNDEFINED__ gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
	40	__UNDEFINED__ gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
	41
bfc37ff7	42	__UNDEFINED__ get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
	43
	44	=xsinit
	45
	46	#define NEED_newSVpvn_share
	47
f2ab5a41	48	=xsubs
	49
	50	void
	51	newSVpvs()
	52	PPCODE:
c1a049cb	53	mXPUSHs(newSVpvs("newSVpvs"));
	54	XSRETURN(1);
	55
	56	void
	57	newSVpvs_flags()
	58	PPCODE:
	59	XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP));
f2ab5a41	60	XSRETURN(1);
f2ab5a41	61
bfc37ff7	62	int
	63	newSVpvs_share()
	64	PREINIT:
	65	SV *sv;
	66	U32 hash;
	67	CODE:
	68	RETVAL = 0;
	69	PERL_HASH(hash, "pvs", 3);
	70	sv = newSVpvs_share("pvs");
	71	RETVAL += strEQ(SvPV_nolen_const(sv), "pvs");
	72	RETVAL += SvCUR(sv) == 3;
	73	RETVAL += SvSHARED_HASH(sv) == hash;
	74	SvREFCNT_dec(sv);
	75	OUTPUT:
	76	RETVAL
	77
f2ab5a41	78	void
	79	sv_catpvs(sv)
	80	SV *sv
	81	PPCODE:
	82	sv_catpvs(sv, "sv_catpvs");
	83
	84	void
	85	sv_setpvs(sv)
	86	SV *sv
	87	PPCODE:
	88	sv_setpvs(sv, "sv_setpvs");
	89
	90	void
	91	hv_fetchs(hv)
	92	SV *hv
	93	PREINIT:
	94	SV **s;
	95	PPCODE:
	96	s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0);
	97	XPUSHs(sv_mortalcopy(*s));
	98	XSRETURN(1);
	99
	100	void
	101	hv_stores(hv, sv)
	102	SV *hv
	103	SV *sv
	104	PPCODE:
c58e738a	105	(void) hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc_simple(sv));
f2ab5a41	106
8565c31a	107	SV*
8565c31a	108	gv_fetchpvs()
	109	CODE:
	110	RETVAL = newRV_inc((SV*)gv_fetchpvs("Devel::PPPort::VERSION", 0, SVt_PV));
	111	OUTPUT:
	112	RETVAL
	113
	114	SV*
	115	gv_stashpvs()
	116	CODE:
	117	RETVAL = newRV_inc((SV*)gv_stashpvs("Devel::PPPort", 0));
	118	OUTPUT:
	119	RETVAL
	120
bfc37ff7	121	int
	122	get_cvs()
	123	PREINIT:
	124	CV* xv;
	125	CODE:
	126	RETVAL = 0;
	127	xv = get_cvs("Devel::PPPort::foobar", 0);
	128	if(xv == NULL) RETVAL++;
	129	xv = get_cvs("Devel::PPPort::foobar", GV_ADDMULTI);
	130	if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
	131	xv = get_cvs("Devel::PPPort::get_cvs", 0);
	132	if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++;
	133	OUTPUT:
	134	RETVAL
8565c31a	135
bfc37ff7	136
bfc37ff7	137	=tests plan => 12
f2ab5a41	138
	139	my $x = 'foo';
	140
	141	ok(Devel::PPPort::newSVpvs(), "newSVpvs");
c1a049cb	142	ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
bfc37ff7	143	ok(Devel::PPPort::newSVpvs_share(), 3);
f2ab5a41	144
	145	Devel::PPPort::sv_catpvs($x);
	146	ok($x, "foosv_catpvs");
	147
	148	Devel::PPPort::sv_setpvs($x);
	149	ok($x, "sv_setpvs");
	150
	151	my %h = ('hv_fetchs' => 42);
	152	Devel::PPPort::hv_stores(\%h, 4711);
	153	ok(scalar keys %h, 2);
	154	ok(exists $h{'hv_stores'});
	155	ok($h{'hv_stores'}, 4711);
	156	ok(Devel::PPPort::hv_fetchs(\%h), 42);
bfc37ff7	157	ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
	158	ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);
	159
	160	ok(Devel::PPPort::get_cvs(), 3);