################################################################################ ## ## $Revision: 9 $ ## $Author: mhx $ ## $Date: 2005/03/10 18:08:41 +0100 $ ## ################################################################################ ## ## Version 3.x, Copyright (C) 2004-2005, 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, 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(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);