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 (file)
--- 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 (file)
--- 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');