develooper Front page | perl.perl5.changes | Postings from September 2019

[perl.git] branch blead updated. v5.31.4-25-gf5a59698ee

From:
Dave Mitchell
Date:
September 25, 2019 20:59
Subject:
[perl.git] branch blead updated. v5.31.4-25-gf5a59698ee
Message ID:
E1iDENJ-0004EY-Is@git.dc.perl.space
In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/f5a59698ee00a9f6abaf832459625e5f51700539?hp=245c91834d573fb7ef487699a31b977fd6aa18ba>

- Log -----------------------------------------------------------------
commit f5a59698ee00a9f6abaf832459625e5f51700539
Merge: 245c91834d 6c4d6ec6da
Author: David Mitchell <davem@iabyn.com>
Date:   Wed Sep 25 21:51:50 2019 +0100

    [MERGE] little fixups to signature tweaks
    
    v5.31.4-18-g9fb6174d08 tweaked a few signature-related things but
    introduced a leak in the test suite and left some debugging code in.

commit 6c4d6ec6dad9f68db2e3ae2a5acb6586a63e5315
Author: David Mitchell <davem@iabyn.com>
Date:   Wed Sep 25 21:46:47 2019 +0100

    fix leak in APItest.xs
    
    The leak Was introduced by my recent commit v5.31.4-16-g4df857782a,
    which added an extra op at the head of a signature subtree, but which
    wasn't being freed by the code in the parse_subsignature test.

commit 3b392ccb69551bb83f74cbe7bb62f458cf47cf95
Author: David Mitchell <davem@iabyn.com>
Date:   Wed Sep 25 18:34:09 2019 +0100

    Perl_Slab_Alloc(): tweak logging
    
    When looking for a suitable op-sized chunk of memory in a slab's free
    list, perl logs the search but doesn't log a successful match. Add such
    a log line to make analysis of the output of 'perl -DS' easier.

commit 061646cff7112212a99ecee007465aebd19baee1
Author: David Mitchell <davem@iabyn.com>
Date:   Tue Sep 24 13:45:20 2019 +0100

    XS-APItest/t/subsignature.t: remove debugging code
    
    I accidentally left a temporary Data::Dumper line in it.

-----------------------------------------------------------------------

Summary of changes:
 ext/XS-APItest/APItest.xs       | 8 ++++----
 ext/XS-APItest/t/subsignature.t | 1 -
 op.c                            | 4 ++++
 3 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index cd58b526a6..777add5ba3 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -1055,7 +1055,7 @@ static OP *THX_parse_keyword_arrayexprflags(pTHX)
 #define parse_keyword_subsignature() THX_parse_keyword_subsignature(aTHX)
 static OP *THX_parse_keyword_subsignature(pTHX)
 {
-    OP *retop = NULL, *sigop = parse_subsignature(0);
+    OP *retop = NULL, *listop, *sigop = parse_subsignature(0);
     OP *kid;
     int seen_nextstate = 0;
 
@@ -1070,12 +1070,12 @@ static OP *THX_parse_keyword_subsignature(pTHX)
     
     if(!(sigop->op_flags & OPf_KIDS))
 	croak("Expected parse_subsignature() to yield an OP_NULL with kids");
-    sigop = cUNOPx(sigop)->op_first;
+    listop = cUNOPx(sigop)->op_first;
 
-    if(sigop->op_type != OP_LINESEQ)
+    if(listop->op_type != OP_LINESEQ)
 	croak("Expected parse_subsignature() to yield an OP_LINESEQ");
 
-    for(kid = cLISTOPx(sigop)->op_first; kid; kid = OpSIBLING(kid)) {
+    for(kid = cLISTOPx(listop)->op_first; kid; kid = OpSIBLING(kid)) {
 	switch(kid->op_type) {
 	    case OP_NEXTSTATE:
 		/* Only emit the first one otherwise they get boring */
diff --git a/ext/XS-APItest/t/subsignature.t b/ext/XS-APItest/t/subsignature.t
index 396fb02291..f7d0e25bce 100644
--- a/ext/XS-APItest/t/subsignature.t
+++ b/ext/XS-APItest/t/subsignature.t
@@ -18,7 +18,6 @@ eval q{
 	push @t, (subsignature $one = 1);
 };
 is $@, "";
-use Data::Dumper; print Dumper \@t;
 is_deeply \@t, [
 	['nextstate:4', 'argcheck:2:0:-', 'argelem:$x', 'argelem:$y'],
 	['nextstate:5', 'argcheck:2:0:-', 'argelem:$z',],
diff --git a/op.c b/op.c
index e875a90433..cc324fe8c7 100644
--- a/op.c
+++ b/op.c
@@ -316,6 +316,10 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
 	    if (o) { DEBUG_S_warn((aTHX_ "found another free op at %p", (void*)o)); }
 	}
 	if (o) {
+            DEBUG_S_warn((aTHX_ "realloced  op at %p, slab %p, head slab %p",
+                (void*)o,
+                (I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset,
+                (void*)head_slab));
 	    *too = o->op_next;
 	    Zero(o, opsz, I32 *);
 	    o->op_slabbed = 1;

-- 
Perl5 Master Repository



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About