develooper Front page | perl.perl5.changes | Postings from November 2010

[perl.git] branch blead, updated. v5.13.7-213-gba781e0

From:
Father Chrysostomos
Date:
November 30, 2010 08:43
Subject:
[perl.git] branch blead, updated. v5.13.7-213-gba781e0
Message ID:
E1PNTIk-0005EX-Ee@camel.ams6.corp.booking.com
In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/ba781e0dc9f7630534d9110ae60d4cd6482b77d4?hp=d9a4b459f94297889956ac3adc42707365f274c2>

- Log -----------------------------------------------------------------
commit ba781e0dc9f7630534d9110ae60d4cd6482b77d4
Author: Father Chrysostomos <sprout@cpan.org>
Date:   Tue Nov 30 08:33:50 2010 -0800

    Suppress warning from t/op/attrs.t

M	t/op/attrs.t

commit 6b7c6d9593471bad3cd6ea2eb3e51ebf08acad3a
Author: Father Chrysostomos <sprout@cpan.org>
Date:   Tue Nov 30 05:54:23 2010 -0800

    [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.

M	ext/B/t/optree_constants.t
M	ext/B/t/optree_samples.t
M	op.c
M	op.h
M	t/lib/warnings/op
M	toke.c
-----------------------------------------------------------------------

Summary of changes:
 ext/B/t/optree_constants.t |   20 ++++++++++----------
 ext/B/t/optree_samples.t   |    4 ++--
 op.c                       |    3 ++-
 op.h                       |    1 +
 t/lib/warnings/op          |    8 ++++++++
 t/op/attrs.t               |    4 ++--
 toke.c                     |    1 +
 7 files changed, 26 insertions(+), 15 deletions(-)

diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t
index f293228..c0f4932 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 e61c970..4e25676 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 20083ad..469a008 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 c011d66..2c8e7fc 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 962ff58..e596e79 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/t/op/attrs.t b/t/op/attrs.t
index fe77043..36d6bee 100644
--- a/t/op/attrs.t
+++ b/t/op/attrs.t
@@ -300,10 +300,10 @@ foreach my $test (@tests) {
   package brength;
   my $proto;
   sub MODIFY_CODE_ATTRIBUTES { $proto = $_[1]; _: }
-  {
+  eval q{
      my $x;
      () = sub :a0 { $x };
-  }
+  };
   package main;
   eval { $proto->() };               # used to crash in pp_entersub
   like $@, qr/^Closure prototype called/,
diff --git a/toke.c b/toke.c
index 476b331..aa1f57c 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);
 		    }
 

--
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