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

newCONSTSUB

=implementation

/* Hint: newCONSTSUB
 * Returns a CV* as of perl-5.7.1. This return value is not supported
 * by Devel::PPPort.
 */

/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if { VERSION < 5.004_63 } && { VERSION != 5.004_05 }
#if { NEED newCONSTSUB }

/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
/* (There's no PL_parser in perl < 5.005, so this is completely safe)     */
#define D_PPP_PL_copline PL_copline

void
newCONSTSUB(HV *stash, const char *name, SV *sv)
{
        U32 oldhints = PL_hints;
        HV *old_cop_stash = PL_curcop->cop_stash;
        HV *old_curstash = PL_curstash;
        line_t oldline = PL_curcop->cop_line;
        PL_curcop->cop_line = D_PPP_PL_copline;

PL_hints &= ~HINT_BLOCK_SCOPE;
        if (stash)
                PL_curstash = PL_curcop->cop_stash = stash;

newSUB(

#if   { VERSION <  5.003_22 }
                start_subparse(),
#elif { VERSION == 5.003_22 }
                start_subparse(0),
#else  /* 5.003_23  onwards */
                start_subparse(FALSE, 0),
#endif

newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
                newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
                newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
        );

PL_hints = oldhints;
        PL_curcop->cop_stash = old_cop_stash;
        PL_curstash = old_curstash;
        PL_curcop->cop_line = oldline;
}
#endif
#endif

=xsinit

#define NEED_newCONSTSUB

=xsmisc

void call_newCONSTSUB_1(void)
{
#ifdef PERL_NO_GET_CONTEXT
        dTHX;
#endif
        newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
}

extern void call_newCONSTSUB_2(void);
extern void call_newCONSTSUB_3(void);

=xsubs

void
call_newCONSTSUB_1()

void
call_newCONSTSUB_2()

void
call_newCONSTSUB_3()

=tests plan => 3

&Devel::PPPort::call_newCONSTSUB_1();
ok(&Devel::PPPort::test_value_1(), 1);

&Devel::PPPort::call_newCONSTSUB_2();
ok(&Devel::PPPort::test_value_2(), 2);

&Devel::PPPort::call_newCONSTSUB_3();
ok(&Devel::PPPort::test_value_3(), 3);