From 0f9a6232f0af0895807ddd0afae2d5512aa91bf9 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Fri, 25 Jan 2019 10:32:42 +1100 Subject: [PATCH] PERL_OP_PARENT is always defined, stop testing for it PERL_OP_PARENT is the new reality, leaving the pre-processor checks is more confusing that anything else. I left the test in perl.c for consistency with the other checks in that code. --- embed.fnc | 2 -- embed.h | 4 +--- ext/B/B.pm | 2 +- ext/B/B.xs | 4 ---- ext/B/t/b.t | 4 +--- ext/XS-APItest/APItest.pm | 2 +- ext/XS-APItest/APItest.xs | 2 -- makedef.pl | 6 ------ op.c | 18 ------------------ op.h | 23 ++--------------------- pp_hot.c | 2 -- proto.h | 8 +++----- 12 files changed, 9 insertions(+), 68 deletions(-) diff --git a/embed.fnc b/embed.fnc index ffdc04e..bdb29f7 100644 --- a/embed.fnc +++ b/embed.fnc @@ -952,9 +952,7 @@ Ap |void |op_refcnt_lock Ap |void |op_refcnt_unlock Apdn |OP* |op_sibling_splice|NULLOK OP *parent|NULLOK OP *start \ |int del_count|NULLOK OP* insert -#ifdef PERL_OP_PARENT Apdn |OP* |op_parent|NN OP *o -#endif #if defined(PERL_IN_OP_C) s |OP* |listkids |NULLOK OP* o #endif diff --git a/embed.h b/embed.h index d35508a..a945838 100644 --- a/embed.h +++ b/embed.h @@ -566,6 +566,7 @@ #define op_free(a) Perl_op_free(aTHX_ a) #define op_linklist(a) Perl_op_linklist(aTHX_ a) #define op_null(a) Perl_op_null(aTHX_ a) +#define op_parent Perl_op_parent #define op_prepend_elem(a,b,c) Perl_op_prepend_elem(aTHX_ a,b,c) #define op_refcnt_lock() Perl_op_refcnt_lock(aTHX) #define op_refcnt_unlock() Perl_op_refcnt_unlock(aTHX) @@ -1013,9 +1014,6 @@ #define warn_nocontext Perl_warn_nocontext #define warner_nocontext Perl_warner_nocontext #endif -#if defined(PERL_OP_PARENT) -#define op_parent Perl_op_parent -#endif #if defined(UNLINK_ALL_VERSIONS) #define unlnk(a) Perl_unlnk(aTHX_ a) #endif diff --git a/ext/B/B.pm b/ext/B/B.pm index 5ec8b8c..2d9b2d0 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -20,7 +20,7 @@ sub import { # walkoptree comes from B.xs BEGIN { - $B::VERSION = '1.75'; + $B::VERSION = '1.76'; @B::EXPORT_OK = (); # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. diff --git a/ext/B/B.xs b/ext/B/B.xs index d9d7715..d8fc22a 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -635,11 +635,7 @@ BOOT: cv = newXS("B::diehook", intrpvar_sv_common, file); ASSIGN_COMMON_ALIAS(I, diehook); sv = get_sv("B::OP::does_parent", GV_ADDMULTI); -#ifdef PERL_OP_PARENT sv_setsv(sv, &PL_sv_yes); -#else - sv_setsv(sv, &PL_sv_no); -#endif } void diff --git a/ext/B/t/b.t b/ext/B/t/b.t index 09dba39..e1279ff 100644 --- a/ext/B/t/b.t +++ b/ext/B/t/b.t @@ -460,9 +460,7 @@ is $regexp->precomp, 'fit', 'pmregexp returns the right regexp'; # test op_parent SKIP: { - unless ($B::OP::does_parent) { - skip "op_parent only present with -DPERL_OP_PARENT builds", 6; - } + ok($B::OP::does_parent, "does_parent always set"); my $lineseq = B::svref_2object(sub{my $x = 1})->ROOT->first; is ($lineseq->type, B::opnumber('lineseq'), 'op_parent: top op is lineseq'); diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 61531fc..ba76d8f 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '0.99'; +our $VERSION = '1.00'; require XSLoader; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index a30659f..e77ff44 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -4197,7 +4197,6 @@ CODE: /* The slab allocator does not like CvROOT being set. */ CvROOT(PL_compcv) = (OP *)1; o = newFOROP(0, 0, newOP(OP_PUSHMARK, 0), 0, 0); -#ifdef PERL_OP_PARENT if (cLOOPx(cUNOPo->op_first)->op_last->op_sibparent != cUNOPo->op_first) { @@ -4205,7 +4204,6 @@ CODE: RETVAL = FALSE; } else -#endif /* If we do not crash before returning, the test passes. */ RETVAL = TRUE; op_free(o); diff --git a/makedef.pl b/makedef.pl index 3c541d8..b3fc164 100644 --- a/makedef.pl +++ b/makedef.pl @@ -478,12 +478,6 @@ if ($define{USE_THREAD_SAFE_LOCALE}) { } } -unless ($define{'PERL_OP_PARENT'}) { - ++$skip{$_} foreach qw( - Perl_op_parent - ); -} - unless ($define{'USE_DTRACE'}) { ++$skip{$_} foreach qw( Perl_dtrace_probe_call diff --git a/op.c b/op.c index 39006ad..d966848 100644 --- a/op.c +++ b/op.c @@ -359,11 +359,9 @@ Perl_Slab_Alloc(pTHX_ size_t sz) DEBUG_S_warn((aTHX_ "allocating op at %p, slab %p", (void*)o, (void*)slab)); gotit: -#ifdef PERL_OP_PARENT /* moresib == 0, op_sibling == 0 implies a solitary unattached op */ assert(!o->op_moresib); assert(!o->op_sibparent); -#endif return (void *)o; } @@ -1473,14 +1471,10 @@ Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert) Perl_croak_nocontext("panic: op_sibling_splice(): NULL parent"); } - -#ifdef PERL_OP_PARENT - /* =for apidoc op_parent Returns the parent OP of C, if it has a parent. Returns C otherwise. -This function is only available on perls built with C<-DPERL_OP_PARENT>. =cut */ @@ -1494,9 +1488,6 @@ Perl_op_parent(OP *o) return o->op_sibparent; } -#endif - - /* replace the sibling following start with a new UNOP, which becomes * the parent of the original sibling; e.g. * @@ -3708,16 +3699,11 @@ S_finalize_op(pTHX_ OP* o) ); for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) { -# ifdef PERL_OP_PARENT if (!OpHAS_SIBLING(kid)) { if (has_last) assert(kid == cLISTOPo->op_last); assert(kid->op_sibparent == o); } -# else - if (has_last && !OpHAS_SIBLING(kid)) - assert(kid == cLISTOPo->op_last); -# endif } #endif @@ -8860,19 +8846,15 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont) LOOP *tmp; NewOp(1234,tmp,1,LOOP); Copy(loop,tmp,1,LISTOP); -#ifdef PERL_OP_PARENT assert(loop->op_last->op_sibparent == (OP*)loop); OpLASTSIB_set(loop->op_last, (OP*)tmp); /*point back to new parent */ -#endif S_op_destroy(aTHX_ (OP*)loop); loop = tmp; } else if (!loop->op_slabbed) { loop = (LOOP*)PerlMemShared_realloc(loop, sizeof(LOOP)); -#ifdef PERL_OP_PARENT OpLASTSIB_set(loop->op_last, (OP*)loop); -#endif } loop->op_targ = padoff; wop = newWHILEOP(flags, 1, loop, newOP(OP_ITER, 0), block, cont, 0); diff --git a/op.h b/op.h index bfdebaa..6d9dae8 100644 --- a/op.h +++ b/op.h @@ -38,21 +38,12 @@ typedef PERL_BITFIELD16 Optype; -/* this field now either points to the next sibling or to the parent, - * depending on op_moresib. So rename it from op_sibling to op_sibparent. - */ -#ifdef PERL_OP_PARENT -# define _OP_SIBPARENT_FIELDNAME op_sibparent -#else -# define _OP_SIBPARENT_FIELDNAME op_sibling -#endif - #ifdef BASEOP_DEFINITION #define BASEOP BASEOP_DEFINITION #else #define BASEOP \ OP* op_next; \ - OP* _OP_SIBPARENT_FIELDNAME;\ + OP* op_sibparent; \ OP* (*op_ppaddr)(pTHX); \ PADOFFSET op_targ; \ PERL_BITFIELD16 op_type:9; \ @@ -980,7 +971,7 @@ and C>. For a higher-level interface, see C>. =for apidoc Am|void|OpLASTSIB_set|OP *o|OP *parent -Marks C as having no further siblings. On C builds, marks +Marks C as having no further siblings and marks o as having the specified parent. See also C> and C. For a higher-level interface, see C>. @@ -1026,7 +1017,6 @@ C is non-null. For a higher-level interface, see C>. ( (o) && OP_TYPE_ISNT_AND_WASNT_NN(o, type) ) -#ifdef PERL_OP_PARENT # define OpHAS_SIBLING(o) (cBOOL((o)->op_moresib)) # define OpSIBLING(o) (0 + (o)->op_moresib ? (o)->op_sibparent : NULL) # define OpMORESIB_set(o, sib) ((o)->op_moresib = 1, (o)->op_sibparent = (sib)) @@ -1034,15 +1024,6 @@ C is non-null. For a higher-level interface, see C>. ((o)->op_moresib = 0, (o)->op_sibparent = (parent)) # define OpMAYBESIB_set(o, sib, parent) \ ((o)->op_sibparent = ((o)->op_moresib = cBOOL(sib)) ? (sib) : (parent)) -#else -# define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling)) -# define OpSIBLING(o) (0 + (o)->op_sibling) -# define OpMORESIB_set(o, sib) ((o)->op_moresib = 1, (o)->op_sibling = (sib)) -# define OpLASTSIB_set(o, parent) \ - ((o)->op_moresib = 0, (o)->op_sibling = NULL) -# define OpMAYBESIB_set(o, sib, parent) \ - ((o)->op_moresib = cBOOL(sib), (o)->op_sibling = (sib)) -#endif #if !defined(PERL_CORE) && !defined(PERL_EXT) /* for backwards compatibility only */ diff --git a/pp_hot.c b/pp_hot.c index ace5f02..3867875 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1822,7 +1822,6 @@ S_padhv_rv2hv_common(pTHX_ HV *hv, U8 gimme, bool is_keys, bool has_targ) PUSHi(i); } else -#ifdef PERL_OP_PARENT if (is_keys) { /* parent op should be an unused OP_KEYS whose targ we can * use */ @@ -1836,7 +1835,6 @@ S_padhv_rv2hv_common(pTHX_ HV *hv, U8 gimme, bool is_keys, bool has_targ) PUSHi(i); } else -#endif mPUSHi(i); } } diff --git a/proto.h b/proto.h index 2023f5c..36a61db 100644 --- a/proto.h +++ b/proto.h @@ -2604,6 +2604,9 @@ PERL_CALLCONV OP* Perl_op_lvalue_flags(pTHX_ OP* o, I32 type, U32 flags); PERL_CALLCONV void Perl_op_null(pTHX_ OP* o); #define PERL_ARGS_ASSERT_OP_NULL \ assert(o) +PERL_CALLCONV OP* Perl_op_parent(OP *o); +#define PERL_ARGS_ASSERT_OP_PARENT \ + assert(o) PERL_CALLCONV OP* Perl_op_prepend_elem(pTHX_ I32 optype, OP* first, OP* last); PERL_CALLCONV void Perl_op_refcnt_lock(pTHX); PERL_CALLCONV void Perl_op_refcnt_unlock(pTHX); @@ -6283,11 +6286,6 @@ PERL_CALLCONV Malloc_t Perl_mem_log_realloc(const UV n, const UV typesize, const #define PERL_ARGS_ASSERT_MEM_LOG_REALLOC \ assert(type_name); assert(filename); assert(funcname) #endif -#if defined(PERL_OP_PARENT) -PERL_CALLCONV OP* Perl_op_parent(OP *o); -#define PERL_ARGS_ASSERT_OP_PARENT \ - assert(o) -#endif #if defined(PERL_USES_PL_PIDSTATUS) && defined(PERL_IN_UTIL_C) STATIC void S_pidgone(pTHX_ Pid_t pid, int status); #endif -- 1.8.3.1