newconstsub

source of perl for linux application,

################################################################################
##
##  $Revision: 12 $
##  $Author: mhx $
##  $Date: 2007/09/11 23:20:42 +0200 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2007, 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 }

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