[perl #77762] Constant assignment warning

With this patch:

$ ./perl -we 'sub A () {1}; if (0) {my $foo = A or die}'
$ ./perl -we 'sub A () {1}; if (0) {my $foo = 1 or die}'
Found = in conditional, should be == at -e line 1.

Since the value of a constant may not be known at the time the program
is written, it should be perfectly acceptable to do a constant assign-
ment in a conditional.

6 files changed, 24 insertions, 13 deletions

diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t
index f293228892..c0f49328ab 100644
--- a/ext/B/t/optree_constants.t
+++ b/ext/B/t/optree_constants.t
@@ -110,12 +110,12 @@ for $func (sort keys %$want) {
 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 -     <\@> lineseq KP ->3
 1        <;> dbstate(main 833 (eval 44):1) v ->2
-2        <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3
+2        <\$> const[$want->{$func}[0] $want->{$func}[1]] s* ->3
 EOT_EOT
 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 -     <\@> lineseq KP ->3
 1        <;> dbstate(main 833 (eval 44):1) v ->2
-2        <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3
+2        <\$> const($want->{$func}[0] $want->{$func}[1]) s* ->3
 EONT_EONT
 
 }
@@ -143,14 +143,14 @@ checkOptree ( name	=> 'myyes() as coderef',
 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
 # 5     <@> print vK ->6
 # 3        <0> pushmark s ->4
-# 4        <$> const[SPECIAL sv_yes] s ->5
+# 4        <$> const[SPECIAL sv_yes] s* ->5
 EOT_EOT
 # 6  <@> leave[1 ref] vKP/REFC ->(end)
 # 1     <0> enter ->2
 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
 # 5     <@> print vK ->6
 # 3        <0> pushmark s ->4
-# 4        <$> const(SPECIAL sv_yes) s ->5
+# 4        <$> const(SPECIAL sv_yes) s* ->5
 EONT_EONT
 
 
@@ -167,14 +167,14 @@ checkOptree ( name	=> 'myno() as coderef',
 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
 # 5     <@> print vK ->6
 # 3        <0> pushmark s ->4
-# 4        <$> const[SPECIAL sv_no] s ->5
+# 4        <$> const[SPECIAL sv_no] s* ->5
 EOT_EOT
 # 6  <@> leave[1 ref] vKP/REFC ->(end)
 # 1     <0> enter ->2
 # 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
 # 5     <@> print vK ->6
 # 3        <0> pushmark s ->4
-# 4        <$> const(SPECIAL sv_no) s ->5
+# 4        <$> const(SPECIAL sv_no) s* ->5
 EONT_EONT
 
 
@@ -224,10 +224,10 @@ EOT_EOT
 # 8        <@> prtf sK ->9
 # 2           <0> pushmark s ->3
 # 3           <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
-# 4           <$> const(IV 42) s ->5
-# 5           <$> const(PV "hithere") s ->6
-# 6           <$> const(NV 1.414213) s ->7
-# 7           <$> const(NV 3.14159) s ->8
+# 4           <$> const(IV 42) s* ->5
+# 5           <$> const(PV "hithere") s* ->6
+# 6           <$> const(NV 1.414213) s* ->7
+# 7           <$> const(NV 3.14159) s* ->8
 EONT_EONT
 
 if($] < 5.009) {
diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t
index e61c970cdf..4e25676b04 100644
--- a/ext/B/t/optree_samples.t
+++ b/ext/B/t/optree_samples.t
@@ -616,14 +616,14 @@ checkOptree ( name	=> '-e use constant j => qq{junk}; print j',
 # 1  <0> enter 
 # 2  <;> nextstate(main 71 -e:1) v:>,<,%,{
 # 3  <0> pushmark s
-# 4  <$> const[PV "junk"] s
+# 4  <$> const[PV "junk"] s*
 # 5  <@> print vK
 # 6  <@> leave[1 ref] vKP/REFC
 EOT_EOT
 # 1  <0> enter 
 # 2  <;> nextstate(main 71 -e:1) v:>,<,%,{
 # 3  <0> pushmark s
-# 4  <$> const(PV "junk") s
+# 4  <$> const(PV "junk") s*
 # 5  <@> print vK
 # 6  <@> leave[1 ref] vKP/REFC
 EONT_EONT
diff --git a/op.c b/op.c
index 20083ad4c4..469a008c8e 100644
--- a/op.c
+++ b/op.c
@@ -910,7 +910,8 @@ S_scalarboolean(pTHX_ OP *o)
 
     PERL_ARGS_ASSERT_SCALARBOOLEAN;
 
-    if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
+    if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST
+     && !(cBINOPo->op_first->op_flags & OPf_SPECIAL)) {
 	if (ckWARN(WARN_SYNTAX)) {
 	    const line_t oldline = CopLINE(PL_curcop);
 
diff --git a/op.h b/op.h
index c011d661f9..2c8e7fc2ca 100644
--- a/op.h
+++ b/op.h
@@ -145,6 +145,7 @@ Deprecated.  Use C<GIMME_V> instead.
 				    operand of a logical or conditional
 				    that was optimised away, so it should
 				    not be bound via =~ */
+				/*  On OP_CONST, from a constant CV */
 
 /* old names; don't use in new code, but don't break them, either */
 #define OPf_LIST	OPf_WANT_LIST
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index 962ff5879f..e596e7918a 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -106,6 +106,14 @@ EXPECT
 Found = in conditional, should be == at - line 3.
 ########
 # op.c
+use warnings 'syntax' ;
+use constant foo => 1;
+1 if $a = foo ;
+no warnings 'syntax' ;
+1 if $a = foo ;
+EXPECT
+########
+# op.c
 my (@foo, %foo);
 %main::foo->{"bar"};
 %foo->{"bar"};
diff --git a/toke.c b/toke.c
index 476b331043..aa1f57c880 100644
--- a/toke.c
+++ b/toke.c
@@ -6514,6 +6514,7 @@ Perl_yylex(pTHX)
 			SvREFCNT_dec(((SVOP*)pl_yylval.opval)->op_sv);
 			((SVOP*)pl_yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
 			pl_yylval.opval->op_private = 0;
+			pl_yylval.opval->op_flags |= OPf_SPECIAL;
 			TOKEN(WORD);
 		    }