File: Adjust-to-perl-5.22.patch

package info (click to toggle)
libb-perlreq-perl 0.82-5
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, buster, sid
  • size: 700 kB
  • ctags: 909
  • sloc: perl: 1,090; sh: 69; makefile: 11
file content (131 lines) | stat: -rw-r--r-- 3,426 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
Bug-Debian: https://bugs.debian.org/787461
Bug: https://rt.cpan.org/Public/Bug/Display.html?id=104885
Origin: https://rt.cpan.org/Public/Bug/Display.html?id=104885

From b73a37a7eb615693b5516068360f61d5b4e8f241 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Tue, 16 Jun 2015 18:20:20 +0200
Subject: [PATCH] Adjust to perl-5.22
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Perl 5.22 brought changes in class/method opcodes, see perl commit

commit b46e009d94293e069270690750f6c669c6d0ce22
Author: syber <syber@crazypanda.ru>
Date: Thu Sep 4 22:08:59 2014 +0400

    Make OP_METHOD* to be of new class METHOP

and optimizations in anoncode, see perl commit

commit 01762542fcff2d3eb5e0fd287f28e872a0cfd5a4
Author: Father Chrysostomos <sprout@cpan.org>
Date: Sat Oct 18 10:23:26 2014 -0700

    Use srefgen for anoncode

and GV to IV optimizations when calling some subroutines.

This patch implements the changes to make tests passing with perl
5.22 and previous versions too.

CPAN RT#104885

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 lib/B/PerlReq.pm | 24 +++++++++++++++++++-----
 lib/B/Walker.pm  |  9 ++++++++-
 t/01-B-PerlReq.t |  3 +++
 3 files changed, 30 insertions(+), 6 deletions(-)

--- a/lib/B/PerlReq.pm
+++ b/lib/B/PerlReq.pm
@@ -44,7 +44,7 @@
 
 our ($Strict, $Relaxed, $Verbose, $Debug);
 
-use B::Walker qw(const_sv);
+use B::Walker qw(const_methop const_sv);
 
 sub RequiresPerl ($) {
 	my $v = shift;
@@ -273,8 +273,13 @@
 sub grok_try {
 	return unless $INC{"Try/Tiny.pm"};
 	my (undef, $op) = @_;
-	return unless $op->name eq "refgen";
-	$op = $op->first->first->sibling;
+	if ($op->name eq "srefgen") {
+		$op = $op->first->first;
+	} elsif ($op->name eq "refgen") {
+		$op = $op->first->first->sibling;
+	} else {
+		return;
+	}
 	return unless $op->name eq "anoncode";
 	my $cv = padval($op->targ);
 	$TryCV{$$cv} = 1;
@@ -304,7 +309,13 @@
 		$op = $op->sibling;
 	}
 	if ($op->name eq "method_named") {
-		my $method = const_sv($op)->PV;
+		my $method;
+		if (ref($op) eq 'B::METHOP') {
+			$method = const_methop($op);
+		} else {
+			$method = const_sv($op);
+		}
+		$method = $method->PV;
 		return unless $methods{$method};
 		return unless $args->name eq "const";
 		my $sv = const_sv($args);
@@ -316,7 +327,10 @@
 	elsif ($op->first->name eq "gv") {
 		$op = $op->first;
 		use B::Walker qw(padval);
-		my $func = padval($op->padix)->NAME;
+		my $padval = padval($op->padix);
+		# perl 5.22 sometimes optimizes to B::IV
+		return unless ref $padval eq 'B::GV';
+		my $func = $padval->NAME;
 		return unless $funcs{$func};
 		$funcs{$func}->($func, $args);
 	}
--- a/lib/B/Walker.pm
+++ b/lib/B/Walker.pm
@@ -6,7 +6,7 @@
 
 require Exporter;
 our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(padname padval const_sv walk);
+our @EXPORT_OK = qw(padname padval const_methop const_sv walk);
 
 our $CV;
 
@@ -26,6 +26,13 @@
 	$sv = padval($op->targ) unless $$sv;
 	return $sv;
 }
+
+sub const_methop ($) {
+	my $op = shift;
+	my $sv = $op->meth_sv;
+	$sv = padval($op->targ) unless $$sv;
+	return $sv;
+}
 
 our $Level = 0;
 our $Line;
--- a/t/01-B-PerlReq.t
+++ b/t/01-B-PerlReq.t
@@ -139,4 +139,7 @@
 
 cmp_ok "perl(Cwd.pm) >= 1.0",	"eq", grok q(use Cwd 0==0);
 
+# perl 5.22 sometimes optimizes to B::IV leading to crash
+cmp_ok "$d", "eq", grok qq(sub foo{} foo; require $m;);
+
 #END { $? = 0; }