Blob Blame History Raw
From fc37d660dd918997669ef2c24cf4098104c6eb89 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

This patch implements the changes to make tests passing with perl
5.22. It does not aim for backward compatibility.

CPAN RT#104885

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 lib/B/PerlReq.pm | 14 ++++++++++----
 lib/B/Walker.pm  |  9 ++++++++-
 2 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/lib/B/PerlReq.pm b/lib/B/PerlReq.pm
index 303454f..b852f83 100644
--- a/lib/B/PerlReq.pm
+++ b/lib/B/PerlReq.pm
@@ -44,7 +44,7 @@ our @Skip = (
 
 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,8 @@ my %TryCV;
 sub grok_try {
 	return unless $INC{"Try/Tiny.pm"};
 	my (undef, $op) = @_;
-	return unless $op->name eq "refgen";
-	$op = $op->first->first->sibling;
+	return unless $op->name eq "srefgen";
+	$op = $op->first->first;
 	return unless $op->name eq "anoncode";
 	my $cv = padval($op->targ);
 	$TryCV{$$cv} = 1;
@@ -304,7 +304,13 @@ sub grok_entersub ($) {
 		$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);
diff --git a/lib/B/Walker.pm b/lib/B/Walker.pm
index b71f204..9e3083c 100644
--- a/lib/B/Walker.pm
+++ b/lib/B/Walker.pm
@@ -6,7 +6,7 @@ use strict;
 
 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;
 
@@ -27,6 +27,13 @@ sub const_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;
 our $Sub;
-- 
2.1.0