From: rkinyon <rkinyon@50811bd7-b8ce-0310-adc1-d9db26280581>
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=refs%2Fheads%2Fbugfix2;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" );
+}