155 lines
4.3 KiB
Plaintext
155 lines
4.3 KiB
Plaintext
################################################################################
|
|
##
|
|
## Version 3.x, Copyright (C) 2004-2013, 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);
|