treat when(index() > -1) as a boolean expression

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

(cherry picked from commit 6b877bbd2c071b3e0659fab552a74dc2ff7e08fb)

2 files changed, 29 insertions, 2 deletions

diff --git a/op.c b/op.c
index a05a1319d4..ddeb484b64 100644
--- 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;
diff --git a/t/op/switch.t b/t/op/switch.t
index e5385df0b4..6ff69e0bce 100644
--- a/t/op/switch.t
+++ b/t/op/switch.t
@@ -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.