New testing feature that allows specification of the workdir for the tests

diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm
index 43f5be2..fa6ff42 100644 (file)
--- a/lib/DBM/Deep.pm
+++ b/lib/DBM/Deep.pm
@@ -105,15 +105,14 @@ sub _init {
     # These are the defaults to be optionally overridden below
     my $self = bless {
         type        => TYPE_HASH,
-        engine      => DBM::Deep::Engine->new,
+        engine      => DBM::Deep::Engine->new( $args ),
         base_offset => undef,
     }, $class;
 
-    # Strip out the node-level parameters before passing $args to
-    # the root's constructor.
+    # Grab the parameters we want to use
     foreach my $param ( keys %$self ) {
         next unless exists $args->{$param};
-        $self->{$param} = delete $args->{$param}
+        $self->{$param} = $args->{$param}
     }
 
     # locking implicitly enables autoflush
@@ -632,9 +631,14 @@ sub new {
         filter_store_value => undef,
         filter_fetch_key   => undef,
         filter_fetch_value => undef,
-        %$args,
     }, $class;
 
+    # Grab the parameters we want to use
+    foreach my $param ( keys %$self ) {
+        next unless exists $args->{$param};
+        $self->{$param} = $args->{$param}
+    }
+
     if ( $self->{fh} && !$self->{file_offset} ) {
         $self->{file_offset} = tell( $self->{fh} );
     }

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index 432b87b..b6526a7 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -97,12 +97,18 @@ sub new {
         max_buckets => 16,
     }, $class;
 
+    # Grab the parameters we want to use
+    foreach my $param ( keys %$self ) {
+        next unless exists $args->{$param};
+        $self->{$param} = $args->{$param}
+    }
+
     $self->precalc_sizes;
 
     return $self;
 }
 
