[perl #63540] bizarre closure lossage

main::b in this example shows a null op that has the if() statement
attached to it.

$ perl -MO=Concise,a,b -e 'my $x;sub a {$x}; sub b{if($x){}0}'
main::a:
3  <1> leavesub[1 ref] K/REFC,1 ->(end)
-     <@> lineseq KP ->3
1        <;> nextstate(main 2 -e:1) v ->2
2        <0> padsv[$x:FAKE:] ->3
main::b:
a  <1> leavesub[1 ref] K/REFC,1 ->(end)
-     <@> lineseq KP ->a
4        <;> nextstate(main 5 -e:1) v ->5
-        <1> null vK/1 ->8
6           <|> and(other->7) vK/1 ->8
5              <0> padsv[$x:FAKE:] s ->6
-              <@> scope vK ->-
7                 <0> stub v ->8
8        <;> nextstate(main 5 -e:1) v ->9
9        <$> const[IV 0] s ->a
-e syntax OK

Perl_op_const_sv has:

	    if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
		continue;

It traverses from the null to the const. The const’s op_next pointer
points to the leavesub, so it is taken to be a constant.

It returns to newATTRSUB, which turns on CvCONST without assigning a
constant value.

Later, cv_clone (called by pp_anoncode) calls op_const_sv again. The
latter returns the SV from the first PADSV it finds, which is the $x
in if($x).

This commit stops op_const_sv from skipping over null ops that
have children.

diff --git a/op.c b/op.c
index 4c3c876..20083ad 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6023,7 +6023,9 @@ Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
        if (sv && o->op_next == o)
            return sv;
        if (o->op_next != o) {
-           if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
+           if (type == OP_NEXTSTATE
+            || (type == OP_NULL && !(o->op_flags & OPf_KIDS))
+            || type == OP_PUSHMARK)
                continue;
            if (type == OP_DBSTATE)
                continue;

diff --git a/t/op/closure.t b/t/op/closure.t
index 5e3bf45..1248cf5 100644 (file)
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -14,7 +14,7 @@ BEGIN {
 use Config;
 require './test.pl'; # for runperl()
 
-print "1..188\n";
+print "1..190\n";
 
 my $test = 1;
 sub test (&) {
@@ -701,6 +701,18 @@ sub f {
     test { $r1 != $r2 };
 }
 
+# [perl #63540] Don’t treat sub { if(){.....}; "constant" } as a constant
 
+BEGIN {
+  my $x = 7;
+  *baz = sub() { if($x){ () = "tralala"; blonk() }; 0 }
+}
+{
+  my $blonk_was_called;
+  *blonk = sub { ++$blonk_was_called };
+  my $ret = baz();
+  test { $ret == 0 or diag("got $ret at line ".__LINE__),0 };
+  test { $blonk_was_called };
+}