new_dbm() added to allow for running the same tests against multiple backends without...
Rob Kinyon [Thu, 26 Nov 2009 04:26:58 +0000 (23:26 -0500)]
t/02_hash.t
t/common.pm

index fd13c02..e92e120 100644 (file)
@@ -4,12 +4,13 @@
 use strict;
 use Test::More tests => 49;
 use Test::Exception;
-use t::common qw( new_fh );
+use t::common qw( new_dbm );
 
 use_ok( 'DBM::Deep' );
 
-my ($fh, $filename) = new_fh();
-my $db = DBM::Deep->new( $filename );
+my $dbm_factory = new_dbm();
+while ( my $dbm_maker = $dbm_factory->() ) {
+my $db = $dbm_maker->();
 
 ##
 # put/get key
@@ -112,8 +113,7 @@ is( $db->get("key1"), "value222222222222222222222222", "We set a value before cl
 # Make sure DB still works after closing / opening
 ##
 undef $db;
-open $fh, '+<', $filename;
-$db = DBM::Deep->new( $filename );
+$db = $dbm_maker->();
 is( $db->get("key1"), "value222222222222222222222222", "The value we set is still there after closure" );
 
 ##
@@ -175,3 +175,4 @@ throws_ok {
     $db->exists(undef);
 } qr/Cannot use an undefined hash key/, "EXISTS fails on an undefined key";
 
+}
index 97cd1c9..e374be7 100644 (file)
@@ -10,6 +10,7 @@ our $VERSION = '0.01';
 
 use base 'Exporter';
 our @EXPORT_OK = qw(
+    new_dbm
     new_fh
 );
 
@@ -30,5 +31,22 @@ sub new_fh {
     return ($fh, $filename);
 }
 
+sub new_dbm {
+    my @args = @_;
+    my ($fh, $filename) = new_fh();
+    my @extra_args = (
+        [ file => $filename ],
+    );
+    return sub {
+        return unless @extra_args;
+        my @these_args = @{ shift @extra_args };
+        return sub {
+            DBM::Deep->new(
+                @these_args, @args,
+            );
+        };
+    };
+}
+
 1;
 __END__