Skip to content

Commit

Permalink
treat when(index() > -1) as a boolean expression
Browse files Browse the repository at this point in the history
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 6b877bb)
  • Loading branch information
iabyn authored and tonycoz committed Aug 30, 2018
1 parent 6cb72a3 commit 9fcae9f
Show file tree
Hide file tree
Showing 2 changed files with 29 additions and 2 deletions.
8 changes: 7 additions & 1 deletion op.c
Expand Up @@ -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 */
Expand All @@ -9081,7 +9088,6 @@ S_looks_like_bool(pTHX_ const OP *o)
return TRUE;
else
return FALSE;

/* FALLTHROUGH */
default:
return FALSE;
Expand Down
23 changes: 22 additions & 1 deletion t/op/switch.t
Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down

0 comments on commit 9fcae9f

Please sign in to comment.