summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2017-02-23 14:33:05 +0000
committerDavid Mitchell <davem@iabyn.com>2017-06-05 12:52:17 +0100
commit0a30b526db0a91f5cad699185aecc65e6eef7965 (patch)
treef829e93bb15332c559ee0bc88dd4309acd801267
parentf7f169a88ce4013295a6e0b5dc924e6d3b2d3aaa (diff)
downloadperl-0a30b526db0a91f5cad699185aecc65e6eef7965.tar.gz
Deparse.pm: handle BEGIN { require expr }
Deparse examines BEGIN subs to see if they look like BEGIN { require Foo; ... } and if so deparses them as 'use Foo' instead. However, it can't cope when Foo is an expression rather than a constant, such as BEGIN { require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); } and crashes. This commit makes it instead recognise such op trees as not being part of a 'use'. Under TEST -deparse, this fixes the following unexpectedly failing script: dist/threads/t/kill3.t and fixes the following expected-to-fail scripts: dist/IO/t/io_file_export.t dist/IO/t/io_multihomed.t dist/IO/t/io_udp.t dist/threads/t/err.t dist/threads/t/kill2.t dist/threads/t/libc.t
-rw-r--r--Porting/deparse-skips.txt6
-rw-r--r--lib/B/Deparse.pm3
2 files changed, 3 insertions, 6 deletions
diff --git a/Porting/deparse-skips.txt b/Porting/deparse-skips.txt
index efac18fb0b..609e4b1806 100644
--- a/Porting/deparse-skips.txt
+++ b/Porting/deparse-skips.txt
@@ -90,10 +90,7 @@ __DEPARSE_FAILURES__
../dist/Data-Dumper/t/dumper.t
../dist/Exporter/t/Exporter.t
../dist/Filter-Simple/t/data.t
-../dist/IO/t/io_file_export.t
-../dist/IO/t/io_multihomed.t
../dist/IO/t/io_sel.t
-../dist/IO/t/io_udp.t
../dist/Locale-Maketext/t/01_about_verbose.t
../dist/Locale-Maketext/t/10_make.t
../dist/Locale-Maketext/t/20_get.t
@@ -125,10 +122,7 @@ __DEPARSE_FAILURES__
../dist/bignum/t/scope_i.t
../dist/bignum/t/scope_r.t
../dist/constant/t/constant.t
-../dist/threads/t/err.t
../dist/threads/t/exit.t
-../dist/threads/t/kill2.t
-../dist/threads/t/libc.t
../dist/threads/t/thread.t
../ext/B/t/b.t
../ext/B/t/optree_constants.t
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 8e94ee6515..dd61739260 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -628,6 +628,9 @@ sub begin_is_use {
my $req_op = $lineseq->first->sibling;
return if $req_op->name ne "require";
+ # maybe it's C<require expr> rather than C<require 'foo'>
+ return if ($req_op->first->name ne 'const');
+
my $module;
if ($req_op->first->private & OPpCONST_BARE) {
# Actually it should always be a bareword