From: rkinyon Date: Fri, 21 Sep 2007 00:38:49 +0000 (+0000) Subject: New branch plus fix for shift/unshift/splice with references being moved. The fix... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7ffc75ae30103d188220757713122a76f54bdd56;p=dbsrgits%2FDBM-Deep.git New branch plus fix for shift/unshift/splice with references being moved. The fix isn't ideal, but it's a quick patch until full references are in. --- diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm index e60c152..9816303 100644 --- a/lib/DBM/Deep/Array.pm +++ b/lib/DBM/Deep/Array.pm @@ -251,6 +251,22 @@ sub PUSH { return $length; } +sub _move_value { + my $self = shift; + my ($old_key, $new_key) = @_; + + my $val = $self->FETCH( $old_key ); + if ( eval { $val->isa( 'DBM::Deep::Hash' ) } ) { + $self->STORE( $new_key, { %$val } ); + } + elsif ( eval { $val->isa( 'DBM::Deep::Array' ) } ) { + $self->STORE( $new_key, [ @$val ] ); + } + else { + $self->STORE( $new_key, $val ); + } +} + sub SHIFT { my $self = shift->_get_self; @@ -262,7 +278,7 @@ sub SHIFT { my $content = $self->FETCH( 0 ); for (my $i = 0; $i < $length - 1; $i++) { - $self->STORE( $i, $self->FETCH($i + 1) ); + $self->_move_value( $i+1, $i ); } $self->DELETE( $length - 1 ); @@ -287,7 +303,7 @@ sub UNSHIFT { if ($length) { for (my $i = $length - 1; $i >= 0; $i--) { - $self->STORE( $i + $new_size, $self->FETCH($i) ); + $self->_move_value( $i, $i+$new_size ); } } @@ -335,12 +351,12 @@ sub SPLICE { if ( $new_size != $splice_length ) { if ($new_size > $splice_length) { for (my $i = $length - 1; $i >= $offset + $splice_length; $i--) { - $self->STORE( $i + ($new_size - $splice_length), $self->FETCH($i) ); + $self->_move_value( $i, $i + ($new_size - $splice_length) ); } } else { for (my $i = $offset + $splice_length; $i < $length; $i++) { - $self->STORE( $i + ($new_size - $splice_length), $self->FETCH($i) ); + $self->_move_value( $i, $i + ($new_size - $splice_length) ); } for (my $i = 0; $i < $splice_length - $new_size; $i++) { $self->DELETE( $length - 1 ); diff --git a/t/04_array.t b/t/04_array.t index a3f9ce3..cc2b2b9 100644 --- a/t/04_array.t +++ b/t/04_array.t @@ -2,7 +2,7 @@ # DBM::Deep Test ## use strict; -use Test::More tests => 116; +use Test::More tests => 124; use Test::Exception; use t::common qw( new_fh ); @@ -239,3 +239,31 @@ throws_ok { $db->exists(); } qr/Cannot use an undefined array index/, "EXISTS fails on an undefined key"; +# Bug reported by Mike Schilli +{ + my ($fh, $filename) = new_fh(); + my $db = DBM::Deep->new( + file => $filename, + type => DBM::Deep->TYPE_ARRAY + ); + + push @{$db}, 1, { foo => 1 }; + lives_ok { + shift @{$db}; + } "Shift doesn't die moving references around"; + is( $db->[0]{foo}, 1, "Right hashref there" ); + + lives_ok { + unshift @{$db}, [ 1 .. 3 ]; + unshift @{$db}, 1; + } "Unshift doesn't die moving references around"; + is( $db->[1][1], 2, "Right arrayref there" ); + is( $db->[2]{foo}, 1, "Right hashref there" ); + + # Add test for splice moving references around + lives_ok { + splice @{$db}, 0, 0, 1 .. 3; + } "Splice doesn't die moving references around"; + is( $db->[4][1], 2, "Right arrayref there" ); + is( $db->[5]{foo}, 1, "Right hashref there" ); +}