In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/66c742d5709538d20fcc9da3f377be437119ba19?hp=2af655b5cf66b7a6963303751abfaa0aa53b7828>
- Log -----------------------------------------------------------------
commit 66c742d5709538d20fcc9da3f377be437119ba19
Author: Aaron Crane <a...@cpan.org>
Date: Tue Jul 15 18:28:42 2014 +0100
Fix bug in inlining some CORE::* subs
As of 4aaa475724fbbc4ab2427743fa4d07a12e6ce0d9, when Perl compiles code like
BEGIN { *entangle = \&CORE::tie }
entangle $foo, $package
the apparent call to "entangle" is replaced with an inlined invocation of
the "tie" builtin.
For unary ops, the OPf_SPECIAL flag was set on the generated inlined op iff
the op's argument was surrounded by parens. But that's incorrect for ops
which have their own interpretation of OPf_SPECIAL. In particular:
keys, values, each
OPf_SPECIAL is set for lvalue usage; this shows up when the compile-time
argument is a reference to be subjected to the autoderef feature, and
the run-time argument is an array ref. The existing tests didn't execute
the code (and didn't combine inlining with array autoderefs), so didn't
catch this case.
delete, exists
OPf_SPECIAL is set when the argument is an array element rather than a
hash element; this doesn't directly cause any obvious problems, because
pp_delete and pp_exists consider OPf_SPECIAL only when they've already
determined that their argument is an array element, but it did break
deparsing (because B::Deparse considers OPf_SPECIAL in all cases): the
hash element argument got deparsed as an array element. Further, the
inlining tests themselves rely on deparsing to ensure that the op was
inlined. The existing inlining tests happened to use array elements, so
didn't catch this problem.
This commit fixes those cases, by avoiding setting OPf_SPECIAL when inlining
an invocation of one of those ops. The list of op types is hard-coded; this
seems a little icky, but I don't see a better alternative.
I believe that no other ops are affected by this issue, but my confidence in
that statement isn't as high as it might be; it seems hard to work out
exactly which ops use OPf_SPECIAL.
M op.c
M t/op/coresubs.t
commit 5e33e2aa63ba88d865ac1653a8dbc30cdafd1822
Author: Aaron Crane <a...@cpan.org>
Date: Tue Jul 15 18:25:22 2014 +0100
t/op/coresubs.t: factor out an internal routine
This routine will be used in the next commit. I believe that the behaviour
of the tests remains unchanged after this commit.
M t/op/coresubs.t
-----------------------------------------------------------------------
Summary of changes:
op.c | 9 +++++++--
t/op/coresubs.t | 52 +++++++++++++++++++++++++++++++++++-----------------
2 files changed, 42 insertions(+), 19 deletions(-)
diff --git a/op.c b/op.c
index 9ae3392..7bdfbce 100644
--- a/op.c
+++ b/op.c
@@ -10485,7 +10485,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV
*namegv, SV *protosv)
}
else {
OP *prev, *cvop, *first, *parent;
- U32 flags;
+ U32 flags = 0;
parent = entersubop;
if (!OP_HAS_SIBLING(aop)) {
@@ -10500,7 +10500,12 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV
*namegv, SV *protosv)
OP_HAS_SIBLING(cvop);
prev = cvop, cvop = OP_SIBLING(cvop))
;
- flags = OPf_SPECIAL * !(cvop->op_private & OPpENTERSUB_NOPAREN);
+ if (!(cvop->op_private & OPpENTERSUB_NOPAREN)
+ /* Usually, OPf_SPECIAL on a UNOP means that its arg had no
+ * parens, but these have their own meaning for that flag: */
+ && opnum != OP_VALUES && opnum != OP_KEYS && opnum != OP_EACH
+ && opnum != OP_DELETE && opnum != OP_EXISTS)
+ flags |= OPf_SPECIAL;
/* excise cvop from end of sibling chain */
op_sibling_splice(parent, prev, 1, NULL);
op_free(cvop);
diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index 2e93c71..58f7d5f 100644
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -53,7 +53,7 @@ while(<$kh>) {
ok !defined &{"CORE::$word"}, "no CORE::$word";
}
else {
- $tests += 4;
+ $tests += 2;
ok defined &{"CORE::$word"}, "defined &{'CORE::$word'}";
@@ -65,23 +65,8 @@ while(<$kh>) {
my $numargs =
$word eq 'delete' || $word eq 'exists' ? 1 :
(() = $proto =~ s/;.*//r =~ /\G$protochar/g);
- my $code =
- "#line 1 This-line-makes-__FILE__-easier-to-test.
- sub { () = (my$word("
- . ($args_for{$word} || join ",", map "\$$_", 1..$numargs)
- . "))}";
- my $core = $bd->coderef2text(eval $code =~ s/my/CORE::/r or die);
- my $my = $bd->coderef2text(eval $code or die);
- is $my, $core, "inlinability of CORE::$word with parens";
- $code =
- "#line 1 This-line-makes-__FILE__-easier-to-test.
- sub { () = (my$word "
- . ($args_for{$word} || join ",", map "\$$_", 1..$numargs)
- . ")}";
- $core = $bd->coderef2text(eval $code =~ s/my/CORE::/r or die);
- $my = $bd->coderef2text(eval $code or die);
- is $my, $core, "inlinability of CORE::$word without parens";
+ inlinable_ok($word, $args_for{$word} || join ",", map "\$$_",
1..$numargs);
# High-precedence tests
my $hpcode;
@@ -130,6 +115,24 @@ while(<$kh>) {
}
}
+sub inlinable_ok {
+ my ($word, $args, $desc_suffix) = @_;
+ $tests += 2;
+
+ $desc_suffix //= '';
+
+ for ([with => "($args)"], [without => " $args"]) {
+ my ($preposition, $full_args) = @$_;
+ my $core_code =
+ "#line 1 This-line-makes-__FILE__-easier-to-test.
+ sub { () = (CORE::$word$full_args) }";
+ my $my_code = $core_code =~ s/CORE::$word/my$word/r;
+ my $core = $bd->coderef2text(eval $core_code or die);
+ my $my = $bd->coderef2text(eval $my_code or die);
+ is $my, $core, "inlinability of CORE::$word $preposition parens
$desc_suffix";
+ }
+}
+
$tests++;
# This subroutine is outside the warnings scope:
sub foo { goto &CORE::abs }
@@ -153,6 +156,21 @@ $tests++;
ok eval { *CORE::exit = \42 },
'[rt.cpan.org #74289] *CORE::foo is not accidentally made read-only';
+for my $word (qw<keys values each>) {
+ # mykeys() etc were aliased to \&CORE::keys etc above
+ my $code = qq{
+ no warnings 'experimental::autoderef';
+ my \$x = [];
+ () = my$word(\$x);
+ 'ok'
+ };
+ $tests++;
+ is(eval($code), 'ok', "inlined $word() on autoderef array") or diag $@;
+}
+
+inlinable_ok($_, '$_{k}', 'on hash')
+ for qw<delete exists>;
+
@UNIVERSAL::ISA = CORE;
is "just another "->ucfirst . "perl hacker,\n"->ucfirst,
"Just another Perl hacker,\n", 'coresubs do not return TARG';
--
Perl5 Master Repository
