1 ################################################################################
5 ## $Date: 2005/01/31 08:10:52 +0100 $
7 ################################################################################
9 ## Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
10 ## Version 2.x, Copyright (C) 2001, Paul Marquess.
11 ## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
13 ## This program is free software; you can redistribute it and/or
14 ## modify it under the same terms as Perl itself.
16 ################################################################################
25 * Returns a CV* as of perl-5.7.1. This return value is not supported
29 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
30 #if { VERSION < 5.004_63 } && { VERSION != 5.004_05 }
31 #if { NEED newCONSTSUB }
34 newCONSTSUB(HV *stash, char *name, SV *sv)
36 U32 oldhints = PL_hints;
37 HV *old_cop_stash = PL_curcop->cop_stash;
38 HV *old_curstash = PL_curstash;
39 line_t oldline = PL_curcop->cop_line;
40 PL_curcop->cop_line = PL_copline;
42 PL_hints &= ~HINT_BLOCK_SCOPE;
44 PL_curstash = PL_curcop->cop_stash = stash;
48 #if { VERSION < 5.003_22 }
50 #elif { VERSION == 5.003_22 }
52 #else /* 5.003_23 onwards */
53 start_subparse(FALSE, 0),
56 newSVOP(OP_CONST, 0, newSVpv(name,0)),
57 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
58 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
62 PL_curcop->cop_stash = old_cop_stash;
63 PL_curstash = old_curstash;
64 PL_curcop->cop_line = oldline;
71 #define NEED_newCONSTSUB
75 void call_newCONSTSUB_1(void)
77 #ifdef PERL_NO_GET_CONTEXT
80 newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
83 extern void call_newCONSTSUB_2(void);
84 extern void call_newCONSTSUB_3(void);
99 &Devel::PPPort::call_newCONSTSUB_1();
100 ok(&Devel::PPPort::test_value_1(), 1);
102 &Devel::PPPort::call_newCONSTSUB_2();
103 ok(&Devel::PPPort::test_value_2(), 2);
105 &Devel::PPPort::call_newCONSTSUB_3();
106 ok(&Devel::PPPort::test_value_3(), 3);