Fix index() and rindex() optimization in given-when boolean context
This commit is contained in:
Petr Písař
parent
b7449d9d90
commit
c5a47bb005
103
perl-5.29.0-treat-when-index-1-as-a-boolean-expression.patch
Normal file
103
perl-5.29.0-treat-when-index-1-as-a-boolean-expression.patch
Normal file
@ -0,0 +1,103 @@
|
||||
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
|
||||
|
||||
12
perl.spec
12
perl.spec
@ -81,7 +81,7 @@ License: GPL+ or Artistic
|
||||
Epoch: %{perl_epoch}
|
||||
Version: %{perl_version}
|
||||
# release number must be even higher, because dual-lived modules will be broken otherwise
|
||||
Release: 418%{?dist}
|
||||
Release: 419%{?dist}
|
||||
Summary: Practical Extraction and Report Language
|
||||
Url: https://www.perl.org/
|
||||
Source0: https://www.cpan.org/src/5.0/perl-%{perl_version}.tar.xz
|
||||
@ -164,6 +164,10 @@ Patch17: perl-5.29.0-regexec.c-Call-macro-with-correct-args.patch
|
||||
# Fix invoking a check for wide characters while ISO-8859-1 locale is in effect
|
||||
Patch18: perl-5.29.0-perl.h-Add-parens-around-macro-arguments.patch
|
||||
|
||||
# Fix index() and rindex() optimization in given-when boolean context,
|
||||
# RT#133368, in upstream after 5.29.0
|
||||
Patch19: perl-5.29.0-treat-when-index-1-as-a-boolean-expression.patch
|
||||
|
||||
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
|
||||
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
|
||||
|
||||
@ -2736,6 +2740,7 @@ Perl extension for Version Objects
|
||||
%patch16 -p1
|
||||
%patch17 -p1
|
||||
%patch18 -p1
|
||||
%patch19 -p1
|
||||
%patch200 -p1
|
||||
%patch201 -p1
|
||||
|
||||
@ -2761,6 +2766,7 @@ perl -x patchlevel.h \
|
||||
'Fedora Patch16: Fix an integer wrap when allocating memory for an environment variable (RT#133204)' \
|
||||
'Fedora Patch17: Fix printing a warning about a wide character when matching a regular expression while ISO-8859-1 locale is in effect' \
|
||||
'Fedora Patch18: Fix invoking a check for wide characters while ISO-8859-1 locale is in effect' \
|
||||
'Fedora Patch19: Fix index() and rindex() optimization in given-when boolean context (RT#133368)' \
|
||||
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
|
||||
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
|
||||
%{nil}
|
||||
@ -5049,6 +5055,10 @@ popd
|
||||
|
||||
# Old changelog entries are preserved in CVS.
|
||||
%changelog
|
||||
* Tue Jul 17 2018 Petr Pisar <ppisar@redhat.com> - 4:5.28.0-419
|
||||
- Fix index() and rindex() optimization in given-when boolean context
|
||||
(RT#133368)
|
||||
|
||||
* Fri Jul 13 2018 Fedora Release Engineering <releng@fedoraproject.org> - 4:5.28.0-418
|
||||
- Rebuilt for https://fedoraproject.org/wiki/Fedora_29_Mass_Rebuild
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user