In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e897f2d79346a5c1b43d0948c1c0720cbb220cfa?hp=ca30c090c37b4fcb6ced9e51748937223401d2f7>
- Log ----------------------------------------------------------------- commit e897f2d79346a5c1b43d0948c1c0720cbb220cfa Author: Father Chrysostomos <spr...@cpan.org> Date: Sun Aug 14 01:12:19 2016 -0700 Re-order intrp struct M intrpvar.h commit 8d89205aa6324e7dc469ff80b73d94181c926654 Author: Father Chrysostomos <spr...@cpan.org> Date: Sun Aug 14 01:11:07 2016 -0700 Remove PL_maxo We have an interpreter variable using memory, PL_maxo, which is defined to be the same as MAXO, a #defined constant. As far as I can tell, it is never used in lvalue context, in core or on CPAN, except for the initialisation in intrpvar.h. It can simply be removed and replaced with a macro defined as equiva- lent to MAXO. It was added in this commit: commit 84ea024ac9cdf20f21223e686dddea82d5eceb4f Author: Perl 5 Porters <perl5-porters.nicoh.com> Date: Tue Jan 2 23:21:55 1996 +0000 perl 5.002beta1h patch: perl.h 5.002beta1 attempted some memory optimizations, but unfortunately they can result in a memory leak problem. This can be avoided by #define STRANGE_MALLOC. I do that here until consensus is reached on a better strategy for handling the memory optimizations. Include maxo for the maximum number of operations (needed for the Safe extension). But apparently it is not needed for the Safe extension (tests pass without it). M embedvar.h M intrpvar.h M perl.h M sv.c commit 6b6b24f11907f607277fd8cf6f08264c234cc693 Author: Father Chrysostomos <spr...@cpan.org> Date: Sun Aug 14 00:52:36 2016 -0700 #define PERL_NO_GET_CONTEXT in XS::APItest We want efficiency. But more importantly, we want to be able to see errors in the output, without them getting drowned by: APItest.xs:197: warning: unused parameter âmy_perlâ APItest.xs:242: warning: unused parameter âmy_perlâ APItest.xs:327: warning: unused parameter âmy_perlâ APItest.xs:341: warning: unused parameter âmy_perlâ APItest.xs:362: warning: unused parameter âmy_perlâ APItest.xs:376: warning: unused parameter âmy_perlâ APItest.xs:390: warning: unused parameter âmy_perlâ APItest.xs:400: warning: unused parameter âmy_perlâ APItest.xs:410: warning: unused parameter âmy_perlâ APItest.xs:426: warning: unused parameter âmy_perlâ APItest.xs:446: warning: unused parameter âmy_perlâ APItest.xs:466: warning: unused parameter âmy_perlâ APItest.xs:474: warning: unused parameter âmy_perlâ APItest.xs:488: warning: unused parameter âmy_perlâ APItest.xs:553: warning: unused parameter âmy_perlâ APItest.xs:564: warning: unused parameter âmy_perlâ APItest.xs:576: warning: unused parameter âmy_perlâ APItest.xs:606: warning: unused parameter âmy_perlâ APItest.xs:620: warning: unused parameter âmy_perlâ APItest.xs:632: warning: unused parameter âmy_perlâ APItest.xs:654: warning: unused parameter âmy_perlâ APItest.xs:672: warning: unused parameter âmy_perlâ APItest.xs:754: warning: unused parameter âmy_perlâ APItest.xs:782: warning: unused parameter âmy_perlâ APItest.xs:851: warning: unused parameter âmy_perlâ APItest.xs:866: warning: unused parameter âmy_perlâ APItest.xs:883: warning: unused parameter âmy_perlâ APItest.xs:904: warning: unused parameter âmy_perlâ APItest.xs:915: warning: unused parameter âmy_perlâ APItest.xs:922: warning: unused parameter âmy_perlâ APItest.xs:937: warning: unused parameter âmy_perlâ APItest.xs:946: warning: unused parameter âmy_perlâ APItest.xs:962: warning: unused parameter âmy_perlâ APItest.xs:969: warning: unused parameter âmy_perlâ APItest.xs:978: warning: unused parameter âmy_perlâ APItest.xs:989: warning: unused parameter âmy_perlâ APItest.xs:995: warning: unused parameter âmy_perlâ APItest.xs:1001: warning: unused parameter âmy_perlâ APItest.xs:1007: warning: unused parameter âmy_perlâ APItest.xs:1013: warning: unused parameter âmy_perlâ APItest.xs:1019: warning: unused parameter âmy_perlâ APItest.xs:1034: warning: unused parameter âmy_perlâ APItest.xs:1040: warning: unused parameter âmy_perlâ APItest.xs:1050: warning: unused parameter âmy_perlâ APItest.xs:1124: warning: unused parameter âmy_perlâ APItest.xs:1136: warning: unused parameter âmy_perlâ APItest.xs:1146: warning: unused parameter âmy_perlâ APItest.xs:1237: warning: unused parameter âmy_perlâ APItest.xs:1243: warning: unused parameter âmy_perlâ APItest.xs:1251: warning: unused parameter âmy_perlâ etc. g++ likes to warn about unused parameters. M ext/XS-APItest/APItest.xs commit c06180d63f8ab087b868a1d5e3425268a9b8726d Author: Father Chrysostomos <spr...@cpan.org> Date: Sun Aug 14 00:41:19 2016 -0700 Test call_argv M ext/XS-APItest/APItest.xs M ext/XS-APItest/t/call.t ----------------------------------------------------------------------- Summary of changes: embedvar.h | 1 - ext/XS-APItest/APItest.xs | 46 +++++++++++++++++++++++++++++++++------------- ext/XS-APItest/t/call.t | 19 ++++++++++++++++++- intrpvar.h | 4 +--- perl.h | 1 + sv.c | 2 -- 6 files changed, 53 insertions(+), 20 deletions(-) diff --git a/embedvar.h b/embedvar.h index cf4912c..18f2c99 100644 --- a/embedvar.h +++ b/embedvar.h @@ -195,7 +195,6 @@ #define PL_markstack_max (vTHX->Imarkstack_max) #define PL_markstack_ptr (vTHX->Imarkstack_ptr) #define PL_max_intro_pending (vTHX->Imax_intro_pending) -#define PL_maxo (vTHX->Imaxo) #define PL_maxsysfd (vTHX->Imaxsysfd) #define PL_memory_debug_header (vTHX->Imemory_debug_header) #define PL_mess_sv (vTHX->Imess_sv) diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 063a198..3d8db26 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -3,6 +3,7 @@ /* We want to be able to test things that aren't API yet. */ #define PERL_EXT +#define PERL_NO_GET_CONTEXT /* we wants efficiency */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" @@ -117,6 +118,7 @@ my_cxt_getsv_interp_context(void) SV* my_cxt_getsv_interp(void) { + dTHX; dMY_CXT; return MY_CXT.sv; } @@ -141,7 +143,7 @@ bool sv_setsv_cow_hashkey_notcore(void); typedef void (freeent_function)(pTHX_ HV *, HE *); void -test_freeent(freeent_function *f) { +test_freeent(pTHX_ freeent_function *f) { dSP; HV *test_hash = newHV(); HE *victim; @@ -515,9 +517,9 @@ THX_ck_entersub_multi_sum(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) return sumop; } -STATIC void test_op_list_describe_part(SV *res, OP *o); +STATIC void test_op_list_describe_part(pTHX_ SV *res, OP *o); STATIC void -test_op_list_describe_part(SV *res, OP *o) +test_op_list_describe_part(pTHX_ SV *res, OP *o) { sv_catpv(res, PL_op_name[o->op_type]); switch (o->op_type) { @@ -529,7 +531,7 @@ test_op_list_describe_part(SV *res, OP *o) OP *k; sv_catpvs(res, "["); for (k = cUNOPx(o)->op_first; k; k = OpSIBLING(k)) - test_op_list_describe_part(res, k); + test_op_list_describe_part(aTHX_ res, k); sv_catpvs(res, "]"); } else { sv_catpvs(res, "."); @@ -537,11 +539,11 @@ test_op_list_describe_part(SV *res, OP *o) } STATIC char * -test_op_list_describe(OP *o) +test_op_list_describe(pTHX_ OP *o) { SV *res = sv_2mortal(newSVpvs("")); if (o) - test_op_list_describe_part(res, o); + test_op_list_describe_part(aTHX_ res, o); return SvPVX(res); } @@ -585,7 +587,7 @@ THX_mkLISTOP(pTHX_ U32 type, OP *first, OP *sib, OP *last) } static char * -test_op_linklist_describe(OP *start) +test_op_linklist_describe(pTHX_ OP *start) { SV *rv = sv_2mortal(newSVpvs("")); OP *o; @@ -1793,13 +1795,13 @@ common(params) void test_hv_free_ent() PPCODE: - test_freeent(&Perl_hv_free_ent); + test_freeent(aTHX_ &Perl_hv_free_ent); XSRETURN(4); void test_hv_delayfree_ent() PPCODE: - test_freeent(&Perl_hv_delayfree_ent); + test_freeent(aTHX_ &Perl_hv_delayfree_ent); XSRETURN(4); SV * @@ -2396,6 +2398,23 @@ call_pv(subname, flags, ...) PUSHs(sv_2mortal(newSViv(i))); void +call_argv(subname, flags, ...) + char* subname + I32 flags + PREINIT: + I32 i; + char *tmpary[4]; + PPCODE: + for (i=0; i<items-2; i++) + tmpary[i] = SvPV_nolen(ST(i+2)); /* ignore first two args */ + tmpary[i] = NULL; + PUTBACK; + i = call_argv(subname, flags, tmpary); + SPAGAIN; + EXTEND(SP, 1); + PUSHs(sv_2mortal(newSViv(i))); + +void call_method(methname, flags, ...) char* methname I32 flags @@ -3409,8 +3428,8 @@ test_op_list() #define iv_op(iv) newSVOP(OP_CONST, 0, newSViv(iv)) #define check_op(o, expect) \ do { \ - if (strcmp(test_op_list_describe(o), (expect))) \ - croak("fail %s %s", test_op_list_describe(o), (expect)); \ + if (strcmp(test_op_list_describe(aTHX_ o), (expect))) \ + croak("fail %s %s", test_op_list_describe(aTHX_ o),(expect)); \ } while(0) a = op_append_elem(OP_LIST, NULL, NULL); check_op(a, ""); @@ -3524,8 +3543,9 @@ test_op_linklist () CODE: #define check_ll(o, expect) \ STMT_START { \ - if (strNE(test_op_linklist_describe(o), (expect))) \ - croak("fail %s %s", test_op_linklist_describe(o), (expect)); \ + if (strNE(test_op_linklist_describe(aTHX_ o), (expect))) \ + croak("fail %s %s", test_op_linklist_describe(aTHX_ o), \ + (expect)); \ } STMT_END o = iv_op(1); check_ll(o, ".const1"); diff --git a/ext/XS-APItest/t/call.t b/ext/XS-APItest/t/call.t index 15b0965..355e498 100644 --- a/ext/XS-APItest/t/call.t +++ b/ext/XS-APItest/t/call.t @@ -11,7 +11,7 @@ use strict; BEGIN { require '../../t/test.pl'; - plan(455); + plan(527); use_ok('XS::APItest') }; @@ -80,6 +80,9 @@ for my $test ( ok(eq_array( [ call_pv('f', $flags, @$args) ], $expected), "$description call_pv('f')"); + ok(eq_array( [ call_argv('f', $flags, @$args) ], $expected), + "$description call_argv('f')") or warn "@{[call_argv('f', $flags, @$args)]}"; + ok(eq_array( [ eval_sv('f(' . join(',',map"'$_'",@$args) . ')', $flags) ], $expected), "$description eval_sv('f(args)')"); @@ -113,6 +116,14 @@ for my $test ( $@ = "before\n"; $warn = ""; + ok(eq_array( [ call_argv('d', $flags|G_EVAL|$keep, @$args) ], + $returnval), + "$desc G_EVAL call_argv('d')"); + is($@, $exp_err, "$desc G_EVAL call_argv('d') - \$@"); + is($warn, $exp_warn, "$desc G_EVAL call_argv('d') - warning"); + + $@ = "before\n"; + $warn = ""; ok(eq_array( [ eval_sv('d()', $flags|$keep) ], $returnval), "$desc eval_sv('d()')"); @@ -134,6 +145,9 @@ for my $test ( ok(eq_array( [ sub { call_pv('f', $flags|G_NOARGS, "bad") }->(@$args) ], $expected), "$description G_NOARGS call_pv('f')"); + ok(eq_array( [ sub { call_argv('f', $flags|G_NOARGS, "bad") }->(@$args) ], + $expected), "$description G_NOARGS call_argv('f')"); + ok(eq_array( [ sub { eval_sv('f(@_)', $flags|G_NOARGS) }->(@$args) ], $expected), "$description G_NOARGS eval_sv('f(@_)')"); @@ -146,6 +160,9 @@ for my $test ( ok(eq_array( [ eval { call_pv('d', $flags, @$args) }, $@ ], [ "its_dead_jim\n" ]), "$description eval { call_pv('d') }"); + ok(eq_array( [ eval { call_argv('d', $flags, @$args) }, $@ ], + [ "its_dead_jim\n" ]), "$description eval { call_argv('d') }"); + ok(eq_array( [ eval { eval_sv('d', $flags), $@ }, $@ ], [ @$returnval, "its_dead_jim\n", '' ]), diff --git a/intrpvar.h b/intrpvar.h index 756b1dc..3f43fd9 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -543,7 +543,7 @@ PERLVARA(I, body_roots, PERL_ARENA_ROOTS_SIZE, void*) /* array of body roots */ PERLVAR(I, debug, VOL U32) /* flags given to -D switch */ -PERLVARI(I, maxo, int, MAXO) /* maximum number of ops */ +PERLVARI(I, padlist_generation, U32, 1) /* id to identify padlist clones */ PERLVARI(I, runops, runops_proc_t, RUNOPS_DEFAULT) @@ -762,8 +762,6 @@ PERLVAR(I, debug_pad, struct perl_debug_pad) /* always needed because of the re /* Hook for File::Glob */ PERLVARI(I, globhook, globhook_t, NULL) -PERLVARI(I, padlist_generation, U32, 1) /* id to identify padlist clones */ - /* The last unconditional member of the interpreter structure when 5.18.0 was released. The offset of the end of this is baked into a global variable in any shared perl library which will allow a sanity test in future perl diff --git a/perl.h b/perl.h index 8a2e1f1..43f1a53 100644 --- a/perl.h +++ b/perl.h @@ -5288,6 +5288,7 @@ EXTCONST char *const PL_phase_names[]; #endif /* !PERL_CORE */ #define PL_hints PL_compiling.cop_hints +#define PL_maxo MAXO END_EXTERN_C diff --git a/sv.c b/sv.c index 467af34..b345052 100644 --- a/sv.c +++ b/sv.c @@ -14780,8 +14780,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_forkprocess = proto_perl->Iforkprocess; /* internal state */ - PL_maxo = proto_perl->Imaxo; - PL_main_start = proto_perl->Imain_start; PL_eval_root = proto_perl->Ieval_root; PL_eval_start = proto_perl->Ieval_start; -- Perl5 Master Repository