From: rkinyon Date: Tue, 16 Jan 2007 15:33:29 +0000 (+0000) Subject: Lots and lots of fixes, primarily in terms of improving test coverage X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a67c4bbf05bd579ff9d4741cef3a1e813e0cb9f2;p=dbsrgits%2FDBM-Deep.git Lots and lots of fixes, primarily in terms of improving test coverage --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 51f8e82..4031271 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -244,12 +244,13 @@ sub import { #XXX This isn't the best solution. Better would be to use Data::Walker, #XXX but that's a lot more thinking than I want to do right now. eval { + local $SIG{'__DIE__'}; $self->begin_work; $self->_import( _clone_data( $struct ) ); $self->commit; - }; if ( $@ ) { + }; if ( my $e = $@ ) { $self->rollback; - die $@; + die $e; } return 1; @@ -331,6 +332,8 @@ sub clone { ); } +#XXX Migrate this to the engine, where it really belongs and go through some +# API - stop poking in the innards of someone else.. { my %is_legal_filter = map { $_ => ~~1, @@ -529,6 +532,9 @@ sub CLEAR { ## $self->lock( LOCK_EX ); + #XXX Rewrite this dreck to do it in the engine as a tight loop vs. + # iterating over keys - such a WASTE - is this required for transactional + # clearning?! Surely that can be detected in the engine ... if ( $self->_type eq TYPE_HASH ) { my $key = $self->first_key; while ( $key ) { @@ -545,11 +551,6 @@ sub CLEAR { } $self->STORESIZE( 0 ); } -#XXX This needs updating to use _release_space -# $self->_engine->write_tag( -# $self->_base_offset, $self->_type, -# chr(0)x$self->_engine->{index_size}, -# ); $self->unlock(); @@ -1439,6 +1440,51 @@ the transaction. Transactions in DBM::Deep are done using the MVCC method, the same method used by the InnoDB MySQL table type. +=head1 PERFORMANCE + +Because DBM::Deep is a conncurrent datastore, every change is flushed to disk +immediately and every read goes to disk. This means that DBM::Deep functions +at the speed of disk (generally 10-20ms) vs. the speed of RAM (generally +50-70ns), or at least 150-200x slower than the comparable in-memory +datastructure in Perl. + +There are several techniques you can use to speed up how DBM::Deep functions. + +=over 4 + +=item * Put it on a ramdisk + +The easiest and quickest mechanism to making DBM::Deep run faster is to create +a ramdisk and locate the DBM::Deep file there. Doing this as an option may +become a feature of DBM::Deep, assuming there is a good ramdisk wrapper on CPAN. + +=item * Work at the tightest level possible + +It is much faster to assign the level of your db that you are working with to +an intermediate variable than to re-look it up every time. Thus + + # BAD + while ( my ($k, $v) = each %{$db->{foo}{bar}{baz}} ) { + ... + } + + # GOOD + my $x = $db->{foo}{bar}{baz}; + while ( my ($k, $v) = each %$x ) { + ... + } + +=item * Make your file as tight as possible + +If you know that you are not going to use more than 65K in your database, +consider using the C 'small'> option. This will instruct +DBM::Deep to use 16bit addresses, meaning that the seek times will be less. +The same goes with the number of transactions. num_Txns defaults to 16. If you +can set that to 1 or 2, that will reduce the file-size considerably, thus +reducing seek times. + +=back + =head1 CAVEATS / ISSUES / BUGS This section describes all the known issues with DBM::Deep. It you have found @@ -1547,13 +1593,14 @@ B report on this distribution's test suite. ---------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ ------ - blib/lib/DBM/Deep.pm 88.1 81.0 81.0 97.9 89.5 4.7 87.9 - blib/lib/DBM/Deep/Array.pm 99.5 90.0 100.0 100.0 100.0 5.8 97.6 - blib/lib/DBM/Deep/Engine.pm 95.6 84.6 78.0 99.1 0.0 58.8 89.3 - blib/lib/DBM/Deep/File.pm 92.6 80.0 45.5 100.0 0.0 28.8 82.6 - blib/lib/DBM/Deep/Hash.pm 98.5 83.3 100.0 100.0 100.0 2.0 96.3 - Total 94.7 84.4 77.5 99.1 32.1 100.0 89.9 + blib/lib/DBM/Deep.pm 96.7 87.9 90.5 100.0 89.5 4.5 95.1 + blib/lib/DBM/Deep/Array.pm 100.0 91.4 100.0 100.0 100.0 4.9 98.3 + blib/lib/DBM/Deep/Engine.pm 95.6 85.1 78.0 99.1 0.0 57.4 89.4 + blib/lib/DBM/Deep/File.pm 94.3 86.1 55.6 100.0 0.0 30.7 85.7 + blib/lib/DBM/Deep/Hash.pm 100.0 100.0 100.0 100.0 100.0 2.4 100.0 + Total 96.5 86.9 81.0 99.5 32.1 100.0 91.8 ---------------------------- ------ ------ ------ ------ ------ ------ ------ + =head1 MORE INFORMATION Check out the DBM::Deep Google Group at L diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm index 3b9784d..817aaa1 100644 --- a/lib/DBM/Deep/Array.pm +++ b/lib/DBM/Deep/Array.pm @@ -26,12 +26,7 @@ sub _import { my $self = shift; my ($struct) = @_; - eval { - local $SIG{'__DIE__'}; - $self->push( @$struct ); - }; if ($@) { - $self->_throw_error("Cannot import: type mismatch"); - } + $self->push( @$struct ); return 1; } diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index c5dcaa6..26c3000 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -68,7 +68,7 @@ sub new { $args->{byte_size} = 8; } else { - die "Unknown pack_size value: '$args->{pack_size}'\n"; + DBM::Deep->_throw_error( "Unknown pack_size value: '$args->{pack_size}'" ); } } @@ -140,7 +140,7 @@ sub get_classname { # This will be a Reference sector my $sector = $self->_load_sector( $obj->_base_offset ) - or die "How did get_classname fail (no sector for '$obj')?!\n"; + or DBM::Deep->_throw_error( "How did get_classname fail (no sector for '$obj')?!" ); if ( $sector->staleness != $obj->_staleness ) { return; @@ -222,10 +222,10 @@ sub write_value { # This will be a Reference sector my $sector = $self->_load_sector( $obj->_base_offset ) - or die "Cannot write to a deleted spot in DBM::Deep.\n"; + or DBM::Deep->_throw_error( "Cannot write to a deleted spot in DBM::Deep." ); if ( $sector->staleness != $obj->_staleness ) { - die "Cannot write to a deleted spot in DBM::Deep.\n"; + DBM::Deep->_throw_error( "Cannot write to a deleted spot in DBM::Deep.n" ); } # Create this after loading the reference sector in case something bad happens. @@ -594,7 +594,7 @@ sub clear_entries { @{$self}{qw(byte_size max_buckets)} = @values; my $header_var = 1 + 1 + 4 + 4 * $self->num_txns + 3 * $self->byte_size; - unless ( $size eq $header_var ) { + unless ( $size == $header_var ) { $self->storage->close; DBM::Deep->_throw_error( "Unexpected size found ($size <-> $header_var)." ); } @@ -654,7 +654,7 @@ sub _load_sector { return; } - die "'$offset': Don't know what to do with type '$type'\n"; + DBM::Deep->_throw_error( "'$offset': Don't know what to do with type '$type'" ); } sub _apply_digest { @@ -780,9 +780,8 @@ sub get_sector_iterator { sector => $sector, }); } - else { - die "Why did $loc make a $sector?"; - } + + DBM::Deep->_throw_error( "get_sector_iterator(): Why did $loc make a $sector?" ); } sub get_next_key { @@ -843,6 +842,7 @@ sub get_next_key { if ( defined $key ) { return $key; } + #XXX else { $iterator->set_to_end() } ? # We hit the end of the bucketlist iterator, so redo redo FIND_NEXT_KEY; @@ -894,17 +894,15 @@ sub get_next_key { return if $self->at_end; + my $idx = $self->{curr_index}++; + my $data_loc = $self->{sector}->get_data_location_for({ allow_head => 1, - idx => $self->{curr_index}++, + idx => $idx, }) or return; - my $key_sector = $self->{sector}->get_key_for( $self->{curr_index} - 1 ); - - #XXX Is this check necessary now? - return unless $key_sector; - - return $key_sector->data; + #XXX Do we want to add corruption checks here? + return $self->{sector}->get_key_for( $idx )->data; } package DBM::Deep::Engine::Sector; @@ -915,8 +913,9 @@ sub new { $self->_init; return $self; } + #sub _init {} -#sub clone { die "Must be implemented in the child class" } +#sub clone { DBM::Deep->_throw_error( "Must be implemented in the child class" ); } sub engine { $_[0]{engine} } sub offset { $_[0]{offset} } @@ -1190,7 +1189,7 @@ sub write_data { key_md5 => $args->{key_md5}, key => $args->{key}, create => 1, - }) or die "How did write_data fail (no blist)?!\n"; + }) or DBM::Deep->_throw_error( "How did write_data fail (no blist)?!" ); # Handle any transactional bookkeeping. if ( $self->engine->trans_id ) { @@ -1222,6 +1221,7 @@ sub write_data { else { if ( @trans_ids ) { foreach my $other_trans_id ( @trans_ids ) { + #XXX This doesn't seem to possible to ever happen . . . next if $blist->get_data_location_for({ trans_id => $other_trans_id, allow_head => 0 }); $blist->mark_deleted({ trans_id => $other_trans_id, @@ -1251,7 +1251,7 @@ sub delete_key { # XXX What should happen if this fails? my $blist = $self->get_bucket_list({ key_md5 => $args->{key_md5}, - }) or die "How did delete_key fail (no blist)?!\n"; + }) or DBM::Deep->_throw_error( "How did delete_key fail (no blist)?!" ); # Save the location so that we can free the data my $location = $blist->get_data_location_for({ @@ -1320,9 +1320,8 @@ sub get_bucket_list { return $blist; } - # Add searching here through the index layers, if any my $sector = $engine->_load_sector( $blist_loc ) - or die "Cannot read sector at $blist_loc in get_bucket_list()"; + or DBM::Deep->_throw_error( "Cannot read sector at $blist_loc in get_bucket_list()" ); my $i = 0; my $last_sector = undef; while ( $sector->isa( 'DBM::Deep::Engine::Sector::Index' ) ) { @@ -1330,7 +1329,7 @@ sub get_bucket_list { $last_sector = $sector; if ( $blist_loc ) { $sector = $engine->_load_sector( $blist_loc ) - or die "Cannot read sector at $blist_loc in get_bucket_list()"; + or DBM::Deep->_throw_error( "Cannot read sector at $blist_loc in get_bucket_list()" ); } else { $sector = undef; @@ -1342,7 +1341,7 @@ sub get_bucket_list { unless ( $sector ) { return unless $args->{create}; - die "No last_sector when attempting to build a new entry" + DBM::Deep->_throw_error( "No last_sector when attempting to build a new entry" ) unless $last_sector; my $blist = DBM::Deep::Engine::Sector::BucketList->new({ @@ -1445,6 +1444,7 @@ sub get_classname { return $self->engine->_load_sector( $class_offset )->data; } +#XXX Add singleton handling here sub data { my $self = shift; @@ -1527,6 +1527,7 @@ sub chopped_up { my $spot = $self->offset + $self->base_size + $idx * $self->bucket_size; my $md5 = $e->storage->read_at( $spot, $e->hash_size ); + #XXX If we're chopping, why would we ever have the blank_md5? last if $md5 eq $e->blank_md5; my $rest = $e->storage->read_at( undef, $self->bucket_size - $e->hash_size ); @@ -1757,7 +1758,8 @@ sub get_key_for { $self->engine->byte_size, ); $location = unpack( $StP{$self->engine->byte_size}, $location ); - return unless $location; + DBM::Deep->_throw_error( "get_key_for: No location?" ) unless $location; + return $self->engine->_load_sector( $location ); } @@ -1819,7 +1821,7 @@ sub get_entry { my $e = $self->engine; - die "get_entry: Out of range ($idx)" + DBM::Deep->_throw_error( "get_entry: Out of range ($idx)" ) if $idx < 0 || $idx >= $e->hash_chars; return unpack( @@ -1834,7 +1836,7 @@ sub set_entry { my $e = $self->engine; - die "set_entry: Out of range ($idx)" + DBM::Deep->_throw_error( "set_entry: Out of range ($idx)" ) if $idx < 0 || $idx >= $e->hash_chars; $self->engine->storage->print_at( diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm index 454fa93..174033d 100644 --- a/lib/DBM/Deep/File.pm +++ b/lib/DBM/Deep/File.pm @@ -22,6 +22,7 @@ sub new { file_offset => 0, locking => undef, locked => 0, +#XXX Migrate this to the engine, where it really belongs. filter_store_key => undef, filter_store_value => undef, filter_fetch_key => undef, @@ -110,7 +111,6 @@ sub print_at { sub read_at { my $self = shift; my ($loc, $size) = @_; - print join(":",map{$_||''}caller) . " - read_at(@{[$loc || 'undef']}, $size)\n" if $::DEBUG; local ($/,$\); diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm index d322665..461bd2f 100644 --- a/lib/DBM/Deep/Hash.pm +++ b/lib/DBM/Deep/Hash.pm @@ -20,13 +20,8 @@ sub _import { my $self = shift; my ($struct) = @_; - eval { - local $SIG{'__DIE__'}; - foreach my $key (keys %$struct) { - $self->put($key, $struct->{$key}); - } - }; if ($@) { - $self->_throw_error("Cannot import: type mismatch"); + foreach my $key (keys %$struct) { + $self->put($key, $struct->{$key}); } return 1; diff --git a/t/03_bighash.t b/t/03_bighash.t index a83ebcb..b362c0f 100644 --- a/t/03_bighash.t +++ b/t/03_bighash.t @@ -10,7 +10,7 @@ plan skip_all => "You must set \$ENV{LONG_TESTS} to run the long tests" use Test::Deep; use t::common qw( new_fh ); -plan tests => 5; +plan tests => 9; use_ok( 'DBM::Deep' ); @@ -48,5 +48,10 @@ cmp_ok( scalar(@keys), '==', $max_keys + 1, "Number of keys is correct" ); my @control = sort map { "hello $_" } 0 .. $max_keys; cmp_deeply( \@keys, \@control, "Correct keys are there" ); +ok( !exists $foo->{does_not_exist}, "EXISTS works on large hashes for non-existent keys" ); +is( $foo->{does_not_exist}, undef, "autovivification works on large hashes" ); +ok( exists $foo->{does_not_exist}, "EXISTS works on large hashes for newly-existent keys" ); +cmp_ok( scalar(keys %$foo), '==', $max_keys + 2, "Number of keys after autovivify is correct" ); + $db->clear; cmp_ok( scalar(keys %$db), '==', 0, "Number of keys after clear() is correct" ); diff --git a/t/11_optimize.todo b/t/11_optimize.t similarity index 92% rename from t/11_optimize.todo rename to t/11_optimize.t index 523c994..0ae0ed8 100644 --- a/t/11_optimize.todo +++ b/t/11_optimize.t @@ -53,8 +53,6 @@ ok( $after < $before, "file size has shrunk" ); # make sure file shrunk is( $db->{key1}, 'value1', "key1's value is still there after optimize" ); is( $db->{a}{c}, 'value2', "key2's value is still there after optimize" ); -#print keys %{$db->{a}}, $/; - ## # now for the tricky one -- try to store a new key while file is being # optimized and locked by another process. filehandle should be invalidated, @@ -70,7 +68,7 @@ SKIP: { # first things first, get us about 1000 keys so the optimize() will take # at least a few seconds on any machine, and re-open db with locking ## - for (11..11) { $db->STORE( $_, $_ +1 ); } + for (1..1000) { $db->STORE( $_, $_ +1 ); } undef $db; ## @@ -93,7 +91,6 @@ SKIP: { exit( 0 ); } -=pod # parent fork ok( defined($pid), "fork was successful" ); # make sure fork was successful @@ -113,15 +110,14 @@ SKIP: { # see if it was stored successfully is( $db->{parentfork}, "hello", "stored key while optimize took place" ); -# undef $db; -# $db = DBM::Deep->new( -# file => $filename, -# autoflush => 1, -# locking => 1 -# ); + undef $db; + $db = DBM::Deep->new( + file => $filename, + autoflush => 1, + locking => 1 + ); # now check some existing values from before is( $db->{key1}, 'value1', "key1's value is still there after optimize" ); is( $db->{a}{c}, 'value2', "key2's value is still there after optimize" ); -=cut } diff --git a/t/14_filter.t b/t/14_filter.t index 9d39f6c..240e96d 100644 --- a/t/14_filter.t +++ b/t/14_filter.t @@ -2,7 +2,8 @@ # DBM::Deep Test ## use strict; -use Test::More tests => 17; +use Test::More tests => 21; +use Test::Deep; use t::common qw( new_fh ); use_ok( 'DBM::Deep' ); @@ -38,13 +39,16 @@ is($db->{key2}, "value2", "Fetchfilters worked right"); ## # Try fetching keys as well as values ## -my $first_key = $db->first_key(); -my $next_key = $db->next_key($first_key); +cmp_bag( [ keys %$db ], [qw( key1 key2 )], "DB keys correct" ); -ok( - (($first_key eq "key1") || ($first_key eq "key2")) && - (($next_key eq "key1") || ($next_key eq "key2")) -); +# Exists and delete tests +ok( exists $db->{key1}, "Key1 exists" ); +ok( exists $db->{key2}, "Key2 exists" ); + +is( delete $db->{key1}, 'value1', "Delete returns the right value" ); + +ok( !exists $db->{key1}, "Key1 no longer exists" ); +ok( exists $db->{key2}, "Key2 exists" ); ## # Now clear all filters, and make sure all is unfiltered @@ -54,8 +58,7 @@ ok( $db->set_filter( 'store_value', undef ), "Unset store_value filter" ); ok( $db->set_filter( 'fetch_key', undef ), "Unset fetch_key filter" ); ok( $db->set_filter( 'fetch_value', undef ), "Unset fetch_value filter" ); -is($db->{MYFILTERkey1}, "MYFILTERvalue1"); -is($db->{MYFILTERkey2}, "MYFILTERvalue2"); +is( $db->{MYFILTERkey2}, "MYFILTERvalue2", "We get the right unfiltered value" ); sub my_filter_store_key { return 'MYFILTER' . $_[0]; } sub my_filter_store_value { return 'MYFILTER' . $_[0]; } diff --git a/t/17_import.t b/t/17_import.t index 8bb4c28..a23b2ed 100644 --- a/t/17_import.t +++ b/t/17_import.t @@ -2,7 +2,7 @@ # DBM::Deep Test ## use strict; -use Test::More tests => 9; +use Test::More tests => 11; use Test::Deep; use t::common qw( new_fh ); @@ -29,9 +29,6 @@ use_ok( 'DBM::Deep' ); } }; -## -# Import entire thing -## $db->import( $struct ); cmp_deeply( @@ -72,9 +69,6 @@ use_ok( 'DBM::Deep' ); { foo => [ 2 .. 4 ] }, ]; -## -# Import entire thing -## $db->import( $struct ); cmp_deeply( @@ -93,6 +87,36 @@ use_ok( 'DBM::Deep' ); ok( $db->[-1], "\$db doesn't have the 'bar' value at the end, so \$struct is not tied" ); } +# Failure case to verify that rollback occurs +{ + my ($fh, $filename) = new_fh(); + my $db = DBM::Deep->new({ + file => $filename, + autobless => 1, + }); + + $db->{foo} = 'bar'; + + my $struct = { + key1 => [ + 2, sub {}, 3, + ], + }; + + eval { + $db->import( $struct ); + }; + like( $@, qr/Storage of references of type 'CODE' is not supported/, 'Error message correct' ); + + cmp_deeply( + $db, + noclass({ + foo => 'bar', + }), + "Everything matches", + ); +} + __END__ Need to add tests for: diff --git a/t/28_index_sector.t b/t/28_index_sector.t index f2c981e..9f8f8cb 100644 --- a/t/28_index_sector.t +++ b/t/28_index_sector.t @@ -1,5 +1,5 @@ use strict; -use Test::More tests => 36; +use Test::More tests => 40; use Test::Deep; use t::common qw( new_fh ); @@ -23,3 +23,9 @@ for ( 1 .. 17 ) { my @keys = keys %$db; cmp_ok( scalar(@keys), '==', 17, "Right number of keys returned" ); + +ok( !exists $db->{does_not_exist}, "EXISTS works on large hashes for non-existent keys" ); +is( $db->{does_not_exist}, undef, "autovivification works on large hashes" ); +ok( exists $db->{does_not_exist}, "EXISTS works on large hashes for newly-existent keys" ); +cmp_ok( scalar(keys %$db), '==', 18, "Number of keys after autovivify is correct" ); + diff --git a/t/36_transaction_deep.todo b/t/36_transaction_deep.todo index 1cb1ec6..818666e 100644 --- a/t/36_transaction_deep.todo +++ b/t/36_transaction_deep.todo @@ -6,32 +6,32 @@ use t::common qw( new_fh ); use_ok( 'DBM::Deep' ); my ($fh, $filename) = new_fh(); -my $db1 = DBM::Deep->new( +my $db = DBM::Deep->new( file => $filename, locking => 1, autoflush => 1, ); -my $x_outer = { a => 'b' }; -my $x_inner = { a => 'c' }; +my $outer = { a => 'b' }; +my $inner = { a => 'c' }; -$db1->{x} = $x_outer; -is( $db1->{x}{a}, 'b', "BEFORE: We're looking at the right value from outer" ); +$db->{x} = $outer; +is( $db->{x}{a}, 'b', "BEFORE: We're looking at the right value from outer" ); -$db1->begin_work; +$db->begin_work; - $db1->{x} = $x_inner; - is( $db1->{x}{a}, 'c', "WITHIN: We're looking at the right value from inner" ); + $db->{x} = $inner; + is( $db->{x}{a}, 'c', "WITHIN: We're looking at the right value from inner" ); TODO: { local $TODO = "Transactions not done yet"; - is( $x_outer->{a}, 'c', "WITHIN: We're looking at the right value from outer" ); + is( $outer->{a}, 'b', "WITHIN: We're looking at the right value from outer" ); } -$db1->commit; +$db->commit; -is( $db1->{x}{a}, 'c', "AFTER: Commit means x_inner is still correct" ); +is( $db->{x}{a}, 'c', "AFTER: Commit means inner is still correct" ); TODO: { local $TODO = "Transactions not done yet"; -is( $x_outer->{a}, 'c', "AFTER: outer made the move" ); -is( $x_inner->{a}, 'c', "AFTER: inner made the move" ); +is( $outer->{a}, undef, "AFTER: outer made the move" ); } +is( $inner->{a}, 'c', "AFTER: inner made the move" ); diff --git a/t/38_transaction_add_item.todo b/t/38_transaction_add_item.todo index 993956a..7c2ae90 100644 --- a/t/38_transaction_add_item.todo +++ b/t/38_transaction_add_item.todo @@ -22,11 +22,11 @@ my $db = DBM::Deep->new( $db->begin_work; - $db->{foo} = $obj; - $db->{foo}{bar} = 1; + $db->{foo} = $obj; + $db->{foo}{bar} = 1; - cmp_ok( $db->{foo}{bar}, '==', 1, "The value is visible within the transaction" ); - cmp_ok( $obj->{bar}, '==', 1, "The value is visible within the object" ); + cmp_ok( $db->{foo}{bar}, '==', 1, "The value is visible within the transaction" ); + cmp_ok( $obj->{bar}, '==', 1, "The value is visible within the object" ); $db->rollback; @@ -55,11 +55,11 @@ __END__ $db->begin_work; - $db->{foo} = $obj; - $db->{foo}{bar} = 1; + $db->{foo} = $obj; + $db->{foo}{bar} = 1; - cmp_ok( $db->{foo}{bar}, '==', 1, "The value is visible within the transaction" ); - cmp_ok( $obj->{bar}, '==', 1, "The value is visible within the object" ); + cmp_ok( $db->{foo}{bar}, '==', 1, "The value is visible within the transaction" ); + cmp_ok( $obj->{bar}, '==', 1, "The value is visible within the object" ); $db->commit; diff --git a/t/40_freespace.t b/t/40_freespace.t index 280fdfe..a4bfa9a 100644 --- a/t/40_freespace.t +++ b/t/40_freespace.t @@ -51,7 +51,7 @@ is( $x->{foo}, undef, "Deleting floober makes \$x empty (read)" ); is( delete $x->{foo}, undef, "Deleting floober makes \$x empty (delete)" ); eval { $x->{foo} = 'bar'; }; -is( $@, "Cannot write to a deleted spot in DBM::Deep.\n", "Exception thrown when writing" ); +like( $@, qr/Cannot write to a deleted spot in DBM::Deep/, "Exception thrown when writing" ); cmp_ok( scalar( keys %$x ), '==', 0, "Keys returns nothing after deletion" ); @@ -62,6 +62,6 @@ is( $x->{foo}, undef, "Even after the space has been reused, \$x is still empty" is( delete $x->{foo}, undef, "Even after the space has been reused, \$x is still empty" ); eval { $x->{foo} = 'bar'; }; -is( $@, "Cannot write to a deleted spot in DBM::Deep.\n", "Exception thrown when writing" ); +like( $@, qr/Cannot write to a deleted spot in DBM::Deep/, "Exception thrown when writing" ); cmp_ok( scalar( keys %$x ), '==', 0, "Keys returns nothing after space reuse" ); diff --git a/t/TODO b/t/TODO new file mode 100644 index 0000000..9042281 --- /dev/null +++ b/t/TODO @@ -0,0 +1,91 @@ +=head1 NAME + +Testing TODO + +=head1 PURPOSE + +This file is to detail the tests, in a general sense, that have yet to be +written so that I don't forget them. + +=head1 MISSING TESTS + +=over 4 + +=item * Readonly filehandles + +=over 4 + +=item * Mutations on readonly filehandles + +This is to verify that the appropriate errors are thrown + +=item * Run an optimize on a readonly FH + +=back + +=item * _copy_value() + +For some reason, $c doesn't seem to be undefinable in _copy_value. Maybe this +means that the bless()ing should occur iff Cisa('DBM::Deep')>? + +=item * OO Array access with illegal keys + +There's a ton of tests that can be written here to verify the gatekeepers in +the array methods. + +=item * Splice + +=over 4 + +=item * Undefined initial offset + +=item * splicing in a group that's equal to the target + +=back + +=item * Passing in a fh without a file_offset + +=item * Do I ever use print_at() without passing in offset? + +=item * How should the inode check for locking happen? + +=item * Attempt to unlock an unlocked fh + +=item * medium and large pack_sizes + +Need to make sure I only run the large pack_size test on 64-bit Perls + +=item * max_buckets check + +=item * get_classname() on a deleted sector + +How should this be triggered?! + +=item * Open a corrupted file that has a header, but not initial reference + +=item * Max out the number of transactions + +=item * What happens when commit/rollback are called immediately after begin_work? + +=item * Delete something in the head that has its own value in a transaction + +=item * Run an import within a transaction + +=over 4 + +=item * Should all assignments happen within a sub-transaction? + +=item * Does this mean that sub-transactions should just be done right now? + +It shouldn't be too hard to variablize which transaction is the base instead +of hard-coding 0 . . . + +=back + +=item * Delete something within a transaction, then commit. + +Verify that the space is reusable by assigning more to the DB. + +=back + +=cut