Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
HvNAME	961 B	-r--r--r--	2014-12-27 11:48
MY_CXT	5.02 KB	-r--r--r--	2014-12-27 11:48
SvPV	14.47 KB	-r--r--r--	2014-12-27 11:49
SvREFCNT	3.78 KB	-r--r--r--	2014-12-27 11:48
Sv_set	2.93 KB	-r--r--r--	2014-12-27 11:48
call	9.12 KB	-r--r--r--	2014-12-27 11:49
cop	2.76 KB	-r--r--r--	2014-12-27 11:49
exception	1.66 KB	-r--r--r--	2014-12-27 11:48
format	1.56 KB	-r--r--r--	2014-12-27 11:48
grok	20.45 KB	-r--r--r--	2014-12-27 11:49
gv	2.8 KB	-r--r--r--	2014-12-27 11:48
limits	7.25 KB	-r--r--r--	2014-12-27 11:48
mPUSH	3.27 KB	-r--r--r--	2014-12-27 11:48
magic	10.14 KB	-r--r--r--	2014-12-27 11:49
memory	2.24 KB	-r--r--r--	2014-12-27 11:48
misc	13.64 KB	-r--r--r--	2014-12-27 11:49
newCONSTSUB	2.54 KB	-r--r--r--	2014-12-27 11:48
newRV	1.4 KB	-r--r--r--	2014-12-27 11:48
newSV_type	1.61 KB	-r--r--r--	2014-12-27 11:48
newSVpv	2.53 KB	-r--r--r--	2014-12-27 11:48
podtest	1.07 KB	-r--r--r--	2014-12-27 11:48
ppphbin	20.5 KB	-r--r--r--	2014-12-27 11:48
ppphdoc	9.64 KB	-r--r--r--	2014-12-27 11:49
ppphtest	21.33 KB	-r--r--r--	2014-12-27 11:49
pv_tools	8.35 KB	-r--r--r--	2014-12-27 11:49
pvs	4.3 KB	-r--r--r--	2014-12-27 11:48
shared_pv	2.14 KB	-r--r--r--	2014-12-27 11:48
snprintf	1.39 KB	-r--r--r--	2014-12-27 11:48
sprintf	1.12 KB	-r--r--r--	2014-12-27 11:48
strlfuncs	2.47 KB	-r--r--r--	2014-12-27 11:48
sv_xpvf	6.98 KB	-r--r--r--	2014-12-27 11:48
threads	1.34 KB	-r--r--r--	2014-12-27 11:48
uv	3.21 KB	-r--r--r--	2014-12-27 11:48
variables	13.2 KB	-r--r--r--	2014-12-27 11:49
version	1.56 KB	-r--r--r--	2014-12-27 11:48
warn	4.36 KB	-r--r--r--	2014-12-27 11:48

Rename

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