################################################################################

##

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