|
 |
afa0df2 |
From b73a37a7eb615693b5516068360f61d5b4e8f241 Mon Sep 17 00:00:00 2001
|
|
|
1cc0345 |
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
|
|
1cc0345 |
Date: Tue, 16 Jun 2015 18:20:20 +0200
|
|
|
1cc0345 |
Subject: [PATCH] Adjust to perl-5.22
|
|
|
1cc0345 |
MIME-Version: 1.0
|
|
|
1cc0345 |
Content-Type: text/plain; charset=UTF-8
|
|
|
1cc0345 |
Content-Transfer-Encoding: 8bit
|
|
|
1cc0345 |
|
|
|
1cc0345 |
Perl 5.22 brought changes in class/method opcodes, see perl commit
|
|
|
1cc0345 |
|
|
|
1cc0345 |
commit b46e009d94293e069270690750f6c669c6d0ce22
|
|
|
1cc0345 |
Author: syber <syber@crazypanda.ru>
|
|
|
1cc0345 |
Date: Thu Sep 4 22:08:59 2014 +0400
|
|
|
1cc0345 |
|
|
|
1cc0345 |
Make OP_METHOD* to be of new class METHOP
|
|
|
1cc0345 |
|
|
|
1cc0345 |
and optimizations in anoncode, see perl commit
|
|
|
1cc0345 |
|
|
|
1cc0345 |
commit 01762542fcff2d3eb5e0fd287f28e872a0cfd5a4
|
|
|
1cc0345 |
Author: Father Chrysostomos <sprout@cpan.org>
|
|
|
1cc0345 |
Date: Sat Oct 18 10:23:26 2014 -0700
|
|
|
1cc0345 |
|
|
|
1cc0345 |
Use srefgen for anoncode
|
|
|
1cc0345 |
|
|
|
afa0df2 |
and GV to IV optimizations when calling some subroutines.
|
|
|
afa0df2 |
|
|
|
1cc0345 |
This patch implements the changes to make tests passing with perl
|
|
|
5332f52 |
5.22 and previous versions too.
|
|
|
1cc0345 |
|
|
|
1cc0345 |
CPAN RT#104885
|
|
|
1cc0345 |
|
|
|
1cc0345 |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
1cc0345 |
---
|
|
|
afa0df2 |
lib/B/PerlReq.pm | 24 +++++++++++++++++++-----
|
|
|
1cc0345 |
lib/B/Walker.pm | 9 ++++++++-
|
|
|
afa0df2 |
t/01-B-PerlReq.t | 3 +++
|
|
|
afa0df2 |
3 files changed, 30 insertions(+), 6 deletions(-)
|
|
|
1cc0345 |
|
|
|
1cc0345 |
diff --git a/lib/B/PerlReq.pm b/lib/B/PerlReq.pm
|
|
|
afa0df2 |
index 303454f..2e2a2ba 100644
|
|
|
1cc0345 |
--- a/lib/B/PerlReq.pm
|
|
|
1cc0345 |
+++ b/lib/B/PerlReq.pm
|
|
|
1cc0345 |
@@ -44,7 +44,7 @@ our @Skip = (
|
|
|
1cc0345 |
|
|
|
1cc0345 |
our ($Strict, $Relaxed, $Verbose, $Debug);
|
|
|
1cc0345 |
|
|
|
1cc0345 |
-use B::Walker qw(const_sv);
|
|
|
1cc0345 |
+use B::Walker qw(const_methop const_sv);
|
|
|
1cc0345 |
|
|
|
1cc0345 |
sub RequiresPerl ($) {
|
|
|
1cc0345 |
my $v = shift;
|
|
|
5332f52 |
@@ -273,8 +273,13 @@ my %TryCV;
|
|
|
1cc0345 |
sub grok_try {
|
|
|
1cc0345 |
return unless $INC{"Try/Tiny.pm"};
|
|
|
1cc0345 |
my (undef, $op) = @_;
|
|
|
1cc0345 |
- return unless $op->name eq "refgen";
|
|
|
1cc0345 |
- $op = $op->first->first->sibling;
|
|
|
5332f52 |
+ if ($op->name eq "srefgen") {
|
|
|
5332f52 |
+ $op = $op->first->first;
|
|
|
5332f52 |
+ } elsif ($op->name eq "refgen") {
|
|
|
5332f52 |
+ $op = $op->first->first->sibling;
|
|
|
5332f52 |
+ } else {
|
|
|
5332f52 |
+ return;
|
|
|
5332f52 |
+ }
|
|
|
1cc0345 |
return unless $op->name eq "anoncode";
|
|
|
1cc0345 |
my $cv = padval($op->targ);
|
|
|
1cc0345 |
$TryCV{$$cv} = 1;
|
|
|
5332f52 |
@@ -304,7 +309,13 @@ sub grok_entersub ($) {
|
|
|
1cc0345 |
$op = $op->sibling;
|
|
|
1cc0345 |
}
|
|
|
1cc0345 |
if ($op->name eq "method_named") {
|
|
|
1cc0345 |
- my $method = const_sv($op)->PV;
|
|
|
1cc0345 |
+ my $method;
|
|
|
1cc0345 |
+ if (ref($op) eq 'B::METHOP') {
|
|
|
1cc0345 |
+ $method = const_methop($op);
|
|
|
1cc0345 |
+ } else {
|
|
|
1cc0345 |
+ $method = const_sv($op);
|
|
|
1cc0345 |
+ }
|
|
|
1cc0345 |
+ $method = $method->PV;
|
|
|
1cc0345 |
return unless $methods{$method};
|
|
|
1cc0345 |
return unless $args->name eq "const";
|
|
|
1cc0345 |
my $sv = const_sv($args);
|
|
|
afa0df2 |
@@ -316,7 +327,10 @@ sub grok_entersub ($) {
|
|
|
afa0df2 |
elsif ($op->first->name eq "gv") {
|
|
|
afa0df2 |
$op = $op->first;
|
|
|
afa0df2 |
use B::Walker qw(padval);
|
|
|
afa0df2 |
- my $func = padval($op->padix)->NAME;
|
|
|
afa0df2 |
+ my $padval = padval($op->padix);
|
|
|
afa0df2 |
+ # perl 5.22 sometimes optimizes to B::IV
|
|
|
afa0df2 |
+ return unless ref $padval eq 'B::GV';
|
|
|
afa0df2 |
+ my $func = $padval->NAME;
|
|
|
afa0df2 |
return unless $funcs{$func};
|
|
|
afa0df2 |
$funcs{$func}->($func, $args);
|
|
|
afa0df2 |
}
|
|
|
1cc0345 |
diff --git a/lib/B/Walker.pm b/lib/B/Walker.pm
|
|
|
1cc0345 |
index b71f204..9e3083c 100644
|
|
|
1cc0345 |
--- a/lib/B/Walker.pm
|
|
|
1cc0345 |
+++ b/lib/B/Walker.pm
|
|
|
1cc0345 |
@@ -6,7 +6,7 @@ use strict;
|
|
|
1cc0345 |
|
|
|
1cc0345 |
require Exporter;
|
|
|
1cc0345 |
our @ISA = qw(Exporter);
|
|
|
1cc0345 |
-our @EXPORT_OK = qw(padname padval const_sv walk);
|
|
|
1cc0345 |
+our @EXPORT_OK = qw(padname padval const_methop const_sv walk);
|
|
|
1cc0345 |
|
|
|
1cc0345 |
our $CV;
|
|
|
1cc0345 |
|
|
|
1cc0345 |
@@ -27,6 +27,13 @@ sub const_sv ($) {
|
|
|
1cc0345 |
return $sv;
|
|
|
1cc0345 |
}
|
|
|
1cc0345 |
|
|
|
1cc0345 |
+sub const_methop ($) {
|
|
|
1cc0345 |
+ my $op = shift;
|
|
|
1cc0345 |
+ my $sv = $op->meth_sv;
|
|
|
1cc0345 |
+ $sv = padval($op->targ) unless $$sv;
|
|
|
1cc0345 |
+ return $sv;
|
|
|
1cc0345 |
+}
|
|
|
1cc0345 |
+
|
|
|
1cc0345 |
our $Level = 0;
|
|
|
1cc0345 |
our $Line;
|
|
|
1cc0345 |
our $Sub;
|
|
|
afa0df2 |
diff --git a/t/01-B-PerlReq.t b/t/01-B-PerlReq.t
|
|
|
afa0df2 |
index 7233cb6..6e02759 100644
|
|
|
afa0df2 |
--- a/t/01-B-PerlReq.t
|
|
|
afa0df2 |
+++ b/t/01-B-PerlReq.t
|
|
|
afa0df2 |
@@ -139,4 +139,7 @@ EOF
|
|
|
afa0df2 |
|
|
|
afa0df2 |
cmp_ok "perl(Cwd.pm) >= 1.0", "eq", grok q(use Cwd 0==0);
|
|
|
afa0df2 |
|
|
|
afa0df2 |
+# perl 5.22 sometimes optimizes to B::IV leading to crash
|
|
|
afa0df2 |
+cmp_ok "$d", "eq", grok qq(sub foo{} foo; require $m;);
|
|
|
afa0df2 |
+
|
|
|
afa0df2 |
#END { $? = 0; }
|
|
|
1cc0345 |
--
|
|
|
1cc0345 |
2.1.0
|
|
|
1cc0345 |
|