1 From b73a37a7eb615693b5516068360f61d5b4e8f241 Mon Sep 17 00:00:00 2001
2 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
3 Date: Tue, 16 Jun 2015 18:20:20 +0200
4 Subject: [PATCH] Adjust to perl-5.22
6 Content-Type: text/plain; charset=UTF-8
7 Content-Transfer-Encoding: 8bit
9 Perl 5.22 brought changes in class/method opcodes, see perl commit
11 commit b46e009d94293e069270690750f6c669c6d0ce22
12 Author: syber <syber@crazypanda.ru>
13 Date: Thu Sep 4 22:08:59 2014 +0400
15 Make OP_METHOD* to be of new class METHOP
17 and optimizations in anoncode, see perl commit
19 commit 01762542fcff2d3eb5e0fd287f28e872a0cfd5a4
20 Author: Father Chrysostomos <sprout@cpan.org>
21 Date: Sat Oct 18 10:23:26 2014 -0700
23 Use srefgen for anoncode
25 and GV to IV optimizations when calling some subroutines.
27 This patch implements the changes to make tests passing with perl
28 5.22 and previous versions too.
32 Signed-off-by: Petr Písař <ppisar@redhat.com>
34 lib/B/PerlReq.pm | 24 +++++++++++++++++++-----
35 lib/B/Walker.pm | 9 ++++++++-
36 t/01-B-PerlReq.t | 3 +++
37 3 files changed, 30 insertions(+), 6 deletions(-)
39 diff --git a/lib/B/PerlReq.pm b/lib/B/PerlReq.pm
40 index 303454f..2e2a2ba 100644
41 --- a/lib/B/PerlReq.pm
42 +++ b/lib/B/PerlReq.pm
43 @@ -44,7 +44,7 @@ our @Skip = (
45 our ($Strict, $Relaxed, $Verbose, $Debug);
47 -use B::Walker qw(const_sv);
48 +use B::Walker qw(const_methop const_sv);
50 sub RequiresPerl ($) {
52 @@ -273,8 +273,13 @@ my %TryCV;
54 return unless $INC{"Try/Tiny.pm"};
56 - return unless $op->name eq "refgen";
57 - $op = $op->first->first->sibling;
58 + if ($op->name eq "srefgen") {
59 + $op = $op->first->first;
60 + } elsif ($op->name eq "refgen") {
61 + $op = $op->first->first->sibling;
65 return unless $op->name eq "anoncode";
66 my $cv = padval($op->targ);
68 @@ -304,7 +309,13 @@ sub grok_entersub ($) {
71 if ($op->name eq "method_named") {
72 - my $method = const_sv($op)->PV;
74 + if (ref($op) eq 'B::METHOP') {
75 + $method = const_methop($op);
77 + $method = const_sv($op);
79 + $method = $method->PV;
80 return unless $methods{$method};
81 return unless $args->name eq "const";
82 my $sv = const_sv($args);
83 @@ -316,7 +327,10 @@ sub grok_entersub ($) {
84 elsif ($op->first->name eq "gv") {
86 use B::Walker qw(padval);
87 - my $func = padval($op->padix)->NAME;
88 + my $padval = padval($op->padix);
89 + # perl 5.22 sometimes optimizes to B::IV
90 + return unless ref $padval eq 'B::GV';
91 + my $func = $padval->NAME;
92 return unless $funcs{$func};
93 $funcs{$func}->($func, $args);
95 diff --git a/lib/B/Walker.pm b/lib/B/Walker.pm
96 index b71f204..9e3083c 100644
99 @@ -6,7 +6,7 @@ use strict;
102 our @ISA = qw(Exporter);
103 -our @EXPORT_OK = qw(padname padval const_sv walk);
104 +our @EXPORT_OK = qw(padname padval const_methop const_sv walk);
108 @@ -27,6 +27,13 @@ sub const_sv ($) {
112 +sub const_methop ($) {
114 + my $sv = $op->meth_sv;
115 + $sv = padval($op->targ) unless $$sv;
122 diff --git a/t/01-B-PerlReq.t b/t/01-B-PerlReq.t
123 index 7233cb6..6e02759 100644
124 --- a/t/01-B-PerlReq.t
125 +++ b/t/01-B-PerlReq.t
126 @@ -139,4 +139,7 @@ EOF
128 cmp_ok "perl(Cwd.pm) >= 1.0", "eq", grok q(use Cwd 0==0);
130 +# perl 5.22 sometimes optimizes to B::IV leading to crash
131 +cmp_ok "$d", "eq", grok qq(sub foo{} foo; require $m;);