summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2022-07-31 22:56:01 +0100
committerDavid Mitchell <davem@iabyn.com>2022-07-31 22:56:01 +0100
commitf365b85076de09f3ac70088e681735c3272a21e4 (patch)
tree7a463b5d23fd7354d38df0dc52e06f78b9531c02
parentcf59ced9dc04ad4430d240340f62cd06ff464eb1 (diff)
downloadperl-f365b85076de09f3ac70088e681735c3272a21e4.tar.gz
fix B::walkoptree_debug()
It turns out that this method has been mostly broken since its introduction in 1998. It will normally successfully turn debugging on with a 'true' argument but will fail to disable again with a 'false' argument. This is for two reasons. First the XS code only ever sets the internal debugging flag, never disables it, and second, it was checking the truthfulness of the arg one too high on the stack and thus was actually checking the CV which had just been popped off the stack, which happened to be true.
-rw-r--r--ext/B/B.xs4
-rw-r--r--ext/B/t/walkoptree.t6
2 files changed, 7 insertions, 3 deletions
diff --git a/ext/B/B.xs b/ext/B/B.xs
index c317ed43f2..7c60e4ad10 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -703,8 +703,8 @@ walkoptree_debug(...)
CODE:
dMY_CXT;
RETVAL = walkoptree_debug;
- if (items > 0 && SvTRUE(ST(1)))
- walkoptree_debug = 1;
+ if (items > 0)
+ walkoptree_debug = SvTRUE(ST(0));
OUTPUT:
RETVAL
diff --git a/ext/B/t/walkoptree.t b/ext/B/t/walkoptree.t
index e7a39b1624..29aaf47409 100644
--- a/ext/B/t/walkoptree.t
+++ b/ext/B/t/walkoptree.t
@@ -48,7 +48,11 @@ foreach (qw(substcont split leavesub)) {
is_deeply ([keys %debug], [], 'walkoptree_debug was not called');
B::walkoptree_debug(2);
-is (B::walkoptree_debug, 1, 'walkoptree_debug() is 1');
+is (B::walkoptree_debug(), 1, 'walkoptree_debug() is 1');
+B::walkoptree_debug(0);
+is (B::walkoptree_debug(), 0, 'walkoptree_debug() is 0');
+B::walkoptree_debug(1);
+is (B::walkoptree_debug(), 1, 'walkoptree_debug() is 1 again');
%seen = ();
B::walkoptree(B::svref_2object($victim)->ROOT, "pie");