C stack overflow in Perl_scalarvoid #11866
Comments
From @bulk88Created by @bulk88Perl lexer (???) has a deep recursion bug in Perl_scalarvoid when given a very large Perl subroutine to run. Perl_scalarvoid calls itself over and over, for what I blindly guess is every opcode in the sub. If there are too many opcodes, C stack overflows. I could not replicate this with any stock ActivePerl (AP 5.10.0, AP 5.12.3). While the test script is running, ActivePerls peak at 8 MB on the C stack. I checked with VMMAP. If I lower the stack reserve from 16 MB to 256KB in the PE header on perl.exe from ActivePerls, I will get the same exact Perl_scalarvoid stack overflow. There is no reason for the interpreter to peak at many MBs of C stack, which is irreversibly expanded (there are OS specific ways to shrink C stacks.... I know it can be done with VirtualFree and VirtualAlloc on Windows, but that is the wrong way to fix C stack recursion) and wasted, never to be used again after BEGIN blocks run. I have not tested doing the "require" at runtime. On other perl scripts and apps I run, all the interpreter (APs and my compiled Perl) peak at 20-50KB of C stack which is fine. I assume that the reason that my self-compiled Perl will stack overflow at 16MB and ActivePerls do not is because of high C stack overhead of each recursive Perl_scalarvoid when Perl is compiled with -Od (no registers) meanwhile ActivePerls are compiled with -O1 (small code). I wrote this test script to test how efficient Perl is at returning memory to the OS after a Perl Module is "use"d and if, and how well, memory behind the BEGIN blocks (SVs, CVs, Opcodes, pads, raw malloced blocks) is returned to the OS. If I lower the 100000 to 50000 in the test script, the script will run without a stack overflow. On sucessful runs, malloced memory went down from ~60MB inside the module BEGIN block (at "print "after branches\n";") to ~3MB at runtime ("print "in main\n";" ) according to VMMAP (private/yellow memory). C Stack remained at many MBs (7 to 8MB at 50000 in test script). Perl_scalarvoid, whatever it does to opcodes, should run in a loop down the optree, not recursively on every opcode and thus eating away the C stack. I request that the above-reported bug be fixed. Perl Info |
From @bulk88included pics of VS debugger and opcode structs, the pp_cond_expr and |
From @bulk88 |
From @bulk88 |
|
@bulk88 - Status changed from 'new' to 'open' |
From @jkeenanOn Sun Jan 15 10:35:13 2012, bulk88 wrote:
1. I modified the test program you wrote to take the number of $ perl 108276_stk.pl 10 'pause' is not an installed executable on those platforms (though it has Could you modify your program to avoid the use of 'pause'? That would 2. While the screenshots you posted via the RT GUI are displaying, I Thank you for your report. |
From @jkeenan |
From @cpansproutOn Sun Jan 15 12:58:36 2012, jkeenan wrote:
I haven’t used Windows for a long, long time (except IE for web Changing system("pause") to: system("perl -e '$|=1; print q|Press return to continue... |; <>'") should work. -- Father Chrysostomos |
From @bulk88On Sun Jan 15 13:16:04 2012, sprout wrote:
Google says "pause" equivalent on POSIX is "echo -n "Press any key to |
From [Unknown Contact. See original ticket]On Sun Jan 15 13:16:04 2012, sprout wrote:
Google says "pause" equivalent on POSIX is "echo -n "Press any key to |
From @iabynOn Sun, Jan 15, 2012 at 10:35:14AM -0800, bulk 88 wrote: The code can be simplified to the following: my $n = $ARGV[0]; my $code = 'my $i = 0; if ($i) { print }' . "\n"; segfaults for me on blead with n >= about 5000. In blead, it's recursing in S_finalize_op rather than scalarvoid; not sure -- |
From @cpansproutOn Mon Jan 16 03:51:55 2012, davem wrote:
Without actually looking, I suspect it is in addition. As I’m sure you already know, each elsif is nested inside the previous So it looks as though at least S_finalize_op needs to be made iterative, And this results in a crash in op_free: perl -e'eval "sub{".q"$a+"x shift . "}"' 500000 What else needs to be made iterative? -- Father Chrysostomos |
From @bulk88On Fri Jan 20 09:38:48 2012, sprout wrote:
I decided to run Perl's test suite on my c stack reduced perl. First one Perl_peep, when running cop_line 111 unsigned long |
From @bulk88
|
From @bulk88/t/cmd/for.t I killed "perl harness " when it started running cpan folder tests. I |
From @bulk88#include "EXTERN.h"
#include "perl.h"
#define _WIN32_WINNT 0x0400
#include <windows.h>
#ifdef __GNUC__
/* Mingw32 defaults to globing command line
* This is inconsistent with other Win32 ports and
* seems to cause trouble with passing -DXSVERSION=\"1.6\"
* So we turn it off like this, but only when compiling
* perlmain.c: perlmainst.c is linked into the same executable
* as win32.c, which also does this, so we mustn't do it twice
* otherwise we get a multiple definition error.
*/
#ifndef PERLDLL
int _CRT_glob = 0;
#endif
#endif
DWORD FilterFunction(LPEXCEPTION_POINTERS exceptionPtr)
{
printf("1 "); // printed first
return EXCEPTION_EXECUTE_HANDLER;
}
int
main(int argc, char **argv, char **env)
{
char * stackSizeEnv = getenv("PLSTK");
int newStackSize = 0;
DWORD oldProtect;
PBYTE pPtr;
MEMORY_BASIC_INFORMATION infoRes;
MEMORY_BASIC_INFORMATION infoGuard;
MEMORY_BASIC_INFORMATION infoAlloc;
DWORD_PTR stackEnd;
DWORD_PTR stackAllocBegin;
BOOL ret;
__asm mov pPtr, esp
if(stackSizeEnv) {
newStackSize = atoi(stackSizeEnv);
}
else {
newStackSize = 7;
}
if(newStackSize) {
assert(VirtualQuery(pPtr, &infoRes,
sizeof(MEMORY_BASIC_INFORMATION)));
assert(VirtualQuery((DWORD_PTR)infoRes.AllocationBase, &infoRes,
sizeof(MEMORY_BASIC_INFORMATION)));
assert(VirtualQuery((DWORD_PTR)infoRes.AllocationBase+infoRes.RegionSize, &infoGuard,
sizeof(MEMORY_BASIC_INFORMATION)));
assert(VirtualQuery((DWORD_PTR)infoRes.AllocationBase+infoRes.RegionSize
+infoGuard.RegionSize, &infoAlloc,
sizeof(MEMORY_BASIC_INFORMATION)));
stackEnd = (DWORD_PTR)infoRes.AllocationBase+infoRes.RegionSize
+infoGuard.RegionSize+infoAlloc.RegionSize;
stackAllocBegin = stackEnd-(newStackSize*4096);
ret = VirtualAlloc(stackAllocBegin, (newStackSize*4096), MEM_COMMIT, PAGE_READWRITE);
//ret = VirtualProtect(stackAllocBegin, (newStackSize*4096),
// PAGE_READWRITE, &oldProtect);
//printf("vp ret=%u glr=%u\n", ret, GetLastError());
ret = VirtualAlloc(stackAllocBegin-(4096*2), (4096*2), MEM_COMMIT, PAGE_NOACCESS);
//printf("vp ret=%u glr=%u\n", ret, GetLastError());
//ret = VirtualProtect(stackEnd-(newStackSize*4096)-4096, 4096,
// PAGE_NOACCESS, &oldProtect);
//printf("vp ret=%u glr=%u\n", ret, GetLastError());
//while( ! (stMemBasicInfo.Protect & PAGE_GUARD)) {
// assert(VirtualQuery((DWORD_PTR)stMemBasicInfo.BaseAddress-1, &stMemBasicInfo,
// sizeof(stMemBasicInfo)));
//}
//assert(VirtualProtect(stMemBasicInfo.BaseAddress, stMemBasicInfo.RegionSize,
// PAGE_NOACCESS, &oldProtect));
//assert(VirtualQuery((DWORD_PTR)stMemBasicInfo.BaseAddress-1, &stMemBasicInfo,
// sizeof(stMemBasicInfo)));
//assert(VirtualFree((DWORD_PTR)stMemBasicInfo.AllocationBase,
// 0, MEM_RELEASE));
}
if(0) {
exit(1);
}
__try {
ret = RunPerl(argc, argv, env);
}
__except(FilterFunction(GetExceptionInformation())) {
ret = 1;
}
return ret;
}
|
From @bulk88 ntdll.dll!_RtlFreeHeap@12() + 0x1763f
|
From @bulk88
|
From @bulk88this bug sounds similar to |
From @nthykierHi, I cannot reproduce the issue in S_finalize_op on blead[1]. It is On the other hand, I can reproduce the crash caused by: perl -e'eval "sub{".q"$a+"x shift . "}"' 500000 I have attached a prototype patch that solves the problem (at least for For the reviewer(s): the patch is much easier to read by ignoring space The test suite showed no regression, perl was configured with: ~Niels [1] I have been using code suggested by Dave Mitchell (rewritten as a ./perl -e 'my $code = q[my $i = 0; if ($i) { print } ] . "\n";' [2] Compare $ git diff --ignore-all-space --stat versus. $ git diff --stat |
From @bulk88On Wed Jul 17 14:29:33 2013, niels@thykier.net wrote:
I'll update this ticket for 5.19.2. All experiments were done with a Perl_scalarvoid on stk.pl script above is still a problem. I attach a The davem script above is still a problem. New callstack attached. The Father C rep operator on add operator then eval is still a problem. I also attach a newer perlmain.c that I used to reduce the C stack's -- |
From @bulk88 perl519.dll!Perl_scalarvoid(interpreter * my_perl=0x003657e4, op * o=0x00930a80) Line 1233 + 0x3 C
|
From @bulk88#include "EXTERN.h"
#include "perl.h"
#ifdef __GNUC__
/* Mingw32 defaults to globing command line
* This is inconsistent with other Win32 ports and
* seems to cause trouble with passing -DXSVERSION=\"1.6\"
* So we turn it off like this, but only when compiling
* perlmain.c: perlmainst.c is linked into the same executable
* as win32.c, which also does this, so we mustn't do it twice
* otherwise we get a multiple definition error.
*/
#ifndef PERLDLL
int _CRT_glob = 0;
#endif
#endif
DWORD FilterFunction(LPEXCEPTION_POINTERS exceptionPtr)
{
printf("1 "); // printed first
return EXCEPTION_EXECUTE_HANDLER;
}
int
main(int argc, char **argv, char **env)
{
char * stackSizeEnv = getenv("PLSTK");
int newStackSize = 0;
DWORD oldProtect;
PBYTE pPtr;
MEMORY_BASIC_INFORMATION infoRes;
MEMORY_BASIC_INFORMATION infoGuard;
MEMORY_BASIC_INFORMATION infoAlloc;
DWORD_PTR stackEnd;
DWORD_PTR stackAllocBegin;
BOOL ret;
__asm mov pPtr, esp
if(stackSizeEnv) {
newStackSize = atoi(stackSizeEnv);
}
else {
newStackSize = 5;
}
if(newStackSize) {
ret = VirtualQuery(pPtr, &infoRes,
sizeof(MEMORY_BASIC_INFORMATION));
assert(ret);
ret = VirtualQuery((DWORD_PTR)infoRes.AllocationBase, &infoRes,
sizeof(MEMORY_BASIC_INFORMATION));
assert(ret);
ret = VirtualQuery((DWORD_PTR)infoRes.AllocationBase+infoRes.RegionSize, &infoGuard,
sizeof(MEMORY_BASIC_INFORMATION));
assert(ret);
ret = VirtualQuery((DWORD_PTR)infoRes.AllocationBase
+infoRes.RegionSize
+infoGuard.RegionSize
,&infoAlloc, sizeof(MEMORY_BASIC_INFORMATION));
assert(ret);
stackEnd = (DWORD_PTR)infoRes.AllocationBase+infoRes.RegionSize
+infoGuard.RegionSize+infoAlloc.RegionSize;
stackAllocBegin = stackEnd-(newStackSize*4096);
ret = VirtualAlloc(stackAllocBegin, (newStackSize*4096), MEM_COMMIT, PAGE_READWRITE);
//ret = VirtualProtect(stackAllocBegin, (newStackSize*4096),
// PAGE_READWRITE, &oldProtect);
printf("vp ret=%u glr=%u\n", ret, GetLastError());
ret = VirtualAlloc(stackAllocBegin-(4096*2), (4096*2), MEM_COMMIT, PAGE_NOACCESS);
printf("vp ret=%u glr=%u\n", ret, GetLastError());
//ret = VirtualProtect(stackEnd-(newStackSize*4096)-4096, 4096,
// PAGE_NOACCESS, &oldProtect);
//printf("vp ret=%u glr=%u\n", ret, GetLastError());
//while( ! (stMemBasicInfo.Protect & PAGE_GUARD)) {
// assert(VirtualQuery((DWORD_PTR)stMemBasicInfo.BaseAddress-1, &stMemBasicInfo,
// sizeof(stMemBasicInfo)));
//}
//assert(VirtualProtect(stMemBasicInfo.BaseAddress, stMemBasicInfo.RegionSize,
// PAGE_NOACCESS, &oldProtect));
//assert(VirtualQuery((DWORD_PTR)stMemBasicInfo.BaseAddress-1, &stMemBasicInfo,
// sizeof(stMemBasicInfo)));
//assert(VirtualFree((DWORD_PTR)stMemBasicInfo.AllocationBase,
// 0, MEM_RELEASE));
}
if(0) {
exit(1);
}
__try {
ret = RunPerl(argc, argv, env);
}
__except(FilterFunction(GetExceptionInformation())) {
ret = 1;
}
return ret;
}
|
From @bulk88[rep op on evaled add callstack.txt](https://rt-archive.perl.org/perl5/Ticket/Attachment/1235621/643139/rep op on evaled add callstack.txt) |
From @bulk88RT web interface lost the attachment. Adding a missing one. -- |
From @bulk88On Wed Jul 17 19:10:02 2013, bulk88 wrote:
Ok, I uploaded a 0 byte file before. Trying again. -- |
From @bulk88n is at 5000
|
From @tonycozOn Mon Jan 16 03:51:55 2012, davem wrote:
Here's a patch that fixes the S_finalize_op() recursion, whitespace changes minimal Additionally another patch to re-indent the new loop, and another to use the new macros I added to declare and clean-up the DEFER_OP() stack. Tony |
From @tonycoz0001-perl-108276-avoid-recursion-in-S_finalize_op.patchFrom e7121e75f07de01236b37370154aa0661cd89734 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 17 Nov 2014 17:10:25 +1100
Subject: [perl #108276] avoid recursion in S_finalize_op()
This uses the same DEFER_OP() macro set as op_free() and scalarvoid()
but required a bit more work to ensure that warnings are still
produced in source order.
---
op.c | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-----
1 file changed, 56 insertions(+), 5 deletions(-)
diff --git a/op.c b/op.c
index 00c1255..c0de23c 100644
--- a/op.c
+++ b/op.c
@@ -109,10 +109,33 @@ recursive, but it's recursive on basic blocks, not on tree nodes.
#define CALL_RPEEP(o) PL_rpeepp(aTHX_ o)
#define CALL_OPFREEHOOK(o) if (PL_opfreehook) PL_opfreehook(aTHX_ o)
-/* Used to avoid recursion through the op tree in scalarvoid() and
- op_free()
+/* Used to avoid recursion through the op tree in scalarvoid(),
+ op_free() and S_finalize_op().
+
+ Add:
+
+ DEFER_OP_DECLARE;
+
+ at the top of the scope these are used in and:
+
+ DEFER_OP_END;
+
+ at any exit points.
+
+ Use DEFER_OP(op) to push an op and POP_DEFERRED_OP() to get the next op
+ to process.
+
+ DEFERRED_OP_ALLOC(sz, fill) allocates sz items at the top of the
+ stack and sets fill to a pointer to just beyond the last item.
+ This is used by S_finalize_op() to ensure children are processed in
+ source order.
*/
+#define DEFER_OP_DECLARE \
+ SSize_t defer_ix = -1; \
+ SSize_t defer_stack_alloc = 0; \
+ OP **defer_stack = NULL
+#define DEFER_OP_END Safefree(defer_stack)
#define DEFERRED_OP_STEP 100
#define DEFER_OP(o) \
STMT_START { \
@@ -126,6 +149,18 @@ recursive, but it's recursive on basic blocks, not on tree nodes.
#define POP_DEFERRED_OP() (defer_ix >= 0 ? defer_stack[defer_ix--] : (OP *)NULL)
+#define DEFERRED_OP_ALLOC(sz, top) \
+ STMT_START { \
+ if (UNLIKELY(defer_ix + (sz) >= defer_stack_alloc)) { \
+ defer_stack_alloc += \
+ (sz) < DEFERRED_OP_STEP ? DEFERRED_OP_STEP : (sz); \
+ assert(defer_stack_alloc > 0); \
+ Renew(defer_stack, defer_stack_alloc, OP *); \
+ } \
+ defer_ix += (sz); \
+ (top) = defer_stack + defer_ix + 1; \
+ } STMT_END
+
/* remove any leading "empty" ops from the op_next chain whose first
* node's address is stored in op_p. Store the updated address of the
* first node in op_p.
@@ -2170,9 +2205,11 @@ S_op_relocate_sv(pTHX_ SV** svp, PADOFFSET* targp)
STATIC void
S_finalize_op(pTHX_ OP* o)
{
- PERL_ARGS_ASSERT_FINALIZE_OP;
+ DEFER_OP_DECLARE;
+ PERL_ARGS_ASSERT_FINALIZE_OP;
+ do {
switch (o->op_type) {
case OP_NEXTSTATE:
case OP_DBSTATE:
@@ -2397,10 +2434,24 @@ S_finalize_op(pTHX_ OP* o)
# endif
}
#endif
+ {
+ /* Count then fill from the top to ensure any diagnostics
+ are produced in order from the start of the code.
+ */
+ SSize_t kid_count = 0;
+ OP **fill;
+ for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
+ ++kid_count;
+
+ DEFERRED_OP_ALLOC(kid_count, fill);
- for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
- finalize_op(kid);
+ for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
+ *--fill = kid;
+ }
}
+ } while ( (o = POP_DEFERRED_OP()) );
+
+ DEFER_OP_END;
}
/*
--
1.7.10.4
|
From @tonycoz0002-perl-108276-re-indent-the-new-S_finalize_op-loop.patchFrom ced2d759ab9b642578a6d671f76da286988437df Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 17 Nov 2014 17:23:27 +1100
Subject: [perl #108276] re-indent the new S_finalize_op() loop
whitespace changes only
---
op.c | 424 +++++++++++++++++++++++++++++++++---------------------------------
1 file changed, 212 insertions(+), 212 deletions(-)
diff --git a/op.c b/op.c
index c0de23c..45e9c16 100644
--- a/op.c
+++ b/op.c
@@ -2210,245 +2210,245 @@ S_finalize_op(pTHX_ OP* o)
PERL_ARGS_ASSERT_FINALIZE_OP;
do {
- switch (o->op_type) {
- case OP_NEXTSTATE:
- case OP_DBSTATE:
- PL_curcop = ((COP*)o); /* for warnings */
- break;
- case OP_EXEC:
- if (OP_HAS_SIBLING(o)) {
- OP *sib = OP_SIBLING(o);
- if (( sib->op_type == OP_NEXTSTATE || sib->op_type == OP_DBSTATE)
- && ckWARN(WARN_EXEC)
- && OP_HAS_SIBLING(sib))
- {
- const OPCODE type = OP_SIBLING(sib)->op_type;
- if (type != OP_EXIT && type != OP_WARN && type != OP_DIE) {
- const line_t oldline = CopLINE(PL_curcop);
- CopLINE_set(PL_curcop, CopLINE((COP*)sib));
- Perl_warner(aTHX_ packWARN(WARN_EXEC),
- "Statement unlikely to be reached");
- Perl_warner(aTHX_ packWARN(WARN_EXEC),
- "\t(Maybe you meant system() when you said exec()?)\n");
- CopLINE_set(PL_curcop, oldline);
- }
- }
- }
- break;
+ switch (o->op_type) {
+ case OP_NEXTSTATE:
+ case OP_DBSTATE:
+ PL_curcop = ((COP*)o); /* for warnings */
+ break;
+ case OP_EXEC:
+ if (OP_HAS_SIBLING(o)) {
+ OP *sib = OP_SIBLING(o);
+ if (( sib->op_type == OP_NEXTSTATE || sib->op_type == OP_DBSTATE)
+ && ckWARN(WARN_EXEC)
+ && OP_HAS_SIBLING(sib))
+ {
+ const OPCODE type = OP_SIBLING(sib)->op_type;
+ if (type != OP_EXIT && type != OP_WARN && type != OP_DIE) {
+ const line_t oldline = CopLINE(PL_curcop);
+ CopLINE_set(PL_curcop, CopLINE((COP*)sib));
+ Perl_warner(aTHX_ packWARN(WARN_EXEC),
+ "Statement unlikely to be reached");
+ Perl_warner(aTHX_ packWARN(WARN_EXEC),
+ "\t(Maybe you meant system() when you said exec()?)\n");
+ CopLINE_set(PL_curcop, oldline);
+ }
+ }
+ }
+ break;
- case OP_GV:
- if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
- GV * const gv = cGVOPo_gv;
- if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX_const(GvCV(gv))) {
- /* XXX could check prototype here instead of just carping */
- SV * const sv = sv_newmortal();
- gv_efullname3(sv, gv, NULL);
- Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE),
- "%"SVf"() called too early to check prototype",
- SVfARG(sv));
- }
- }
- break;
+ case OP_GV:
+ if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
+ GV * const gv = cGVOPo_gv;
+ if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX_const(GvCV(gv))) {
+ /* XXX could check prototype here instead of just carping */
+ SV * const sv = sv_newmortal();
+ gv_efullname3(sv, gv, NULL);
+ Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE),
+ "%"SVf"() called too early to check prototype",
+ SVfARG(sv));
+ }
+ }
+ break;
- case OP_CONST:
- if (cSVOPo->op_private & OPpCONST_STRICT)
- no_bareword_allowed(o);
- /* FALLTHROUGH */
+ case OP_CONST:
+ if (cSVOPo->op_private & OPpCONST_STRICT)
+ no_bareword_allowed(o);
+ /* FALLTHROUGH */
#ifdef USE_ITHREADS
- case OP_HINTSEVAL:
- op_relocate_sv(&cSVOPo->op_sv, &o->op_targ);
+ case OP_HINTSEVAL:
+ op_relocate_sv(&cSVOPo->op_sv, &o->op_targ);
#endif
- break;
+ break;
#ifdef USE_ITHREADS
- /* Relocate all the METHOP's SVs to the pad for thread safety. */
- case OP_METHOD_NAMED:
- op_relocate_sv(&cMETHOPx(o)->op_u.op_meth_sv, &o->op_targ);
- break;
+ /* Relocate all the METHOP's SVs to the pad for thread safety. */
+ case OP_METHOD_NAMED:
+ op_relocate_sv(&cMETHOPx(o)->op_u.op_meth_sv, &o->op_targ);
+ break;
#endif
- case OP_HELEM: {
- UNOP *rop;
- SV *lexname;
- GV **fields;
- SVOP *key_op;
- OP *kid;
- bool check_fields;
+ case OP_HELEM: {
+ UNOP *rop;
+ SV *lexname;
+ GV **fields;
+ SVOP *key_op;
+ OP *kid;
+ bool check_fields;
- if ((key_op = cSVOPx(((BINOP*)o)->op_last))->op_type != OP_CONST)
- break;
+ if ((key_op = cSVOPx(((BINOP*)o)->op_last))->op_type != OP_CONST)
+ break;
- rop = (UNOP*)((BINOP*)o)->op_first;
+ rop = (UNOP*)((BINOP*)o)->op_first;
- goto check_keys;
+ goto check_keys;
- case OP_HSLICE:
- S_scalar_slice_warning(aTHX_ o);
- /* FALLTHROUGH */
+ case OP_HSLICE:
+ S_scalar_slice_warning(aTHX_ o);
+ /* FALLTHROUGH */
- case OP_KVHSLICE:
- kid = OP_SIBLING(cLISTOPo->op_first);
- if (/* I bet there's always a pushmark... */
- OP_TYPE_ISNT_AND_WASNT_NN(kid, OP_LIST)
- && OP_TYPE_ISNT_NN(kid, OP_CONST))
- {
- break;
- }
+ case OP_KVHSLICE:
+ kid = OP_SIBLING(cLISTOPo->op_first);
+ if (/* I bet there's always a pushmark... */
+ OP_TYPE_ISNT_AND_WASNT_NN(kid, OP_LIST)
+ && OP_TYPE_ISNT_NN(kid, OP_CONST))
+ {
+ break;
+ }
- key_op = (SVOP*)(kid->op_type == OP_CONST
- ? kid
- : OP_SIBLING(kLISTOP->op_first));
+ key_op = (SVOP*)(kid->op_type == OP_CONST
+ ? kid
+ : OP_SIBLING(kLISTOP->op_first));
- rop = (UNOP*)((LISTOP*)o)->op_last;
+ rop = (UNOP*)((LISTOP*)o)->op_last;
- check_keys:
- if (o->op_private & OPpLVAL_INTRO || rop->op_type != OP_RV2HV)
- rop = NULL;
- else if (rop->op_first->op_type == OP_PADSV)
- /* @$hash{qw(keys here)} */
- rop = (UNOP*)rop->op_first;
- else {
- /* @{$hash}{qw(keys here)} */
- if (rop->op_first->op_type == OP_SCOPE
- && cLISTOPx(rop->op_first)->op_last->op_type == OP_PADSV)
- {
- rop = (UNOP*)cLISTOPx(rop->op_first)->op_last;
- }
- else
- rop = NULL;
- }
-
- lexname = NULL; /* just to silence compiler warnings */
- fields = NULL; /* just to silence compiler warnings */
-
- check_fields =
- rop
- && (lexname = *av_fetch(PL_comppad_name, rop->op_targ, TRUE),
- SvPAD_TYPED(lexname))
- && (fields = (GV**)hv_fetchs(SvSTASH(lexname), "FIELDS", FALSE))
- && isGV(*fields) && GvHV(*fields);
- for (; key_op;
- key_op = (SVOP*)OP_SIBLING(key_op)) {
- SV **svp, *sv;
- if (key_op->op_type != OP_CONST)
- continue;
- svp = cSVOPx_svp(key_op);
-
- /* Make the CONST have a shared SV */
- if ((!SvIsCOW_shared_hash(sv = *svp))
- && SvTYPE(sv) < SVt_PVMG && SvOK(sv) && !SvROK(sv)) {
- SSize_t keylen;
- const char * const key = SvPV_const(sv, *(STRLEN*)&keylen);
- SV *nsv = newSVpvn_share(key,
- SvUTF8(sv) ? -keylen : keylen, 0);
- SvREFCNT_dec_NN(sv);
- *svp = nsv;
- }
-
- if (check_fields
- && !hv_fetch_ent(GvHV(*fields), *svp, FALSE, 0)) {
- Perl_croak(aTHX_ "No such class field \"%"SVf"\" "
- "in variable %"SVf" of type %"HEKf,
- SVfARG(*svp), SVfARG(lexname),
- HEKfARG(HvNAME_HEK(SvSTASH(lexname))));
- }
- }
- break;
- }
- case OP_ASLICE:
- S_scalar_slice_warning(aTHX_ o);
- break;
+ check_keys:
+ if (o->op_private & OPpLVAL_INTRO || rop->op_type != OP_RV2HV)
+ rop = NULL;
+ else if (rop->op_first->op_type == OP_PADSV)
+ /* @$hash{qw(keys here)} */
+ rop = (UNOP*)rop->op_first;
+ else {
+ /* @{$hash}{qw(keys here)} */
+ if (rop->op_first->op_type == OP_SCOPE
+ && cLISTOPx(rop->op_first)->op_last->op_type == OP_PADSV)
+ {
+ rop = (UNOP*)cLISTOPx(rop->op_first)->op_last;
+ }
+ else
+ rop = NULL;
+ }
- case OP_SUBST: {
- if (cPMOPo->op_pmreplrootu.op_pmreplroot)
- finalize_op(cPMOPo->op_pmreplrootu.op_pmreplroot);
- break;
- }
- default:
- break;
- }
+ lexname = NULL; /* just to silence compiler warnings */
+ fields = NULL; /* just to silence compiler warnings */
+
+ check_fields =
+ rop
+ && (lexname = *av_fetch(PL_comppad_name, rop->op_targ, TRUE),
+ SvPAD_TYPED(lexname))
+ && (fields = (GV**)hv_fetchs(SvSTASH(lexname), "FIELDS", FALSE))
+ && isGV(*fields) && GvHV(*fields);
+ for (; key_op;
+ key_op = (SVOP*)OP_SIBLING(key_op)) {
+ SV **svp, *sv;
+ if (key_op->op_type != OP_CONST)
+ continue;
+ svp = cSVOPx_svp(key_op);
+
+ /* Make the CONST have a shared SV */
+ if ((!SvIsCOW_shared_hash(sv = *svp))
+ && SvTYPE(sv) < SVt_PVMG && SvOK(sv) && !SvROK(sv)) {
+ SSize_t keylen;
+ const char * const key = SvPV_const(sv, *(STRLEN*)&keylen);
+ SV *nsv = newSVpvn_share(key,
+ SvUTF8(sv) ? -keylen : keylen, 0);
+ SvREFCNT_dec_NN(sv);
+ *svp = nsv;
+ }
- if (o->op_flags & OPf_KIDS) {
- OP *kid;
+ if (check_fields
+ && !hv_fetch_ent(GvHV(*fields), *svp, FALSE, 0)) {
+ Perl_croak(aTHX_ "No such class field \"%"SVf"\" "
+ "in variable %"SVf" of type %"HEKf,
+ SVfARG(*svp), SVfARG(lexname),
+ HEKfARG(HvNAME_HEK(SvSTASH(lexname))));
+ }
+ }
+ break;
+ }
+ case OP_ASLICE:
+ S_scalar_slice_warning(aTHX_ o);
+ break;
-#ifdef DEBUGGING
- /* check that op_last points to the last sibling, and that
- * the last op_sibling field points back to the parent, and
- * that the only ops with KIDS are those which are entitled to
- * them */
- U32 type = o->op_type;
- U32 family;
- bool has_last;
-
- if (type == OP_NULL) {
- type = o->op_targ;
- /* ck_glob creates a null UNOP with ex-type GLOB
- * (which is a list op. So pretend it wasn't a listop */
- if (type == OP_GLOB)
- type = OP_NULL;
+ case OP_SUBST: {
+ if (cPMOPo->op_pmreplrootu.op_pmreplroot)
+ finalize_op(cPMOPo->op_pmreplrootu.op_pmreplroot);
+ break;
}
- family = PL_opargs[type] & OA_CLASS_MASK;
-
- has_last = ( family == OA_BINOP
- || family == OA_LISTOP
- || family == OA_PMOP
- || family == OA_LOOP
- );
- assert( has_last /* has op_first and op_last, or ...
- ... has (or may have) op_first: */
- || family == OA_UNOP
- || family == OA_LOGOP
- || family == OA_BASEOP_OR_UNOP
- || family == OA_FILESTATOP
- || family == OA_LOOPEXOP
- || family == OA_METHOP
- /* I don't know why SASSIGN is tagged as OA_BASEOP - DAPM */
- || type == OP_SASSIGN
- || type == OP_CUSTOM
- || type == OP_NULL /* new_logop does this */
- );
- /* XXX list form of 'x' is has a null op_last. This is wrong,
- * but requires too much hacking (e.g. in Deparse) to fix for
- * now */
- if (type == OP_REPEAT && (o->op_private & OPpREPEAT_DOLIST)) {
- assert(has_last);
- has_last = 0;
+ default:
+ break;
}
- for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid)) {
-# ifdef PERL_OP_PARENT
- if (!OP_HAS_SIBLING(kid)) {
- if (has_last)
- assert(kid == cLISTOPo->op_last);
- assert(kid->op_sibling == o);
- }
-# else
- if (OP_HAS_SIBLING(kid)) {
- assert(!kid->op_lastsib);
+ if (o->op_flags & OPf_KIDS) {
+ OP *kid;
+
+#ifdef DEBUGGING
+ /* check that op_last points to the last sibling, and that
+ * the last op_sibling field points back to the parent, and
+ * that the only ops with KIDS are those which are entitled to
+ * them */
+ U32 type = o->op_type;
+ U32 family;
+ bool has_last;
+
+ if (type == OP_NULL) {
+ type = o->op_targ;
+ /* ck_glob creates a null UNOP with ex-type GLOB
+ * (which is a list op. So pretend it wasn't a listop */
+ if (type == OP_GLOB)
+ type = OP_NULL;
}
- else {
- assert(kid->op_lastsib);
- if (has_last)
- assert(kid == cLISTOPo->op_last);
+ family = PL_opargs[type] & OA_CLASS_MASK;
+
+ has_last = ( family == OA_BINOP
+ || family == OA_LISTOP
+ || family == OA_PMOP
+ || family == OA_LOOP
+ );
+ assert( has_last /* has op_first and op_last, or ...
+ ... has (or may have) op_first: */
+ || family == OA_UNOP
+ || family == OA_LOGOP
+ || family == OA_BASEOP_OR_UNOP
+ || family == OA_FILESTATOP
+ || family == OA_LOOPEXOP
+ || family == OA_METHOP
+ /* I don't know why SASSIGN is tagged as OA_BASEOP - DAPM */
+ || type == OP_SASSIGN
+ || type == OP_CUSTOM
+ || type == OP_NULL /* new_logop does this */
+ );
+ /* XXX list form of 'x' is has a null op_last. This is wrong,
+ * but requires too much hacking (e.g. in Deparse) to fix for
+ * now */
+ if (type == OP_REPEAT && (o->op_private & OPpREPEAT_DOLIST)) {
+ assert(has_last);
+ has_last = 0;
}
+
+ for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid)) {
+# ifdef PERL_OP_PARENT
+ if (!OP_HAS_SIBLING(kid)) {
+ if (has_last)
+ assert(kid == cLISTOPo->op_last);
+ assert(kid->op_sibling == o);
+ }
+# else
+ if (OP_HAS_SIBLING(kid)) {
+ assert(!kid->op_lastsib);
+ }
+ else {
+ assert(kid->op_lastsib);
+ if (has_last)
+ assert(kid == cLISTOPo->op_last);
+ }
# endif
- }
+ }
#endif
- {
- /* Count then fill from the top to ensure any diagnostics
- are produced in order from the start of the code.
- */
- SSize_t kid_count = 0;
- OP **fill;
- for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
- ++kid_count;
-
- DEFERRED_OP_ALLOC(kid_count, fill);
-
- for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
- *--fill = kid;
+ {
+ /* Count then fill from the top to ensure any diagnostics
+ are produced in order from the start of the code.
+ */
+ SSize_t kid_count = 0;
+ OP **fill;
+ for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
+ ++kid_count;
+
+ DEFERRED_OP_ALLOC(kid_count, fill);
+
+ for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
+ *--fill = kid;
+ }
}
- }
} while ( (o = POP_DEFERRED_OP()) );
DEFER_OP_END;
--
1.7.10.4
|
From @tonycoz0003-perl-108276-use-the-new-declare-and-clean-up-macros-.patchFrom cf5d0ab47de426134b6c2b1934b698aed98ad650 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 17 Nov 2014 17:35:10 +1100
Subject: [perl #108276] use the new declare and clean-up macros for the old
uses
---
op.c | 12 ++++--------
1 file changed, 4 insertions(+), 8 deletions(-)
diff --git a/op.c b/op.c
index 45e9c16..ea97abf 100644
--- a/op.c
+++ b/op.c
@@ -732,9 +732,7 @@ Perl_op_free(pTHX_ OP *o)
{
dVAR;
OPCODE type;
- SSize_t defer_ix = -1;
- SSize_t defer_stack_alloc = 0;
- OP **defer_stack = NULL;
+ DEFER_OP_DECLARE;
do {
@@ -821,7 +819,7 @@ Perl_op_free(pTHX_ OP *o)
#endif
} while ( (o = POP_DEFERRED_OP()) );
- Safefree(defer_stack);
+ DEFER_OP_END;
}
void
@@ -1649,9 +1647,7 @@ Perl_scalarvoid(pTHX_ OP *arg)
OP *kid;
SV* sv;
U8 want;
- SSize_t defer_stack_alloc = 0;
- SSize_t defer_ix = -1;
- OP **defer_stack = NULL;
+ DEFER_OP_DECLARE;
OP *o = arg;
PERL_ARGS_ASSERT_SCALARVOID;
@@ -2014,7 +2010,7 @@ Perl_scalarvoid(pTHX_ OP *arg)
}
} while ( (o = POP_DEFERRED_OP()) );
- Safefree(defer_stack);
+ DEFER_OP_END;
return arg;
}
--
1.7.10.4
|
From @iabynOn Sun, Nov 16, 2014 at 10:42:19PM -0800, Tony Cook via RT wrote:
Note that once PERL_OP_PARENT becomes the default in blead, the recursion -- |
From @tonycozOn Mon Nov 17 04:49:05 2014, davem wrote:
I started an attempt to use that chain, but unfortunately blead as it is now fails an assertion with -DPERL_OP_PARENT: tony@mars:.../git/perl$ make Tony |
From @tonycozOn Mon Nov 17 16:05:50 2014, tonyc wrote:
Build failure* bisected to: bad - could not build test-prep Make OP_METHOD* to be of new class METHOP I'll look at trying to fix this, unless someone beats me to it (out for a bit now) Tony * this is simply the first build failure found with -DPERL_OP_PARENT, there may be other op-tree bugs. |
From @tonycozOn Mon Nov 17 17:01:17 2014, tonyc wrote:
Turns out there were two problems, an earlier commit 2872f91 didn't add a needed parent link. Patch attached, I'll apply it tomorrow if no-one points out a problem with it. Tony |
From @tonycoz0001-fix-PERL_OP_PARENT-builds.patchFrom 22f53d964f94d524ba285bcd7e9a110d97e67821 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 18 Nov 2014 17:11:58 +1100
Subject: [PATCH] fix PERL_OP_PARENT builds
This was broken in two commits:
- b46e009d9 - introduced newMETHOP(), which didn't add the parent link
as newUNOP() was doing
- 2872f9187 - updated ck_sort() to handle lexical subs named as a
bareword parameter to sort, but didn't update the parent link in the
new PADCV op created.
---
op.c | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/op.c b/op.c
index 00c1255..728b927 100644
--- a/op.c
+++ b/op.c
@@ -4657,6 +4657,11 @@ S_newMETHOP_internal(pTHX_ I32 type, I32 flags, OP* dynamic_meth, SV* const_meth
methop->op_flags = (U8)(flags | OPf_KIDS);
methop->op_u.op_first = dynamic_meth;
methop->op_private = (U8)(1 | (flags >> 8));
+
+#ifdef PERL_OP_PARENT
+ if (!OP_HAS_SIBLING(dynamic_meth))
+ dynamic_meth->op_sibling = (OP*)methop;
+#endif
}
else {
assert(const_meth);
@@ -10649,6 +10654,9 @@ Perl_ck_sort(pTHX_ OP *o)
OP * const padop = newOP(OP_PADCV, 0);
padop->op_targ = off;
cUNOPx(firstkid)->op_first = padop;
+#ifdef PERL_OP_PARENT
+ padop->op_sibling = firstkid;
+#endif
op_free(kid);
}
}
--
1.7.10.4
|
From @iabynOn Mon, Nov 17, 2014 at 10:15:08PM -0800, Tony Cook via RT wrote:
Looks good to me, thanks. -- |
From @tonycozOn Mon Nov 17 04:49:05 2014, davem wrote:
Something like the attached? Applies on top of the other S_finalize_op() change. Tony |
From @tonycoz0001-perl-108276-use-the-PERL_OP_PARENT-links-in-S_finali.patchFrom 9f55fceda22a4ca097bc0a715f58a4dbb8a3aeae Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 19 Nov 2014 14:18:17 +1100
Subject: [perl #108276] use the PERL_OP_PARENT links in S_finalize_op() if
possible
---
embed.fnc | 3 +++
embed.h | 3 +++
op.c | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
proto.h | 8 ++++++++
4 files changed, 75 insertions(+), 2 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index 77ceca8..67da32a 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -910,6 +910,9 @@ poX |OP* |op_lvalue_flags|NULLOK OP* o|I32 type|U32 flags
p |void |finalize_optree |NN OP* o
#if defined(PERL_IN_OP_C)
s |void |finalize_op |NN OP* o
+# ifdef PERL_OP_PARENT
+s |OP* |traverse_op_tree|NN OP* top|NN OP* o
+# endif
s |void |move_proto_attr|NN OP **proto|NN OP **attrs|NN const GV *name
#endif
: Used in op.c and pp_sys.c
diff --git a/embed.h b/embed.h
index 7fddb5d..b8acf8b 100644
--- a/embed.h
+++ b/embed.h
@@ -1539,6 +1539,9 @@
#define simplify_sort(a) S_simplify_sort(aTHX_ a)
#define too_few_arguments_pv(a,b,c) S_too_few_arguments_pv(aTHX_ a,b,c)
#define too_many_arguments_pv(a,b,c) S_too_many_arguments_pv(aTHX_ a,b,c)
+# if defined(PERL_OP_PARENT)
+#define traverse_op_tree(a,b) S_traverse_op_tree(aTHX_ a,b)
+# endif
# if defined(USE_ITHREADS)
#define op_relocate_sv(a,b) S_op_relocate_sv(aTHX_ a,b)
# endif
diff --git a/op.c b/op.c
index eee542a..6c2482e 100644
--- a/op.c
+++ b/op.c
@@ -2197,15 +2197,64 @@ S_op_relocate_sv(pTHX_ SV** svp, PADOFFSET* targp)
}
#endif
+#ifdef PERL_OP_PARENT
+
+/*
+=for apidoc s|OP*|traverse_op_tree|OP* top|OP* o
+
+Return the next op in a depth-first traversal of the op tree,
+returning NULL when the traversal is complete.
+
+The initial call must supply the root of the tree as both top and o.
+
+This is only available under -DPERL_OP_PARENT.
+
+For now it's static, but it may be exposed to the API in the future.
+
+=cut
+*/
+
+STATIC OP*
+S_traverse_op_tree(OP *top, OP *o) {
+ OP *sib;
+
+ PERL_ARGS_ASSERT_TRAVERSE_OP_TREE;
+
+ if ((o->op_flags & OPf_KIDS) && cUNOPo->op_first) {
+ return cUNOPo->op_first;
+ }
+ else if ((sib = OP_SIBLING(o))) {
+ return sib;
+ }
+ else {
+ OP *parent = o->op_sibling;
+ while (parent && parent != top) {
+ OP *sib = OP_SIBLING(parent);
+ if (sib)
+ return sib;
+ parent = parent->op_sibling;
+ }
+
+ return NULL;
+ }
+}
+
+#endif
STATIC void
S_finalize_op(pTHX_ OP* o)
{
+#ifdef PERL_OP_PARENT
+ OP *top = o;
+#else
DEFER_OP_DECLARE;
+#endif
PERL_ARGS_ASSERT_FINALIZE_OP;
-
+ /*op_dump(o);*/
+ /*PerlIO_printf(PerlIO_stderr(), "entering loop\n");*/
do {
+ /*PerlIO_printf(PerlIO_stderr(), "op %p (%s) first %p sib %p lastsib %d\n", o, PL_op_name[o->op_type], cUNOPo->op_first, o->op_sibling, o->op_lastsib);*/
switch (o->op_type) {
case OP_NEXTSTATE:
case OP_DBSTATE:
@@ -2430,6 +2479,7 @@ S_finalize_op(pTHX_ OP* o)
# endif
}
#endif
+#ifndef PERL_OP_PARENT
{
/* Count then fill from the top to ensure any diagnostics
are produced in order from the start of the code.
@@ -2444,10 +2494,19 @@ S_finalize_op(pTHX_ OP* o)
for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
*--fill = kid;
}
+#endif
}
- } while ( (o = POP_DEFERRED_OP()) );
+ } while (
+#ifdef PERL_OP_PARENT
+ (o = S_traverse_op_tree(top, o))
+#else
+ (o = POP_DEFERRED_OP())
+#endif
+ );
+#ifndef PERL_OP_PARENT
DEFER_OP_END;
+#endif
}
/*
diff --git a/proto.h b/proto.h
index 656d6b4..d985cee 100644
--- a/proto.h
+++ b/proto.h
@@ -6366,6 +6366,14 @@ STATIC OP* S_too_many_arguments_pv(pTHX_ OP *o, const char* name, U32 flags)
#define PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS_PV \
assert(o); assert(name)
+# if defined(PERL_OP_PARENT)
+STATIC OP* S_traverse_op_tree(pTHX_ OP* top, OP* o)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_TRAVERSE_OP_TREE \
+ assert(top); assert(o)
+
+# endif
# if defined(USE_ITHREADS)
PERL_STATIC_INLINE void S_op_relocate_sv(pTHX_ SV** svp, PADOFFSET* targp)
__attribute__nonnull__(pTHX_1)
--
1.7.10.4
|
From @cpansproutOn Tue Nov 18 19:19:28 2014, tonyc wrote:
Would it be possible to make it even simpler to use? OP *o = whatever; FOR_EACH_OP_DESCENDENT(o, kid) { if (blah blah blah) goto finished; } -- Father Chrysostomos |
From @tonycozOn Tue Nov 18 21:56:19 2014, sprout wrote:
I'm not sure it's practical. It wouldn't be as simple as you've illustrated. It would be tricky to use with Perl_scalarvoid(), since it doesn't scalarvoid(o) every node in the tree, and would need a mechanism to skip a subtree. op_free() has a similar issue, since it skips already freed child ops and their sub-trees. It's also special in that it needs to store the link to the next node before processing the current node. op_finalize() is special compared to the others too, for op_free() and scalarvoid() it doesn't matter much which direction we iterate over children, but it does for finalize_op(), and it pays a small performance cost with the DEFER_OP() mechanism. A general mechanism would pass that cost onto op_free() and scalarvoid(). Tony |
From @tonycozOn Tue, 18 Nov 2014 19:19:28 -0800, tonyc wrote:
A new set of patches: - standalone finalize_op() fix, which requires PERL_OP_PARENT - DEFER_OP() fix for optimize_op() The final commit might not be needed. Tony |
From @tonycozop-recursion.patchFrom f003f14c35078fdf95a51ec8b7bd2d85fc92ded0 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 29 Jan 2019 13:57:51 +1100
Subject: (perl #108276) eliminate recursion from finalize_op()
whitespace in next commit
---
embed.fnc | 1 +
embed.h | 1 +
op.c | 48 +++++++++++++++++++++++++++++++++++++++++++-----
proto.h | 3 +++
4 files changed, 48 insertions(+), 5 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index bdb29f7216..d311ca7f51 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -563,6 +563,7 @@ i |OP* |newMETHOP_internal |I32 type|I32 flags|NULLOK OP* dynamic_meth \
|NULLOK SV* const_meth
: FIXME
s |OP* |fold_constants |NN OP * const o
+s |OP* |traverse_op_tree|NN OP* top|NN OP* o
#endif
Afpd |char* |form |NN const char* pat|...
Ap |char* |vform |NN const char* pat|NULLOK va_list* args
diff --git a/embed.h b/embed.h
index a94583870a..f3b95eadbd 100644
--- a/embed.h
+++ b/embed.h
@@ -1886,6 +1886,7 @@
#define simplify_sort(a) S_simplify_sort(aTHX_ a)
#define too_few_arguments_pv(a,b,c) S_too_few_arguments_pv(aTHX_ a,b,c)
#define too_many_arguments_pv(a,b,c) S_too_many_arguments_pv(aTHX_ a,b,c)
+#define traverse_op_tree(a,b) S_traverse_op_tree(aTHX_ a,b)
# if defined(USE_ITHREADS)
#define op_relocate_sv(a,b) S_op_relocate_sv(aTHX_ a,b)
# endif
diff --git a/op.c b/op.c
index d966848055..41067e7ff4 100644
--- a/op.c
+++ b/op.c
@@ -3537,12 +3537,52 @@ S_op_relocate_sv(pTHX_ SV** svp, PADOFFSET* targp)
}
#endif
+/*
+=for apidoc s|OP*|traverse_op_tree|OP* top|OP* o
+
+Return the next op in a depth-first traversal of the op tree,
+returning NULL when the traversal is complete.
+
+The initial call must supply the root of the tree as both top and o.
+
+For now it's static, but it may be exposed to the API in the future.
+
+=cut
+*/
+
+STATIC OP*
+S_traverse_op_tree(OP *top, OP *o) {
+ OP *sib;
+
+ PERL_ARGS_ASSERT_TRAVERSE_OP_TREE;
+
+ if ((o->op_flags & OPf_KIDS) && cUNOPo->op_first) {
+ return cUNOPo->op_first;
+ }
+ else if ((sib = OpSIBLING(o))) {
+ return sib;
+ }
+ else {
+ OP *parent = o->op_sibparent;
+ assert(!(o->op_moresib));
+ while (parent && parent != top) {
+ OP *sib = OpSIBLING(parent);
+ if (sib)
+ return sib;
+ parent = parent->op_sibparent;
+ }
+
+ return NULL;
+ }
+}
STATIC void
S_finalize_op(pTHX_ OP* o)
{
+ OP * const top = o;
PERL_ARGS_ASSERT_FINALIZE_OP;
+ do {
assert(o->op_type != OP_FREED);
switch (o->op_type) {
@@ -3659,10 +3699,10 @@ S_finalize_op(pTHX_ OP* o)
break;
}
+#ifdef DEBUGGING
if (o->op_flags & OPf_KIDS) {
OP *kid;
-#ifdef DEBUGGING
/* check that op_last points to the last sibling, and that
* the last op_sibling/op_sibparent field points back to the
* parent, and that the only ops with KIDS are those which are
@@ -3705,11 +3745,9 @@ S_finalize_op(pTHX_ OP* o)
assert(kid->op_sibparent == o);
}
}
-#endif
-
- for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
- finalize_op(kid);
}
+#endif
+ } while (( o = traverse_op_tree(top, o)) != NULL);
}
/*
diff --git a/proto.h b/proto.h
index 36a61db05d..daf338707b 100644
--- a/proto.h
+++ b/proto.h
@@ -5115,6 +5115,9 @@ STATIC OP* S_too_few_arguments_pv(pTHX_ OP *o, const char* name, U32 flags)
STATIC OP* S_too_many_arguments_pv(pTHX_ OP *o, const char* name, U32 flags);
#define PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS_PV \
assert(o); assert(name)
+STATIC OP* S_traverse_op_tree(pTHX_ OP* top, OP* o);
+#define PERL_ARGS_ASSERT_TRAVERSE_OP_TREE \
+ assert(top); assert(o)
# if defined(USE_ITHREADS)
#ifndef PERL_NO_INLINE_FUNCTIONS
PERL_STATIC_INLINE void S_op_relocate_sv(pTHX_ SV** svp, PADOFFSET* targp);
--
2.11.0
From 6bf66a2cd50fc888294f11b2c4c9a69dc8113c31 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 29 Jan 2019 14:22:02 +1100
Subject: (perl #108276) indent body of new finalize_op() loop
---
op.c | 260 +++++++++++++++++++++++++++++++++----------------------------------
1 file changed, 130 insertions(+), 130 deletions(-)
diff --git a/op.c b/op.c
index 41067e7ff4..befedb7c3c 100644
--- a/op.c
+++ b/op.c
@@ -3583,20 +3583,20 @@ S_finalize_op(pTHX_ OP* o)
PERL_ARGS_ASSERT_FINALIZE_OP;
do {
- assert(o->op_type != OP_FREED);
+ assert(o->op_type != OP_FREED);
- switch (o->op_type) {
- case OP_NEXTSTATE:
- case OP_DBSTATE:
- PL_curcop = ((COP*)o); /* for warnings */
- break;
- case OP_EXEC:
- if (OpHAS_SIBLING(o)) {
- OP *sib = OpSIBLING(o);
- if (( sib->op_type == OP_NEXTSTATE || sib->op_type == OP_DBSTATE)
- && ckWARN(WARN_EXEC)
- && OpHAS_SIBLING(sib))
- {
+ switch (o->op_type) {
+ case OP_NEXTSTATE:
+ case OP_DBSTATE:
+ PL_curcop = ((COP*)o); /* for warnings */
+ break;
+ case OP_EXEC:
+ if (OpHAS_SIBLING(o)) {
+ OP *sib = OpSIBLING(o);
+ if (( sib->op_type == OP_NEXTSTATE || sib->op_type == OP_DBSTATE)
+ && ckWARN(WARN_EXEC)
+ && OpHAS_SIBLING(sib))
+ {
const OPCODE type = OpSIBLING(sib)->op_type;
if (type != OP_EXIT && type != OP_WARN && type != OP_DIE) {
const line_t oldline = CopLINE(PL_curcop);
@@ -3607,145 +3607,145 @@ S_finalize_op(pTHX_ OP* o)
"\t(Maybe you meant system() when you said exec()?)\n");
CopLINE_set(PL_curcop, oldline);
}
- }
- }
- break;
+ }
+ }
+ break;
- case OP_GV:
- if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
- GV * const gv = cGVOPo_gv;
- if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX_const(GvCV(gv))) {
- /* XXX could check prototype here instead of just carping */
- SV * const sv = sv_newmortal();
- gv_efullname3(sv, gv, NULL);
- Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE),
- "%" SVf "() called too early to check prototype",
- SVfARG(sv));
- }
- }
- break;
+ case OP_GV:
+ if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
+ GV * const gv = cGVOPo_gv;
+ if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX_const(GvCV(gv))) {
+ /* XXX could check prototype here instead of just carping */
+ SV * const sv = sv_newmortal();
+ gv_efullname3(sv, gv, NULL);
+ Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE),
+ "%" SVf "() called too early to check prototype",
+ SVfARG(sv));
+ }
+ }
+ break;
- case OP_CONST:
- if (cSVOPo->op_private & OPpCONST_STRICT)
- no_bareword_allowed(o);
+ case OP_CONST:
+ if (cSVOPo->op_private & OPpCONST_STRICT)
+ no_bareword_allowed(o);
#ifdef USE_ITHREADS
- /* FALLTHROUGH */
- case OP_HINTSEVAL:
- op_relocate_sv(&cSVOPo->op_sv, &o->op_targ);
+ /* FALLTHROUGH */
+ case OP_HINTSEVAL:
+ op_relocate_sv(&cSVOPo->op_sv, &o->op_targ);
#endif
- break;
+ break;
#ifdef USE_ITHREADS
- /* Relocate all the METHOP's SVs to the pad for thread safety. */
- case OP_METHOD_NAMED:
- case OP_METHOD_SUPER:
- case OP_METHOD_REDIR:
- case OP_METHOD_REDIR_SUPER:
- op_relocate_sv(&cMETHOPx(o)->op_u.op_meth_sv, &o->op_targ);
- break;
+ /* Relocate all the METHOP's SVs to the pad for thread safety. */
+ case OP_METHOD_NAMED:
+ case OP_METHOD_SUPER:
+ case OP_METHOD_REDIR:
+ case OP_METHOD_REDIR_SUPER:
+ op_relocate_sv(&cMETHOPx(o)->op_u.op_meth_sv, &o->op_targ);
+ break;
#endif
- case OP_HELEM: {
- UNOP *rop;
- SVOP *key_op;
- OP *kid;
+ case OP_HELEM: {
+ UNOP *rop;
+ SVOP *key_op;
+ OP *kid;
- if ((key_op = cSVOPx(((BINOP*)o)->op_last))->op_type != OP_CONST)
- break;
+ if ((key_op = cSVOPx(((BINOP*)o)->op_last))->op_type != OP_CONST)
+ break;
- rop = (UNOP*)((BINOP*)o)->op_first;
+ rop = (UNOP*)((BINOP*)o)->op_first;
- goto check_keys;
+ goto check_keys;
- case OP_HSLICE:
- S_scalar_slice_warning(aTHX_ o);
- /* FALLTHROUGH */
+ case OP_HSLICE:
+ S_scalar_slice_warning(aTHX_ o);
+ /* FALLTHROUGH */
- case OP_KVHSLICE:
- kid = OpSIBLING(cLISTOPo->op_first);
- if (/* I bet there's always a pushmark... */
- OP_TYPE_ISNT_AND_WASNT_NN(kid, OP_LIST)
- && OP_TYPE_ISNT_NN(kid, OP_CONST))
- {
- break;
- }
+ case OP_KVHSLICE:
+ kid = OpSIBLING(cLISTOPo->op_first);
+ if (/* I bet there's always a pushmark... */
+ OP_TYPE_ISNT_AND_WASNT_NN(kid, OP_LIST)
+ && OP_TYPE_ISNT_NN(kid, OP_CONST))
+ {
+ break;
+ }
- key_op = (SVOP*)(kid->op_type == OP_CONST
- ? kid
- : OpSIBLING(kLISTOP->op_first));
+ key_op = (SVOP*)(kid->op_type == OP_CONST
+ ? kid
+ : OpSIBLING(kLISTOP->op_first));
- rop = (UNOP*)((LISTOP*)o)->op_last;
+ rop = (UNOP*)((LISTOP*)o)->op_last;
- check_keys:
- if (o->op_private & OPpLVAL_INTRO || rop->op_type != OP_RV2HV)
- rop = NULL;
- S_check_hash_fields_and_hekify(aTHX_ rop, key_op);
- break;
- }
- case OP_NULL:
- if (o->op_targ != OP_HSLICE && o->op_targ != OP_ASLICE)
- break;
- /* FALLTHROUGH */
- case OP_ASLICE:
- S_scalar_slice_warning(aTHX_ o);
- break;
+ check_keys:
+ if (o->op_private & OPpLVAL_INTRO || rop->op_type != OP_RV2HV)
+ rop = NULL;
+ S_check_hash_fields_and_hekify(aTHX_ rop, key_op);
+ break;
+ }
+ case OP_NULL:
+ if (o->op_targ != OP_HSLICE && o->op_targ != OP_ASLICE)
+ break;
+ /* FALLTHROUGH */
+ case OP_ASLICE:
+ S_scalar_slice_warning(aTHX_ o);
+ break;
- case OP_SUBST: {
- if (cPMOPo->op_pmreplrootu.op_pmreplroot)
- finalize_op(cPMOPo->op_pmreplrootu.op_pmreplroot);
- break;
- }
- default:
- break;
- }
+ case OP_SUBST: {
+ if (cPMOPo->op_pmreplrootu.op_pmreplroot)
+ finalize_op(cPMOPo->op_pmreplrootu.op_pmreplroot);
+ break;
+ }
+ default:
+ break;
+ }
#ifdef DEBUGGING
- if (o->op_flags & OPf_KIDS) {
- OP *kid;
+ if (o->op_flags & OPf_KIDS) {
+ OP *kid;
- /* check that op_last points to the last sibling, and that
- * the last op_sibling/op_sibparent field points back to the
- * parent, and that the only ops with KIDS are those which are
- * entitled to them */
- U32 type = o->op_type;
- U32 family;
- bool has_last;
-
- if (type == OP_NULL) {
- type = o->op_targ;
- /* ck_glob creates a null UNOP with ex-type GLOB
- * (which is a list op. So pretend it wasn't a listop */
- if (type == OP_GLOB)
- type = OP_NULL;
- }
- family = PL_opargs[type] & OA_CLASS_MASK;
-
- has_last = ( family == OA_BINOP
- || family == OA_LISTOP
- || family == OA_PMOP
- || family == OA_LOOP
- );
- assert( has_last /* has op_first and op_last, or ...
- ... has (or may have) op_first: */
- || family == OA_UNOP
- || family == OA_UNOP_AUX
- || family == OA_LOGOP
- || family == OA_BASEOP_OR_UNOP
- || family == OA_FILESTATOP
- || family == OA_LOOPEXOP
- || family == OA_METHOP
- || type == OP_CUSTOM
- || type == OP_NULL /* new_logop does this */
- );
-
- for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
- if (!OpHAS_SIBLING(kid)) {
- if (has_last)
- assert(kid == cLISTOPo->op_last);
- assert(kid->op_sibparent == o);
+ /* check that op_last points to the last sibling, and that
+ * the last op_sibling/op_sibparent field points back to the
+ * parent, and that the only ops with KIDS are those which are
+ * entitled to them */
+ U32 type = o->op_type;
+ U32 family;
+ bool has_last;
+
+ if (type == OP_NULL) {
+ type = o->op_targ;
+ /* ck_glob creates a null UNOP with ex-type GLOB
+ * (which is a list op. So pretend it wasn't a listop */
+ if (type == OP_GLOB)
+ type = OP_NULL;
+ }
+ family = PL_opargs[type] & OA_CLASS_MASK;
+
+ has_last = ( family == OA_BINOP
+ || family == OA_LISTOP
+ || family == OA_PMOP
+ || family == OA_LOOP
+ );
+ assert( has_last /* has op_first and op_last, or ...
+ ... has (or may have) op_first: */
+ || family == OA_UNOP
+ || family == OA_UNOP_AUX
+ || family == OA_LOGOP
+ || family == OA_BASEOP_OR_UNOP
+ || family == OA_FILESTATOP
+ || family == OA_LOOPEXOP
+ || family == OA_METHOP
+ || type == OP_CUSTOM
+ || type == OP_NULL /* new_logop does this */
+ );
+
+ for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
+ if (!OpHAS_SIBLING(kid)) {
+ if (has_last)
+ assert(kid == cLISTOPo->op_last);
+ assert(kid->op_sibparent == o);
+ }
}
}
- }
#endif
} while (( o = traverse_op_tree(top, o)) != NULL);
}
--
2.11.0
From c13919ff3cfb99b5660bd0e20021c92cffb594cd Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 29 Jan 2019 15:03:43 +1100
Subject: (perl #108276) add wrappers for deferred op processing
To avoid duplication of the declarations.
---
op.c | 17 +++++++++--------
1 file changed, 9 insertions(+), 8 deletions(-)
diff --git a/op.c b/op.c
index befedb7c3c..8ed48b293b 100644
--- a/op.c
+++ b/op.c
@@ -175,6 +175,11 @@ static const char array_passed_to_stat[] = "Array passed to stat will be coerced
op_free()
*/
+#define dDEFER_OP \
+ SSize_t defer_stack_alloc = 0; \
+ SSize_t defer_ix = -1; \
+ OP **defer_stack = NULL;
+#define DEFER_OP_CLEANUP Safefree(defer_stack)
#define DEFERRED_OP_STEP 100
#define DEFER_OP(o) \
STMT_START { \
@@ -770,9 +775,7 @@ Perl_op_free(pTHX_ OP *o)
{
dVAR;
OPCODE type;
- SSize_t defer_ix = -1;
- SSize_t defer_stack_alloc = 0;
- OP **defer_stack = NULL;
+ dDEFER_OP;
do {
@@ -870,7 +873,7 @@ Perl_op_free(pTHX_ OP *o)
PL_op = NULL;
} while ( (o = POP_DEFERRED_OP()) );
- Safefree(defer_stack);
+ DEFER_OP_CLEANUP;
}
/* S_op_clear_gv(): free a GV attached to an OP */
@@ -1892,10 +1895,8 @@ Perl_scalarvoid(pTHX_ OP *arg)
dVAR;
OP *kid;
SV* sv;
- SSize_t defer_stack_alloc = 0;
- SSize_t defer_ix = -1;
- OP **defer_stack = NULL;
OP *o = arg;
+ dDEFER_OP;
PERL_ARGS_ASSERT_SCALARVOID;
@@ -2256,7 +2257,7 @@ Perl_scalarvoid(pTHX_ OP *arg)
}
} while ( (o = POP_DEFERRED_OP()) );
- Safefree(defer_stack);
+ DEFER_OP_CLEANUP;
return arg;
}
--
2.11.0
From 1a0de2e84c170d316c95b4323525eac85bef5802 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 29 Jan 2019 16:29:04 +1100
Subject: (perl #108276) remove recursion from optimize_op()
The prevented code like:
./miniperl -e 'my $line = "\$cond ? \$a : \n"; my $code = ($line x 100000) . "\$b;\n"; eval $code;'
from crashing due to stack overflow.
It does however take a long time to compile.
Because it doesn't strictly recurse through the op tree (due
to OP_SUBST), I couldn't use traverse_op_tree().
I considered wrapping a traverse_op_tree() loop inside a defer op
loop, so OP_SUBST would defer its op, but processing order is
somewhat important from setting PL_curcop.
This also processes the child ops in reverse order, I'm not sure if
that's a real problem (no tests failed), but the next commit fixes
that order.
---
op.c | 16 ++++++++++------
1 file changed, 10 insertions(+), 6 deletions(-)
diff --git a/op.c b/op.c
index 8ed48b293b..0db0128500 100644
--- a/op.c
+++ b/op.c
@@ -3459,9 +3459,10 @@ Perl_optimize_optree(pTHX_ OP* o)
STATIC void
S_optimize_op(pTHX_ OP* o)
{
- OP *kid;
+ dDEFER_OP;
PERL_ARGS_ASSERT_OPTIMIZE_OP;
+ do {
assert(o->op_type != OP_FREED);
switch (o->op_type) {
@@ -3480,18 +3481,21 @@ S_optimize_op(pTHX_ OP* o)
case OP_SUBST:
if (cPMOPo->op_pmreplrootu.op_pmreplroot)
- optimize_op(cPMOPo->op_pmreplrootu.op_pmreplroot);
+ DEFER_OP(cPMOPo->op_pmreplrootu.op_pmreplroot);
break;
default:
break;
}
- if (!(o->op_flags & OPf_KIDS))
- return;
+ if (o->op_flags & OPf_KIDS) {
+ OP *kid;
+ for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
+ DEFER_OP(kid);
+ }
+ } while ( ( o = POP_DEFERRED_OP() ) );
- for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
- optimize_op(kid);
+ DEFER_OP_CLEANUP;
}
--
2.11.0
From e95b861e282cb218336589bb74790651183e1d88 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 30 Jan 2019 11:06:52 +1100
Subject: (perl #108276) indent optimize_op() loop body
---
op.c | 48 ++++++++++++++++++++++++------------------------
1 file changed, 24 insertions(+), 24 deletions(-)
diff --git a/op.c b/op.c
index 0db0128500..35414bef16 100644
--- a/op.c
+++ b/op.c
@@ -3463,36 +3463,36 @@ S_optimize_op(pTHX_ OP* o)
PERL_ARGS_ASSERT_OPTIMIZE_OP;
do {
- assert(o->op_type != OP_FREED);
+ assert(o->op_type != OP_FREED);
- switch (o->op_type) {
- case OP_NEXTSTATE:
- case OP_DBSTATE:
- PL_curcop = ((COP*)o); /* for warnings */
- break;
+ switch (o->op_type) {
+ case OP_NEXTSTATE:
+ case OP_DBSTATE:
+ PL_curcop = ((COP*)o); /* for warnings */
+ break;
- case OP_CONCAT:
- case OP_SASSIGN:
- case OP_STRINGIFY:
- case OP_SPRINTF:
- S_maybe_multiconcat(aTHX_ o);
- break;
+ case OP_CONCAT:
+ case OP_SASSIGN:
+ case OP_STRINGIFY:
+ case OP_SPRINTF:
+ S_maybe_multiconcat(aTHX_ o);
+ break;
- case OP_SUBST:
- if (cPMOPo->op_pmreplrootu.op_pmreplroot)
- DEFER_OP(cPMOPo->op_pmreplrootu.op_pmreplroot);
- break;
+ case OP_SUBST:
+ if (cPMOPo->op_pmreplrootu.op_pmreplroot)
+ DEFER_OP(cPMOPo->op_pmreplrootu.op_pmreplroot);
+ break;
- default:
- break;
- }
+ default:
+ break;
+ }
- if (o->op_flags & OPf_KIDS) {
- OP *kid;
- for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
- DEFER_OP(kid);
- }
+ if (o->op_flags & OPf_KIDS) {
+ OP *kid;
+ for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
+ DEFER_OP(kid);
+ }
} while ( ( o = POP_DEFERRED_OP() ) );
DEFER_OP_CLEANUP;
--
2.11.0
From 4a1bb46bb07cba6823f9a55c5cb343f26b7d55f2 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 29 Jan 2019 16:29:38 +1100
Subject: (perl #108276) optimize child ops in sibling order
---
op.c | 22 +++++++++++++++++++++-
1 file changed, 21 insertions(+), 1 deletion(-)
diff --git a/op.c b/op.c
index 35414bef16..8a61b8b616 100644
--- a/op.c
+++ b/op.c
@@ -190,6 +190,22 @@ static const char array_passed_to_stat[] = "Array passed to stat will be coerced
} \
defer_stack[++defer_ix] = o; \
} STMT_END
+#define DEFER_REVERSE(count) \
+ STMT_START { \
+ UV cnt = (count); \
+ if (cnt > 1) { \
+ OP **top = defer_stack + defer_ix; \
+ /* top - (cnt) + 1 isn't safe here */ \
+ OP **bottom = top - (cnt - 1); \
+ OP *tmp; \
+ assert(bottom >= defer_stack); \
+ while (top > bottom) { \
+ tmp = *top; \
+ *top-- = *bottom; \
+ *bottom++ = tmp; \
+ } \
+ } \
+ } STMT_END;
#define POP_DEFERRED_OP() (defer_ix >= 0 ? defer_stack[defer_ix--] : (OP *)NULL)
@@ -3490,8 +3506,12 @@ S_optimize_op(pTHX_ OP* o)
if (o->op_flags & OPf_KIDS) {
OP *kid;
- for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
+ IV child_count = 0;
+ for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
DEFER_OP(kid);
+ ++child_count;
+ }
+ DEFER_REVERSE(child_count);
}
} while ( ( o = POP_DEFERRED_OP() ) );
--
2.11.0
|
From @iabynOn Tue, Jan 29, 2019 at 04:47:14PM -0800, Tony Cook via RT wrote:
They look plausible
Dunno. -- |
From @tonycozOn Tue, 29 Jan 2019 16:47:14 -0800, tonyc wrote:
Applied as 7f8280c through ee367d4. Tony |
|
@tonycoz is there anything left to do for this ticket? |
hvds
added
the
Closable?
|
@bulk88, we believe this (8-year-old !) ticket is closable ... and will close it in 7 days unless we hear from you otherwise. Thanks. |
|
Its closeable. |
Thanks! |
jkeenan
removed
the
Closable?
Migrated from rt.perl.org#108276 (status was 'open')
Searchable as RT108276$
The text was updated successfully, but these errors were encountered: