From: Marcus Holland-Moritz <mhx-perl@gmx.net>
Date: Thu, 1 Apr 2004 06:01:25 +0000 (+0000)
Subject: Fix and tests for [perl #28123] Perl optimizes // away incorrectly
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=75cc09e40ef43ffdb7866f862ed8a8f1528a2d9e;p=p5sagit%2Fp5-mst-13.2.git

Fix and tests for [perl #28123] Perl optimizes // away incorrectly

p4raw-id: //depot/perl@22625
---

diff --git a/op.c b/op.c
index a13a7ef..25db092 100644
--- a/op.c
+++ b/op.c
@@ -3368,7 +3368,9 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	    no_bareword_allowed(first);
 	else if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
 		Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
-	if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
+	if ((type == OP_AND &&  SvTRUE(((SVOP*)first)->op_sv)) ||
+	    (type == OP_OR  && !SvTRUE(((SVOP*)first)->op_sv)) ||
+	    (type == OP_DOR && !SvOK(((SVOP*)first)->op_sv))) {
 	    op_free(first);
 	    *firstp = Nullop;
 	    other->op_private |= OPpCONST_SHORTCIRCUIT;
diff --git a/t/op/dor.t b/t/op/dor.t
index 979419b..67f2b77 100644
--- a/t/op/dor.t
+++ b/t/op/dor.t
@@ -10,7 +10,7 @@ BEGIN {
 package main;
 require './test.pl';
 
-plan( tests => 30 );
+plan( tests => 33 );
 
 my($x);
 
@@ -72,3 +72,9 @@ eval q# sub { print $fh / 2 } #;
 is( $@, '' );
 eval q# sub { print $fh /2 } #;
 like( $@, qr/^Search pattern not terminated/ );
+
+# [perl #28123] Perl optimizes // away incorrectly
+
+is(0 // 2, 0, 		'	// : left-hand operand not optimized away');
+is('' // 2, '',		'	// : left-hand operand not optimized away');
+is(undef // 2, 2, 	'	// : left-hand operand optimized away');