In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/0f907b96d618c97cd2e020841a70ae037954a616?hp=2ab54efd6265713df5cd4bd0927024245675c1c2>
- Log -----------------------------------------------------------------
commit 0f907b96d618c97cd2e020841a70ae037954a616
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Dec 14 16:15:51 2009 +0100
[perl #70171] 5.10.0 -> 5.10.1 Regression in fafafbaf70 (Big slowdown in
5.10 @_ parameter passing)
In this case my %x = %$x assigns a hash to itself. This causes the
hv_clear in pp_aassign to wipe away the hash before it can be copied.
The âpanic: attempt to copy freed scalarâ error is triggered by this
line, which copies the value:
sv_setsv(tmpstr,*relem); /* value */
The solution is to make sure the OPpASSIGN_COMMON flag is on in such
cases, so that pp_aassign copies everything before doing the assignment.
-----------------------------------------------------------------------
Summary of changes:
op.c | 2 +-
t/op/array.t | 16 +++++++++++++++-
2 files changed, 16 insertions(+), 2 deletions(-)
diff --git a/op.c b/op.c
index bc8403a..19d7d5e 100644
--- a/op.c
+++ b/op.c
@@ -4277,7 +4277,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype,
OP *right)
|| left->op_type == OP_PADHV
|| left->op_type == OP_PADANY))
{
- maybe_common_vars = FALSE;
+ if (left->op_type == OP_PADSV) maybe_common_vars = FALSE;
if (left->op_private & OPpPAD_STATE) {
/* All single variable list context state assignments, hence
state ($a) = ...
diff --git a/t/op/array.t b/t/op/array.t
index 0027f4b..e36fd28 100644
--- a/t/op/array.t
+++ b/t/op/array.t
@@ -7,7 +7,7 @@ BEGIN {
require 'test.pl';
-plan (125);
+plan (127);
#
# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
@@ -428,5 +428,19 @@ sub test_arylen {
is("$x $y $z", "1 1 2");
}
+# [perl #70171]
+{
+ my $x = get_x(); my %x = %$x; sub get_x { %x=(1..4); return \%x };
+ is(
+ join(" ", map +($_,$x{$_}), sort keys %x), "1 2 3 4",
+ 'bug 70171 (self-assignment via my %x = %$x)'
+ );
+ my $y = get_y(); my @y = @$y; sub get_y { @y=(1..4); return \...@y };
+ is(
+ "@y", "1 2 3 4",
+ 'bug 70171 (self-assignment via my @x = @$x)'
+ );
+}
+
"We're included by lib/Tie/Array/std.t so we need to return something true";
--
Perl5 Master Repository
