]>
Commit | Line | Data |
---|---|---|
cc3f43f5 JB |
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 | |
5 | MIME-Version: 1.0 | |
6 | Content-Type: text/plain; charset=UTF-8 | |
7 | Content-Transfer-Encoding: 8bit | |
8 | ||
9 | Perl 5.22 brought changes in class/method opcodes, see perl commit | |
10 | ||
11 | commit b46e009d94293e069270690750f6c669c6d0ce22 | |
12 | Author: syber <syber@crazypanda.ru> | |
13 | Date: Thu Sep 4 22:08:59 2014 +0400 | |
14 | ||
15 | Make OP_METHOD* to be of new class METHOP | |
16 | ||
17 | and optimizations in anoncode, see perl commit | |
18 | ||
19 | commit 01762542fcff2d3eb5e0fd287f28e872a0cfd5a4 | |
20 | Author: Father Chrysostomos <sprout@cpan.org> | |
21 | Date: Sat Oct 18 10:23:26 2014 -0700 | |
22 | ||
23 | Use srefgen for anoncode | |
24 | ||
25 | and GV to IV optimizations when calling some subroutines. | |
26 | ||
27 | This patch implements the changes to make tests passing with perl | |
28 | 5.22 and previous versions too. | |
29 | ||
30 | CPAN RT#104885 | |
31 | ||
32 | Signed-off-by: Petr Písař <ppisar@redhat.com> | |
33 | --- | |
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(-) | |
38 | ||
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 = ( | |
44 | ||
45 | our ($Strict, $Relaxed, $Verbose, $Debug); | |
46 | ||
47 | -use B::Walker qw(const_sv); | |
48 | +use B::Walker qw(const_methop const_sv); | |
49 | ||
50 | sub RequiresPerl ($) { | |
51 | my $v = shift; | |
52 | @@ -273,8 +273,13 @@ my %TryCV; | |
53 | sub grok_try { | |
54 | return unless $INC{"Try/Tiny.pm"}; | |
55 | my (undef, $op) = @_; | |
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; | |
62 | + } else { | |
63 | + return; | |
64 | + } | |
65 | return unless $op->name eq "anoncode"; | |
66 | my $cv = padval($op->targ); | |
67 | $TryCV{$$cv} = 1; | |
68 | @@ -304,7 +309,13 @@ sub grok_entersub ($) { | |
69 | $op = $op->sibling; | |
70 | } | |
71 | if ($op->name eq "method_named") { | |
72 | - my $method = const_sv($op)->PV; | |
73 | + my $method; | |
74 | + if (ref($op) eq 'B::METHOP') { | |
75 | + $method = const_methop($op); | |
76 | + } else { | |
77 | + $method = const_sv($op); | |
78 | + } | |
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") { | |
85 | $op = $op->first; | |
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); | |
94 | } | |
95 | diff --git a/lib/B/Walker.pm b/lib/B/Walker.pm | |
96 | index b71f204..9e3083c 100644 | |
97 | --- a/lib/B/Walker.pm | |
98 | +++ b/lib/B/Walker.pm | |
99 | @@ -6,7 +6,7 @@ use strict; | |
100 | ||
101 | require Exporter; | |
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); | |
105 | ||
106 | our $CV; | |
107 | ||
108 | @@ -27,6 +27,13 @@ sub const_sv ($) { | |
109 | return $sv; | |
110 | } | |
111 | ||
112 | +sub const_methop ($) { | |
113 | + my $op = shift; | |
114 | + my $sv = $op->meth_sv; | |
115 | + $sv = padval($op->targ) unless $$sv; | |
116 | + return $sv; | |
117 | +} | |
118 | + | |
119 | our $Level = 0; | |
120 | our $Line; | |
121 | our $Sub; | |
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 | |
127 | ||
128 | cmp_ok "perl(Cwd.pm) >= 1.0", "eq", grok q(use Cwd 0==0); | |
129 | ||
130 | +# perl 5.22 sometimes optimizes to B::IV leading to crash | |
131 | +cmp_ok "$d", "eq", grok qq(sub foo{} foo; require $m;); | |
132 | + | |
133 | #END { $? = 0; } | |
134 | -- | |
135 | 2.1.0 | |
136 |