This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
treat when(index() > -1) as a boolean expression
authorDavid Mitchell <davem@iabyn.com>
Sat, 14 Jul 2018 09:47:04 +0000 (10:47 +0100)
committerDavid Mitchell <davem@iabyn.com>
Sat, 14 Jul 2018 09:59:25 +0000 (10:59 +0100)
RT #133368

when(X) is normally compiled as when($_ ~~ X) *except* when X appears to
be a boolean expression, in which case it's used directly.

5.28.0 introduced an optimisation whereby comparisons involving index
like

    index(...) != -1

eliminated the comparison, and pp_index() returned a boolean value
directly. This defeated the 'look for a boolean op' mechanism, and so

    when(index(...) != -1)

and similar were being incorrectly compiled as

    when($_ ~~ (index(...) != -1))

op.c
t/op/switch.t

diff --git a/op.c b/op.c
index a05a131..ddeb484 100644 (file)
--- a/op.c
+++ b/op.c
@@ -9072,6 +9072,13 @@ S_looks_like_bool(pTHX_ const OP *o)
        case OP_FLOP:
 
            return TRUE;
+
+       case OP_INDEX:
+       case OP_RINDEX:
+            /* optimised-away (index() != -1) or similar comparison */
+            if (o->op_private & OPpTRUEBOOL)
+                return TRUE;
+            return FALSE;
        
        case OP_CONST:
            /* Detect comparisons that have been optimized away */
@@ -9081,7 +9088,6 @@ S_looks_like_bool(pTHX_ const OP *o)
                return TRUE;
            else
                return FALSE;
-
        /* FALLTHROUGH */
        default:
            return FALSE;
index e5385df..6ff69e0 100644 (file)
@@ -10,7 +10,7 @@ use strict;
 use warnings;
 no warnings 'experimental::smartmatch';
 
-plan tests => 195;
+plan tests => 197;
 
 # The behaviour of the feature pragma should be tested by lib/feature.t
 # using the tests in t/lib/feature/*. This file tests the behaviour of
@@ -1358,6 +1358,27 @@ given("xyz") {
        "scalar value of false when";
 }
 
+# RT #133368
+# index() and rindex() comparisons such as '> -1' are optimised away. Make
+# sure that they're still treated as a direct boolean expression rather
+# than when(X) being implicitly converted to when($_ ~~ X)
+
+{
+    my $s = "abc";
+    my $ok = 0;
+    given("xyz") {
+        when (index($s, 'a') > -1) { $ok = 1; }
+    }
+    ok($ok, "RT #133368 index");
+
+    $ok = 0;
+    given("xyz") {
+        when (rindex($s, 'a') > -1) { $ok = 1; }
+    }
+    ok($ok, "RT #133368 rindex");
+}
+
+
 # Okay, that'll do for now. The intricacies of the smartmatch
 # semantics are tested in t/op/smartmatch.t. Taintedness of
 # returned values is checked in t/op/taint.t.