Mercurial > pub > Impl
changeset 175:9057e4b95d10
corrected cloning method
| author | sourcer |
|---|---|
| date | Wed, 05 Oct 2011 00:48:43 +0300 |
| parents | d920d2b70230 |
| children | 74c27daf2e7b |
| files | Lib/IMPL/clone.pm _test/Test/Lang.pm |
| diffstat | 2 files changed, 27 insertions(+), 5 deletions(-) [+] |
line wrap: on
line diff
--- a/Lib/IMPL/clone.pm Tue Oct 04 17:55:38 2011 +0400 +++ b/Lib/IMPL/clone.pm Wed Oct 05 00:48:43 2011 +0300 @@ -10,7 +10,7 @@ HASH => sub { my $class = blessed($_[0]); - my $new = {}; + my $new = $_[1]->{ refaddr($_[0]) } = {}; while (my ($key,$val) = each %{$_[0]}) { $new->{$key} = clone($val,$_[1]); } @@ -18,7 +18,12 @@ }, ARRAY => sub { my $class = blessed($_[0]); - $class ? bless( [ map clone($_,$_[1]), @{$_[0]} ], $class ) : [ map clone($_), @{$_[0]} ]; + + my $new = $_[1]->{ refaddr($_[0]) } = []; + + push @$new, clone($_,$_[1]) foreach @{$_[0]}; + + $class ? bless( $new, $class ) : $new; }, SCALAR => sub { my $class = blessed($_[0]); @@ -28,7 +33,9 @@ }, REF => sub { my $class = blessed($_[0]); - my $v = clone ( ${$_[0]},$_[1] ); + my $v; + my $new = $_[1]->{ refaddr($_[0]) } = \$v; + $v = clone ( ${$_[0]},$_[1] ); $class ? bless \$v, $class : \$v; }, @@ -42,7 +49,7 @@ return $_[0] unless ref $_[0]; - return $_[1]->{refaddr($_[0])} ||= ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->($_[0]); + return $_[1]->{refaddr($_[0])} || ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->(@_); } }
--- a/_test/Test/Lang.pm Tue Oct 04 17:55:38 2011 +0400 +++ b/_test/Test/Lang.pm Wed Oct 05 00:48:43 2011 +0300 @@ -74,7 +74,22 @@ }; -test clone => { +test clone => sub { + + my $a; + + my $b = clone($a); + + assert(not defined $b); + + my $lp = { a => '1' }; + $lp->{b} = $lp; + + my $c = clone($lp); + + assert($c); + assert($c->{b}); + assert($c->{b} == $c); };