From: Father Chrysostomos <sprout@cpan.org>
Date: Mon, 29 Nov 2010 14:05:35 +0000 (-0800)
Subject: [perl #63540] bizarre closure lossage
X-Git-Tag: accepted/trunk/20130322.191538~6586^2~64
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=dbe92b04c262cab7908c1678a21a3dac03a61e15;p=platform%2Fupstream%2Fperl.git

[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
--- 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
--- 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 };
+}