104 lines
2.7 KiB
Diff
104 lines
2.7 KiB
Diff
|
From 6b877bbd2c071b3e0659fab552a74dc2ff7e08fb Mon Sep 17 00:00:00 2001
|
||
|
|
From: David Mitchell <davem@iabyn.com>
|
||
|
|
Date: Sat, 14 Jul 2018 10:47:04 +0100
|
||
|
|
Subject: [PATCH] treat when(index() > -1) as a boolean expression
|
||
|
|
MIME-Version: 1.0
|
||
|
|
Content-Type: text/plain; charset=UTF-8
|
||
|
|
Content-Transfer-Encoding: 8bit
|
||
|
|
|
||
|
|
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))
|
||
|
|
|
||
|
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||
|
|
---
|
||
|
|
op.c | 8 +++++++-
|
||
|
|
t/op/switch.t | 23 ++++++++++++++++++++++-
|
||
|
|
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.
|
||
|
|
--
|
||
|
|
2.14.4
|
||
|
|
|