From 9fcae9f15ece3ecae8ea65355fc7b66fad0b8e31 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Sat, 14 Jul 2018 10:47:04 +0100 Subject: [PATCH] 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) --- op.c | 8 +++++++- t/op/switch.t | 23 ++++++++++++++++++++++- 2 files changed, 29 insertions(+), 2 deletions(-) diff --git a/op.c b/op.c index a05a1319d431..ddeb484b640d 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 e5385df0b482..6ff69e0bcea2 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.