From: rkinyon@cpan.org <rkinyon@cpan.org>
Date: Thu, 26 Jun 2008 03:04:19 +0000 (+0000)
Subject: Array tests now pass
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBM-Deep.git;a=commitdiff_plain;h=68e37b5129df9be33e24ceda16d7ca6cdd52256c

Array tests now pass

git-svn-id: http://svn.ali.as/cpan/trunk/DBM-Deep@3639 88f4d9cd-8a04-0410-9d60-8f63309c3137
---

diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index d6df2d6..5f8494e 100644
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -189,16 +189,12 @@ sub FETCHSIZE {
     $self->_engine->storage->{filter_fetch_value} = undef;
 
     # If there is no flushing, then things get out of sync.
-#    warn "FETCHSIZE BEG: " . $self->_engine->_dump_file;
     my $size = $self->FETCH('length') || 0;
-#    warn "FETCHSIZE AFT: " . $self->_engine->_dump_file;
 
     $self->_engine->storage->{filter_fetch_value} = $SAVE_FILTER;
 
     $self->unlock;
 
-#    warn "FETCHSIZE END: " . $self->_engine->_dump_file;
-
     return $size;
 }
 
@@ -314,15 +310,12 @@ sub UNSHIFT {
             $self->_move_value( $i, $i+$new_size );
         }
 
-#        warn "BEFORE: " . $self->_dump_file;
         $self->STORESIZE( $length + $new_size );
     }
 
-#    $self->_engine->flush;
     for (my $i = 0; $i < $new_size; $i++) {
         $self->STORE( $i, $new_elements[$i] );
     }
-        warn "AFTER : " . $self->_dump_file;
 
     $self->unlock;
 
diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 9c41951..2c369a9 100644
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -690,7 +690,6 @@ sub _request_sector       { shift->_load_header->request_sector( @_ ) }
         my $self = shift;
         my ($offset) = @_;
 
-        #warn join(':',(caller)[0,2]) . " -> $offset\n";
         my $data = $self->get_data( $offset )
             or return;#die "Cannot read from '$offset'\n";
         my $type = substr( $$data, 0, 1 );
diff --git a/lib/DBM/Deep/Engine/Sector/FileHeader.pm b/lib/DBM/Deep/Engine/Sector/FileHeader.pm
index ae56c0f..4a0870d 100644
--- a/lib/DBM/Deep/Engine/Sector/FileHeader.pm
+++ b/lib/DBM/Deep/Engine/Sector/FileHeader.pm
@@ -183,10 +183,10 @@ sub request_sector {
     }
 
     # Need to load the new sector so we can read from it.
-    my $new_sector = $self->engine->storage->read_at( $loc, $size );
+    my $new_sector = $self->engine->get_data( $loc, $size );
 
     # Read the new head after the signature and the staleness counter
-    my $new_head = substr( $new_sector, $e->SIG_SIZE + $DBM::Deep::Engine::STALE_SIZE, $e->byte_size );
+    my $new_head = substr( $$new_sector, $e->SIG_SIZE + $DBM::Deep::Engine::STALE_SIZE, $e->byte_size );
 
     $self->write( $e->chains_loc + $chains_offset, $new_head );
 
diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm
index aa1ea32..f75689a 100644
--- a/lib/DBM/Deep/File.pm
+++ b/lib/DBM/Deep/File.pm
@@ -7,7 +7,7 @@ use warnings FATAL => 'all';
 
 use Fcntl qw( :DEFAULT :flock :seek );
 
-use constant DEBUG => 0;
+use constant DEBUG => 1;
 
 sub new {
     my $class = shift;
@@ -110,6 +110,7 @@ sub print_at {
     my $self = shift;
     my $loc  = shift;
 
+    warn "print_at called\n";
     local ($/,$\);
 
     my $fh = $self->{fh};
diff --git a/t/03_bighash.t b/t/03_bighash.t
index c1f0079..6dff322 100644
--- a/t/03_bighash.t
+++ b/t/03_bighash.t
@@ -22,6 +22,8 @@ my $db = DBM::Deep->new(
 	type => DBM::Deep->TYPE_HASH,
 );
 
+#$db->lock_exclusive;
+
 $db->{foo} = {};
 my $foo = $db->{foo};
 
@@ -61,3 +63,5 @@ warn localtime(time) . ": before clear\n";
 $db->clear;
 warn localtime(time) . ": after clear\n";
 cmp_ok( scalar(keys %$db), '==', 0, "Number of keys after clear() is correct" );
+
+#$db->unlock;
diff --git a/t/04_array.t b/t/04_array.t
index f746f4e..3eea452 100644
--- a/t/04_array.t
+++ b/t/04_array.t
@@ -22,10 +22,7 @@ $db->[0] = "elem1";
 $db->push( "elem2" );
 $db->put(2, "elem3");
 $db->store(3, "elem4");
-#warn $db->_engine->_dump_file;
 $db->unshift("elem0");
-#warn $db->_engine->_dump_file;
-#__END__
 
 is( $db->[0], 'elem0', "Array get for shift works" );
 is( $db->[1], 'elem1', "Array get for array set works" );
@@ -66,25 +63,17 @@ is( $db->fetch(4), 'elem4.1' );
 
 throws_ok {
     $db->[-6] = 'whoops!';
-} qr/Modification of non-creatable array value attempted, subscript -6/, "Correct error thrown";
+} qr/Modification of non-creatable array value attempted, subscript -6/,
+  "Correct error thrown when attempting to modify a non-creatable array value";
 
-warn "1: \n" . $db->_engine->_dump_file;
 my $popped = $db->pop;
-warn "2: \n" . $db->_engine->_dump_file;
 is( $db->length, 4, "... and we have four after popping" );
-warn "3: \n" . $db->_engine->_dump_file;
 is( $db->[0], 'elem0', "0th element still there after popping" );
-warn "4: \n" . $db->_engine->_dump_file;
 is( $db->[1], 'elem1', "1st element still there after popping" );
-warn "5: \n" . $db->_engine->_dump_file;
 is( $db->[2], 'elem2', "2nd element still there after popping" );
-warn "6: \n" . $db->_engine->_dump_file;
 is( $db->[3], 'elem3', "3rd element still there after popping" );
-warn "7: \n" . $db->_engine->_dump_file;
 is( $popped, 'elem4.1', "Popped value is correct" );
 
-die $db->_engine->_dump_file;
-
 my $shifted = $db->shift;
 is( $db->length, 3, "... and we have three after shifting" );
 is( $db->[0], 'elem1', "0th element still there after shifting" );
@@ -145,8 +134,6 @@ is( $db->length(), 0, "After pop() on empty array, length is still 0" );
 is( $db->shift, undef, "shift on an empty array returns undef" );
 is( $db->length(), 0, "After shift() on empty array, length is still 0" );
 
-warn "BEFORE: " . $db->_engine->_dump_file;
-__END__
 is( $db->unshift( 1, 2, 3 ), 3, "unshift returns the number of elements in the array" );
 is( $db->unshift( 1, 2, 3 ), 6, "unshift returns the number of elements in the array" );
 is( $db->push( 1, 2, 3 ), 9, "push returns the number of elements in the array" );