################################################################################
##
## $Revision: 11 $
## $Author: mhx $
## $Date: 2009/06/12 12:19:15 +0200 $
##
################################################################################
##
## 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
/* 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)
__UNDEFINED__ gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
__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)
=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));
SV*
gv_fetchpvn_flags()
CODE:
RETVAL = newRV_inc((SV*)gv_fetchpvn_flags("Devel::PPPort::VERSION", sizeof("Devel::PPPort::VERSION")-1, 0, SVt_PV));
OUTPUT:
RETVAL
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
=tests plan => 11
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);
ok(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION);
ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);