-sub write_file_signature {
+sub write_file_header {
     my $self = shift;
     my ($obj) = @_;
 
@@ -117,7 +123,7 @@ sub write_file_signature {
     return;
 }
 
-sub read_file_signature {
+sub read_file_header {
     my $self = shift;
     my ($obj) = @_;
 
@@ -150,13 +156,13 @@ sub setup_fh {
     flock $fh, LOCK_EX;
 
     unless ( $obj->{base_offset} ) {
-        my $bytes_read = $self->read_file_signature( $obj );
+        my $bytes_read = $self->read_file_header( $obj );
 
         ##
-        # File is empty -- write signature and master index
+        # File is empty -- write header and master index
         ##
         if (!$bytes_read) {
-            $self->write_file_signature( $obj );
+            $self->write_file_header( $obj );
 
             $obj->{base_offset} = $self->_request_space(
                 $obj, $self->tag_size( $self->{index_size} ),
@@ -176,7 +182,7 @@ sub setup_fh {
             $obj->{base_offset} = $bytes_read;
 
             ##
-            # Get our type from master index signature
+            # Get our type from master index header
             ##
             my $tag = $self->load_tag($obj, $obj->_base_offset)
             or $obj->_throw_error("Corrupted file, no master index record");

diff --git a/t/01_basic.t b/t/01_basic.t
index 194812d..3c7e88d 100644 (file)
--- a/t/01_basic.t
+++ b/t/01_basic.t
@@ -3,8 +3,8 @@
 ##
 use strict;
 use Test::More tests => 3;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+
+use t::common qw( new_fh );
 
 diag "Testing DBM::Deep against Perl $] located at $^X";
 
@@ -13,9 +13,7 @@ use_ok( 'DBM::Deep' );
 ##
 # basic file open
 ##
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = eval {
     local $SIG{__DIE__};
     DBM::Deep->new( $filename );

diff --git a/t/02_hash.t b/t/02_hash.t
index b1a41fd..d4a52ef 100644 (file)
--- a/t/02_hash.t
+++ b/t/02_hash.t
@@ -4,14 +4,11 @@
 use strict;
 use Test::More tests => 32;
 use Test::Exception;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new( $filename );
 
 ##

diff --git a/t/03_bighash.t b/t/03_bighash.t
index e31920b..091de54 100644 (file)
--- a/t/03_bighash.t
+++ b/t/03_bighash.t
@@ -3,14 +3,11 @@
 ##
 use strict;
 use Test::More tests => 2;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new(
        file => $filename,
        type => DBM::Deep->TYPE_HASH

diff --git a/t/04_array.t b/t/04_array.t
index f3a6860..e5babd3 100644 (file)
--- a/t/04_array.t
+++ b/t/04_array.t
@@ -4,14 +4,11 @@
 use strict;
 use Test::More tests => 109;
 use Test::Exception;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new(
        file => $filename,
        type => DBM::Deep->TYPE_ARRAY

diff --git a/t/05_bigarray.t b/t/05_bigarray.t
index 738dc68..8378c35 100644 (file)
--- a/t/05_bigarray.t
+++ b/t/05_bigarray.t
@@ -3,17 +3,14 @@
 ##
 use strict;
 use Test::More tests => 2;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new(
        file => $filename,
-       type => DBM::Deep->TYPE_ARRAY
+       type => DBM::Deep->TYPE_ARRAY,
 );
 
 ##

diff --git a/t/06_error.t b/t/06_error.t
index 8615ba1..9f3e59e 100644 (file)
--- a/t/06_error.t
+++ b/t/06_error.t
@@ -5,14 +5,11 @@ $|++;
 use strict;
 use Test::More tests => 6;
 use Test::Exception;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 
 ##
 # test a corrupted file
@@ -25,8 +22,7 @@ throws_ok {
 } qr/DBM::Deep: Corrupted file, no master index record/, "Fail if there's no master index record";
 
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
     my %hash;
     tie %hash, 'DBM::Deep', $filename;
     undef %hash;
@@ -42,8 +38,7 @@ throws_ok {
 }
 
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
     my @array;
     tie @array, 'DBM::Deep', $filename;
     undef @array;

diff --git a/t/07_locking.t b/t/07_locking.t
index f92bb8f..09e3c8d 100644 (file)
--- a/t/07_locking.t
+++ b/t/07_locking.t
@@ -3,14 +3,11 @@
 ##
 use strict;
 use Test::More tests => 4;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new(
        file => $filename,
        locking => 1,

diff --git a/t/08_deephash.t b/t/08_deephash.t
index 521b62d..11b0877 100644 (file)
--- a/t/08_deephash.t
+++ b/t/08_deephash.t
@@ -3,14 +3,11 @@
 ##
 use strict;
 use Test::More tests => 5;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 
 my $max_levels = 1000;
 

diff --git a/t/09_deeparray.t b/t/09_deeparray.t
index 749e411..288492b 100644 (file)
--- a/t/09_deeparray.t
+++ b/t/09_deeparray.t
@@ -3,14 +3,11 @@
 ##
 use strict;
 use Test::More tests => 3;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 
 my $max_levels = 1000;
 

diff --git a/t/10_largekeys.t b/t/10_largekeys.t
index 32bc3f7..eff10b5 100644 (file)
--- a/t/10_largekeys.t
+++ b/t/10_largekeys.t
@@ -3,14 +3,11 @@
 ##
 use strict;
 use Test::More tests => 14;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new(
        file => $filename,
 );

diff --git a/t/12_clone.t b/t/12_clone.t
index ac3a42d..a997acc 100644 (file)
--- a/t/12_clone.t
+++ b/t/12_clone.t
@@ -3,14 +3,11 @@
 ##
 use strict;
 use Test::More tests => 14;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 
 {
     my $clone;

diff --git a/t/13_setpack.t b/t/13_setpack.t
index 603b6a0..f7c0e4d 100644 (file)
--- a/t/13_setpack.t
+++ b/t/13_setpack.t
@@ -3,18 +3,14 @@
 ##
 use strict;
 use Test::More tests => 2;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-
 my ($before, $after);
 
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
     my $db = DBM::Deep->new(
         file => $filename,
         autoflush => 1
@@ -25,8 +21,7 @@ my ($before, $after);
 }
 
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
     my $db = DBM::Deep->new(
         file => $filename,
         autoflush => 1

diff --git a/t/14_filter.t b/t/14_filter.t
index a74eb03..9d39f6c 100644 (file)
--- a/t/14_filter.t
+++ b/t/14_filter.t
@@ -3,14 +3,11 @@
 ##
 use strict;
 use Test::More tests => 17;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new(
        file => $filename,
 );

diff --git a/t/15_digest.t b/t/15_digest.t
index 10c9329..22cca87 100644 (file)
--- a/t/15_digest.t
+++ b/t/15_digest.t
@@ -3,14 +3,11 @@
 ##
 use strict;
 use Test::More tests => 14;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 
 my $salt = 38473827;
 

diff --git a/t/16_circular.t b/t/16_circular.t
index 8cd099e..501435d 100644 (file)
--- a/t/16_circular.t
+++ b/t/16_circular.t
@@ -3,14 +3,11 @@
 ##
 use strict;
 use Test::More tests => 32;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new( $filename );
 
 ##

diff --git a/t/17_import.t b/t/17_import.t
index 729d702..2dbd22a 100644 (file)
--- a/t/17_import.t
+++ b/t/17_import.t
@@ -3,14 +3,11 @@
 ##
 use strict;
 use Test::More tests => 2;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new( $filename );
 
 ##

diff --git a/t/18_export.t b/t/18_export.t
index a7127bb..57d3975 100644 (file)
--- a/t/18_export.t
+++ b/t/18_export.t
@@ -3,17 +3,13 @@
 ##
 use strict;
 use Test::More tests => 2;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-
 my $struct;
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
     my $db = DBM::Deep->new( $filename );
 
     ##

diff --git a/t/19_crossref.t b/t/19_crossref.t
index aa49512..aedf5c5 100644 (file)
--- a/t/19_crossref.t
+++ b/t/19_crossref.t
@@ -4,19 +4,15 @@
 use strict;
 use Test::More tests => 6;
 use Test::Exception;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh2, $filename2) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh2, LOCK_UN;
+my ($fh2, $filename2) = new_fh();
 my $db2 = DBM::Deep->new( $filename2 );
 
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
     my $db = DBM::Deep->new( $filename );
 
     ##

diff --git a/t/20_tie.t b/t/20_tie.t
index 71acd61..ffa49a4 100644 (file)
--- a/t/20_tie.t
+++ b/t/20_tie.t
@@ -4,19 +4,15 @@
 use strict;
 use Test::More tests => 11;
 use Test::Exception;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-
 ##
 # testing the various modes of opening a file
 ##
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
     my %hash;
     my $db = tie %hash, 'DBM::Deep', $filename;
 
@@ -24,8 +20,7 @@ my $dir = tempdir( CLEANUP => 1 );
 }
 
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
     my %hash;
     my $db = tie %hash, 'DBM::Deep', {
         file => $filename,
@@ -35,8 +30,7 @@ my $dir = tempdir( CLEANUP => 1 );
 }
 
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
     my @array;
     my $db = tie @array, 'DBM::Deep', $filename;
 
@@ -46,8 +40,7 @@ my $dir = tempdir( CLEANUP => 1 );
 }
 
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
     my @array;
     my $db = tie @array, 'DBM::Deep', {
         file => $filename,
@@ -58,8 +51,7 @@ my $dir = tempdir( CLEANUP => 1 );
     is( $db->{type}, DBM::Deep->TYPE_ARRAY, "TIE_ARRAY sets the correct type" );
 }
 
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 throws_ok {
     tie my %hash, 'DBM::Deep', [ file => $filename ];
 } qr/Not a hashref/, "Passing an arrayref to TIEHASH fails";

diff --git a/t/21_tie_access.t b/t/21_tie_access.t
index 42d1fbe..29a5ef6 100644 (file)
--- a/t/21_tie_access.t
+++ b/t/21_tie_access.t
@@ -4,14 +4,11 @@
 use strict;
 use Test::More tests => 7;
 use Test::Exception;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir();
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 
 {
     my %hash;
@@ -41,8 +38,7 @@ flock $fh, LOCK_UN;
 }
 
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
     DBM::Deep->new( file => $filename, type => DBM::Deep->TYPE_ARRAY );
 
     throws_ok {

diff --git a/t/22_internal_copy.t b/t/22_internal_copy.t
index 699f6c0..c2ed42a 100644 (file)
--- a/t/22_internal_copy.t
+++ b/t/22_internal_copy.t
@@ -3,14 +3,11 @@
 ##
 use strict;
 use Test::More tests => 13;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new( $filename );
 
 ##
@@ -51,8 +48,7 @@ is( $db->{copy}{subkey3}, 'subvalue3', "After the second copy, we're still good"
 
 my $max_keys = 1000;
 
-my ($fh2, $filename2) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh2, LOCK_UN;
+my ($fh2, $filename2) = new_fh();
 {
     my $db = DBM::Deep->new( $filename2 );
 

diff --git a/t/23_misc.t b/t/23_misc.t
index 5b42189..3407439 100644 (file)
--- a/t/23_misc.t
+++ b/t/23_misc.t
@@ -4,14 +4,11 @@
 use strict;
 use Test::More tests => 7;
 use Test::Exception;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new( $filename );
 
 $db->{key1} = "value1";

diff --git a/t/24_autobless.t b/t/24_autobless.t
index 57f7d92..97aae91 100644 (file)
--- a/t/24_autobless.t
+++ b/t/24_autobless.t
@@ -8,14 +8,11 @@ use strict;
 }
 
 use Test::More tests => 64;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 {
     my $db = DBM::Deep->new(
         file     => $filename,
@@ -150,8 +147,7 @@ flock $fh, LOCK_UN;
     is( $db->{unblessed}{b}[2], 3 );
 }
 
-my ($fh2, $filename2) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh2, LOCK_UN;
+my ($fh2, $filename2) = new_fh();
 {
     my $db = DBM::Deep->new(
         file     => $filename2,
@@ -182,8 +178,7 @@ flock $fh2, LOCK_UN;
        # longer named class (FooFoo) and replacing key in db file, then validating
        # content after that point in file to check for corruption.
        ##
-    my ($fh3, $filename3) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh3, LOCK_UN;
+    my ($fh3, $filename3) = new_fh();
     my $db = DBM::Deep->new(
         file     => $filename3,
         autobless => 1,

diff --git a/t/25_tie_return_value.t b/t/25_tie_return_value.t
index e14c319..33943f3 100644 (file)
--- a/t/25_tie_return_value.t
+++ b/t/25_tie_return_value.t
@@ -1,18 +1,14 @@
 use strict;
 
 use Test::More tests => 5;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-
 use Scalar::Util qw( reftype );
 
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
 
     my %hash;
     my $obj = tie %hash, 'DBM::Deep', $filename;
@@ -21,8 +17,7 @@ use Scalar::Util qw( reftype );
 }
 
 {
-    my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-    flock $fh, LOCK_UN;
+    my ($fh, $filename) = new_fh();
 
     my @array;
     my $obj = tie @array, 'DBM::Deep', $filename;

diff --git a/t/26_scalar_ref.t b/t/26_scalar_ref.t
index 06beda8..71109a0 100644 (file)
--- a/t/26_scalar_ref.t
+++ b/t/26_scalar_ref.t
@@ -2,14 +2,11 @@ use strict;
 
 use Test::More tests => 10;
 use Test::Exception;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 
 my $x = 25;
 {

diff --git a/t/27_filehandle.t b/t/27_filehandle.t
index 744a8fd..d46439b 100644 (file)
--- a/t/27_filehandle.t
+++ b/t/27_filehandle.t
@@ -4,14 +4,11 @@
 use strict;
 use Test::More tests => 11;
 use Test::Exception;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 
 # Create the datafile to be used
 {

diff --git a/t/29_freespace_manager.t b/t/29_freespace_manager.t
index abf5683..336646e 100644 (file)
--- a/t/29_freespace_manager.t
+++ b/t/29_freespace_manager.t
@@ -1,13 +1,11 @@
 use strict;
 
 use Test::More tests => 3;
-use File::Temp qw( tempfile );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1 );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new({
     file => $filename,
     autoflush => 1,

diff --git a/t/30_already_tied.t b/t/30_already_tied.t
index 5422851..cc5e551 100644 (file)
--- a/t/30_already_tied.t
+++ b/t/30_already_tied.t
@@ -4,14 +4,11 @@
 use strict;
 use Test::More tests => 7;
 use Test::Exception;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new( $filename );
 
 {

diff --git a/t/31_references.t b/t/31_references.t
index 2becbe2..da588b2 100644 (file)
--- a/t/31_references.t
+++ b/t/31_references.t
@@ -4,14 +4,11 @@
 use strict;
 use Test::More tests => 16;
 use Test::Exception;
-use File::Temp qw( tempfile tempdir );
-use Fcntl qw( :flock );
+use t::common qw( new_fh );
 
 use_ok( 'DBM::Deep' );
 
-my $dir = tempdir( CLEANUP => 1 );
-my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
-flock $fh, LOCK_UN;
+my ($fh, $filename) = new_fh();
 my $db = DBM::Deep->new( $filename );
 
 my %hash = (

diff --git a/t/32_dash_ell.t b/t/32_dash_ell.t
new file mode 100644 (file)
index 0000000..3fe965a
--- /dev/null
+++ b/t/32_dash_ell.t
@@ -0,0 +1,24 @@
+#!/usr/bin/perl -l
+
+##
+# DBM::Deep Test
+#
+# Test for interference from -l on the commandline.
+##
+use strict;
+use Test::More tests => 4;
+use Test::Exception;
+use t::common qw( new_fh );
+
+use_ok( 'DBM::Deep' );
+
+my ($fh, $filename) = new_fh();
+my $db = DBM::Deep->new( $filename );
+
+##
+# put/get key
+##
+$db->{key1} = "value1";
+is( $db->get("key1"), "value1", "get() works with hash assignment" );
+is( $db->fetch("key1"), "value1", "... fetch() works with hash assignment" );
+is( $db->{key1}, "value1", "... and hash-access also works" );

diff --git a/t/common.pm b/t/common.pm
new file mode 100644 (file)
index 0000000..d8a9a7e
--- /dev/null
+++ b/t/common.pm
@@ -0,0 +1,33 @@
+package t::common;
+
+use 5.6.0;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use base 'Exporter';
+our @EXPORT_OK = qw(
+    new_fh
+);
+
+use File::Spec ();
+use File::Temp qw( tempfile tempdir );
+use Fcntl qw( :flock );
+
+my $parent = $ENV{WORK_DIR} || File::Spec->tmpdir;
+my $dir = tempdir( CLEANUP => 1, DIR => $parent );
+
+sub new_fh {
+    my ($fh, $filename) = tempfile( 'tmpXXXX', DIR => $dir );
+
+    # This is because tempfile() returns a flock'ed $fh on MacOSX.
+    flock $fh, LOCK_UN;
+
+    return ($fh, $filename);
+}
+#END{<>}
+1;
+__END__
+