Devel-PPPort
view release on metacpan or search on metacpan
parts/inc/SvPV view on Meta::CPAN
RETVAL
void
SvPV_renew(sv, nlen, insv)
SV *sv
STRLEN nlen
SV *insv
PREINIT:
STRLEN slen;
const char *str;
PPCODE:
str = SvPV_const(insv, slen);
XPUSHs(sv);
mXPUSHi(SvLEN(sv));
SvPV_renew(sv, nlen);
Copy(str, SvPVX(sv), slen + 1, char);
SvCUR_set(sv, slen);
mXPUSHi(SvLEN(sv));
void
SvPVCLEAR(sv)
parts/inc/SvREFCNT view on Meta::CPAN
__UNDEFINED__ SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
__UNDEFINED__ SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
__UNDEFINED__ SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
=xsubs
void
SvREFCNT()
PREINIT:
SV *sv, *svr;
PPCODE:
sv = newSV(0);
mXPUSHi(SvREFCNT(sv) == 1);
svr = SvREFCNT_inc(sv);
mXPUSHi(sv == svr);
mXPUSHi(SvREFCNT(sv) == 2);
svr = SvREFCNT_inc_simple(sv);
mXPUSHi(sv == svr);
mXPUSHi(SvREFCNT(sv) == 3);
svr = SvREFCNT_inc_NN(sv);
mXPUSHi(sv == svr);
parts/inc/call view on Meta::CPAN
RETVAL = G_RETHROW;
OUTPUT:
RETVAL
void
eval_sv(sv, flags)
SV* sv
I32 flags
PREINIT:
I32 i;
PPCODE:
PUTBACK;
i = eval_sv(sv, flags);
SPAGAIN;
EXTEND(SP, 1);
mPUSHi(i);
void
eval_pv(p, croak_on_error)
char* p
I32 croak_on_error
PPCODE:
PUTBACK;
EXTEND(SP, 1);
PUSHs(eval_pv(p, croak_on_error));
void
call_sv(sv, flags, ...)
SV* sv
I32 flags
PREINIT:
I32 i;
PPCODE:
for (i=0; i<items-2; i++)
ST(i) = ST(i+2); /* pop first two args */
PUSHMARK(SP);
SP += items - 2;
PUTBACK;
i = call_sv(sv, flags);
SPAGAIN;
EXTEND(SP, 1);
mPUSHi(i);
void
call_pv(subname, flags, ...)
char* subname
I32 flags
PREINIT:
I32 i;
PPCODE:
for (i=0; i<items-2; i++)
ST(i) = ST(i+2); /* pop first two args */
PUSHMARK(SP);
SP += items - 2;
PUTBACK;
i = call_pv(subname, flags);
SPAGAIN;
EXTEND(SP, 1);
mPUSHi(i);
void
call_argv(subname, flags, ...)
char* subname
I32 flags
PREINIT:
I32 i;
char *args[8];
PPCODE:
if (items > 8) /* play safe */
XSRETURN_UNDEF;
for (i=2; i<items; i++)
args[i-2] = SvPV_nolen(ST(i));
args[items-2] = NULL;
PUTBACK;
i = call_argv(subname, flags, args);
SPAGAIN;
EXTEND(SP, 1);
mPUSHi(i);
void
call_method(methname, flags, ...)
char* methname
I32 flags
PREINIT:
I32 i;
PPCODE:
for (i=0; i<items-2; i++)
ST(i) = ST(i+2); /* pop first two args */
PUSHMARK(SP);
SP += items - 2;
PUTBACK;
i = call_method(methname, flags);
SPAGAIN;
EXTEND(SP, 1);
mPUSHi(i);
void
call_sv_G_METHOD(sv, flags, ...)
SV* sv
I32 flags
PREINIT:
I32 i;
PPCODE:
for (i=0; i<items-2; i++)
ST(i) = ST(i+2); /* pop first two args */
PUSHMARK(SP);
SP += items - 2;
PUTBACK;
i = call_sv(sv, flags | G_METHOD);
SPAGAIN;
EXTEND(SP, 1);
mPUSHi(i);
parts/inc/cop view on Meta::CPAN
#if { VERSION >= 5.6.0 }
void
caller_cx(level)
I32 level
PREINIT:
const PERL_CONTEXT *cx, *dbcx;
const char *pv;
const GV *gv;
PPCODE:
cx = caller_cx(level, &dbcx);
if (!cx) XSRETURN_EMPTY;
EXTEND(SP, 4);
pv = CopSTASHPV(cx->blk_oldcop);
ST(0) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef;
gv = CvGV(cx->blk_sub.cv);
ST(1) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef;
parts/inc/format view on Meta::CPAN
# define NVff "f"
# define NVgf "g"
# endif
#endif
=xsubs
void
croak_NVgf(num)
NV num
PPCODE:
Perl_croak(aTHX_ "%.20" NVgf "\n", num);
#if { VERSION >= 5.004 }
SV *
sprintf_iv(iv)
IV iv
CODE:
RETVAL = newSVpvf("XX_%" IVdf "_XX", iv);
OUTPUT:
parts/inc/gv view on Meta::CPAN
void
gv_init_type(namesv, multi, flags)
SV* namesv
int multi
I32 flags
PREINIT:
HV *defstash = gv_stashpv("main", 0);
STRLEN len;
const char * const name = SvPV_const(namesv, len);
GV *gv = *(GV**)hv_fetch(defstash, name, len, TRUE);
PPCODE:
if (SvTYPE(gv) == SVt_PVGV)
Perl_croak(aTHX_ "GV is already a PVGV");
if (multi) flags |= GV_ADDMULTI;
gv_init_pvn(gv, defstash, name, len, flags);
XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
=tests plan => 7
is(Devel::PPPort::GvSVn(), 1);
parts/inc/mPUSH view on Meta::CPAN
__UNDEFINED__ XPUSHmortal XPUSHs(sv_newmortal())
__UNDEFINED__ mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
__UNDEFINED__ mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
__UNDEFINED__ mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
__UNDEFINED__ mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
=xsubs
void
mPUSHs()
PPCODE:
EXTEND(SP, 3);
mPUSHs(newSVpv("foo", 0));
mPUSHs(newSVpv("bar13", 3));
mPUSHs(newSViv(42));
XSRETURN(3);
void
mPUSHp()
PPCODE:
EXTEND(SP, 3);
mPUSHp("one", 3);
mPUSHp("two", 3);
mPUSHp("three", 5);
XSRETURN(3);
void
mPUSHn()
PPCODE:
EXTEND(SP, 3);
mPUSHn(0.5);
mPUSHn(-0.25);
mPUSHn(0.125);
XSRETURN(3);
void
mPUSHi()
PPCODE:
EXTEND(SP, 3);
mPUSHi(-1);
mPUSHi(2);
mPUSHi(-3);
XSRETURN(3);
void
mPUSHu()
PPCODE:
EXTEND(SP, 3);
mPUSHu(1);
mPUSHu(2);
mPUSHu(3);
XSRETURN(3);
void
mXPUSHs()
PPCODE:
mXPUSHs(newSVpv("foo", 0));
mXPUSHs(newSVpv("bar13", 3));
mXPUSHs(newSViv(42));
XSRETURN(3);
void
mXPUSHp()
PPCODE:
mXPUSHp("one", 3);
mXPUSHp("two", 3);
mXPUSHp("three", 5);
XSRETURN(3);
void
mXPUSHn()
PPCODE:
mXPUSHn(0.5);
mXPUSHn(-0.25);
mXPUSHn(0.125);
XSRETURN(3);
void
mXPUSHi()
PPCODE:
mXPUSHi(-1);
mXPUSHi(2);
mXPUSHi(-3);
XSRETURN(3);
void
mXPUSHu()
PPCODE:
mXPUSHu(1);
mXPUSHu(2);
mXPUSHu(3);
XSRETURN(3);
=tests plan => 10
is(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42");
is(join(':', &Devel::PPPort::mPUSHp()), "one:two:three");
is(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125");
parts/inc/magic view on Meta::CPAN
RETVAL = sv_bless(self_ref, stash);
OUTPUT:
RETVAL
void
remove_null_magic(self)
SV *self
PREINIT:
HV *obj;
PPCODE:
obj = (HV*) SvRV(self);
sv_unmagicext((SV*)obj, PERL_MAGIC_ext, &null_mg_vtbl);
void
remove_other_magic(self)
SV *self
PREINIT:
HV *obj;
PPCODE:
obj = (HV*) SvRV(self);
sv_unmagicext((SV*)obj, PERL_MAGIC_ext, &other_mg_vtbl);
void
as_string(self)
SV *self
PREINIT:
HV *obj;
MAGIC *mg;
PPCODE:
obj = (HV*) SvRV(self);
if ((mg = mg_findext((SV*)obj, PERL_MAGIC_ext, &null_mg_vtbl))) {
XPUSHs(sv_2mortal(newSVpv(mg->mg_ptr, strlen(mg->mg_ptr))));
} else {
XPUSHs(sv_2mortal(newSVpvs("Sorry, your princess is in another castle.")));
}
void
sv_catpv_mg(sv, string)
parts/inc/misc view on Meta::CPAN
char *name
I32 create
CODE:
RETVAL = get_cv(name, create) != NULL;
OUTPUT:
RETVAL
void
xsreturn(two)
int two
PPCODE:
mXPUSHp("test1", 5);
if (two)
mXPUSHp("test2", 5);
if (two)
XSRETURN(2);
else
XSRETURN(1);
SV*
boolSV(value)
parts/inc/misc view on Meta::CPAN
SV*
DEFSV()
CODE:
RETVAL = newSVsv(DEFSV);
OUTPUT:
RETVAL
void
DEFSV_modify()
PPCODE:
XPUSHs(sv_mortalcopy(DEFSV));
ENTER;
SAVE_DEFSV;
DEFSV_set(newSVpvs("DEFSV"));
XPUSHs(sv_mortalcopy(DEFSV));
/* Yes, this leaks the above scalar; 5.005 with threads for some reason */
/* frees it upon LEAVE, thus mortalizing it causes "attempt to free..." */
/* sv_2mortal(DEFSV); */
LEAVE;
XPUSHs(sv_mortalcopy(DEFSV));
parts/inc/misc view on Meta::CPAN
XSRETURN(1);
}
int
PERL_ABS(a)
int a
void
SVf(x)
SV *x
PPCODE:
#if { VERSION >= 5.004 }
x = sv_2mortal(newSVpvf("[%" SVf "]", SVfARG(x)));
#endif
XPUSHs(x);
XSRETURN(1);
void
Perl_ppaddr_t(string)
char *string
PREINIT:
Perl_ppaddr_t lower;
PPCODE:
lower = PL_ppaddr[OP_LC];
mXPUSHs(newSVpv(string, 0));
PUTBACK;
ENTER;
(void)*(lower)(aTHXR);
SPAGAIN;
LEAVE;
XSRETURN(1);
#if { VERSION >= 5.8.0 }
void
check_HeUTF8(utf8_key)
SV *utf8_key;
PREINIT:
HV *hash;
HE *ent;
STRLEN klen;
char *key;
PPCODE:
hash = newHV();
key = SvPV(utf8_key, klen);
if (SvUTF8(utf8_key)) klen *= -1;
hv_store(hash, key, klen, newSVpvs("string"), 0);
hv_iterinit(hash);
ent = hv_iternext(hash);
assert(ent);
mXPUSHp((HeUTF8(ent) == 0 ? "norm" : "utf8"), 4);
hv_undef(hash);
#endif
void
check_c_array()
PREINIT:
int x[] = { 10, 11, 12, 13 };
PPCODE:
mXPUSHi(C_ARRAY_LENGTH(x)); /* 4 */
mXPUSHi(*(C_ARRAY_END(x)-1)); /* 13 */
bool
isBLANK(ord)
UV ord
CODE:
RETVAL = isBLANK(ord);
OUTPUT:
RETVAL
parts/inc/newSVpv view on Meta::CPAN
return sv;
}
# define newSVpvn_flags(s, len, flags) D_PPP_newSVpvn_flags((s), (len), (flags))
# endif
#endif
=xsubs
void
newSVpvn()
PPCODE:
mXPUSHs(newSVpvn("test", 4));
mXPUSHs(newSVpvn("test", 2));
mXPUSHs(newSVpvn("test", 0));
mXPUSHs(newSVpvn(NULL, 2));
mXPUSHs(newSVpvn(NULL, 0));
XSRETURN(5);
void
newSVpvn_flags()
PPCODE:
XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP));
XPUSHs(newSVpvn_flags("test", 2, SVs_TEMP));
XPUSHs(newSVpvn_flags("test", 0, SVs_TEMP));
XPUSHs(newSVpvn_flags(NULL, 2, SVs_TEMP));
XPUSHs(newSVpvn_flags(NULL, 0, SVs_TEMP));
XSRETURN(5);
void
newSVpvn_utf8()
PPCODE:
XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP|SVf_UTF8));
XSRETURN(1);
=tests plan => 15
my @s = &Devel::PPPort::newSVpvn();
ok(@s == 5);
is($s[0], "test");
is($s[1], "te");
is($s[2], "");
parts/inc/pv_tools view on Meta::CPAN
=xsinit
#define NEED_pv_escape
#define NEED_pv_pretty
#define NEED_pv_display
=xsubs
void
pv_escape_can_unicode()
PPCODE:
#if defined(is_utf8_string) && defined(utf8_to_uvchr_buf)
XSRETURN_YES;
#else
XSRETURN_NO;
#endif
void
pv_pretty()
PREINIT:
char *rv;
PPCODE:
EXTEND(SP, 8);
ST(0) = sv_newmortal();
rv = pv_pretty(ST(0), "foobarbaz",
9, 40, NULL, NULL, 0);
ST(1) = sv_2mortal(newSVpv(rv, 0));
ST(2) = sv_newmortal();
rv = pv_pretty(ST(2), "pv_p\retty\n",
10, 40, "left", "right", PERL_PV_PRETTY_LTGT);
ST(3) = sv_2mortal(newSVpv(rv, 0));
ST(4) = sv_newmortal();
parts/inc/pv_tools view on Meta::CPAN
ST(6) = sv_newmortal();
rv = pv_pretty(ST(6), "\303\201g\303\246tis Byrjun",
15, 18, NULL, NULL, PERL_PV_ESCAPE_UNI_DETECT|PERL_PV_PRETTY_ELLIPSES);
ST(7) = sv_2mortal(newSVpv(rv, 0));
XSRETURN(8);
void
pv_display()
PREINIT:
char *rv;
PPCODE:
EXTEND(SP, 4);
ST(0) = sv_newmortal();
rv = pv_display(ST(0), "foob\0rbaz", 9, 10, 20);
ST(1) = sv_2mortal(newSVpv(rv, 0));
ST(2) = sv_newmortal();
rv = pv_display(ST(2), "pv_display", 10, 11, 5);
ST(3) = sv_2mortal(newSVpv(rv, 0));
XSRETURN(4);
=tests plan => 13
parts/inc/pvs view on Meta::CPAN
__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;
parts/inc/pvs view on Meta::CPAN
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*
parts/inc/snprintf view on Meta::CPAN
#define NEED_my_snprintf
=xsubs
void
my_snprintf()
PREINIT:
char buf[128];
int len;
PPCODE:
len = my_snprintf(buf, sizeof buf, "foo%s%d", "bar", 42);
mXPUSHi(len);
mXPUSHs(newSVpv(buf, 0));
XSRETURN(2);
=tests plan => 2
my($l, $s) = Devel::PPPort::my_snprintf();
is($l, 8);
is($s, "foobar42");
parts/inc/sprintf view on Meta::CPAN
#define NEED_my_sprintf
=xsubs
void
my_sprintf()
PREINIT:
char buf[128];
int len;
PPCODE:
len = my_sprintf(buf, "foo%s%d", "bar", 42);
mXPUSHi(len);
mXPUSHs(newSVpv(buf, 0));
XSRETURN(2);
=tests plan => 2
my($l, $s) = Devel::PPPort::my_sprintf();
is($l, 8);
is($s, "foobar42");
parts/inc/strlfuncs view on Meta::CPAN
#define NEED_my_strlcat
#define NEED_my_strlcpy
=xsubs
void
my_strlfunc()
PREINIT:
char buf[8];
int len;
PPCODE:
len = my_strlcpy(buf, "foo", sizeof(buf));
mXPUSHi(len);
mXPUSHs(newSVpv(buf, 0));
len = my_strlcat(buf, "bar", sizeof(buf));
mXPUSHi(len);
mXPUSHs(newSVpv(buf, 0));
len = my_strlcat(buf, "baz", sizeof(buf));
mXPUSHi(len);
mXPUSHs(newSVpv(buf, 0));
len = my_strlcpy(buf, "1234567890", sizeof(buf));
parts/inc/threads view on Meta::CPAN
no_THX_arg(sv)
SV *sv
CODE:
RETVAL = 1 + sv_2iv(sv);
OUTPUT:
RETVAL
void
with_THX_arg(error)
SV *error
PPCODE:
croak_sv(error);
=tests plan => 2
is(&Devel::PPPort::no_THX_arg("42"), 43);
eval { &Devel::PPPort::with_THX_arg("yes\n"); };
ok($@ =~ /^yes/);
parts/inc/utf8 view on Meta::CPAN
void
UTF8f(x)
SV *x
PREINIT:
U32 u;
STRLEN len;
char *ptr;
INIT:
ptr = SvPV(x, len);
u = SvUTF8(x);
PPCODE:
x = sv_2mortal(newSVpvf("[%" UTF8f "]", UTF8fARG(u, len, ptr)));
XPUSHs(x);
XSRETURN(1);
#endif
#if { VERSION >= 5.006 } /* This is just a helper fcn, not publicized */ \
/* as being available and params not what the */ \
/* API function has; works on EBCDIC too */
parts/inc/uv view on Meta::CPAN
SvUVx(sv)
SV *sv
CODE:
sv--;
RETVAL = SvUVx(++sv);
OUTPUT:
RETVAL
void
XSRETURN_UV()
PPCODE:
XSRETURN_UV(42);
void
PUSHu()
PREINIT:
dTARG;
PPCODE:
TARG = sv_newmortal();
EXTEND(SP, 1);
PUSHu(42);
XSRETURN(1);
void
XPUSHu()
PREINIT:
dTARG;
PPCODE:
TARG = sv_newmortal();
XPUSHu(43);
XSRETURN(1);
STRLEN
my_strnlen(s, max)
char * s
STRLEN max
CODE:
RETVAL= my_strnlen(s, max);
parts/inc/variables view on Meta::CPAN
SV *
PL_hints()
CODE:
RETVAL = newSViv((IV) PL_hints);
OUTPUT:
RETVAL
void
PL_ppaddr(string)
char *string
PPCODE:
PUSHMARK(SP);
mXPUSHs(newSVpv(string, 0));
PUTBACK;
ENTER;
(void)*(PL_ppaddr[OP_UC])(aTHXR);
SPAGAIN;
LEAVE;
XSRETURN(1);
void
other_variables()
PREINIT:
int count = 0;
PPCODE:
ppp_TESTVAR(PL_DBsignal);
ppp_TESTVAR(PL_DBsingle);
ppp_TESTVAR(PL_DBsub);
ppp_TESTVAR(PL_DBtrace);
ppp_TESTVAR(PL_compiling);
ppp_TESTVAR(PL_curcop);
ppp_TESTVAR(PL_curstash);
ppp_TESTVAR(PL_debstash);
ppp_TESTVAR(PL_defgv);
ppp_TESTVAR(PL_diehook);
( run in 3.580 seconds using v1.01-cache-2.11-cpan-71847e10f99 )