From: rkinyon Date: Thu, 6 Apr 2006 20:29:23 +0000 (+0000) Subject: New testing feature that allows specification of the workdir for the tests X-Git-Tag: 0-99_01~38 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fde3db1a5e4879bebec5ca8051caa2804d1a826e;p=dbsrgits%2FDBM-Deep.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 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 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__ +