X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F27_filehandle.t;h=11f9eca8fba7dc95890f3c55a39c76bbba7f4169;hb=6e78585cfdedc2754b455639da5cc877d7f25cab;hp=2c4d04e96dc6161c2b75e9b60b0ce7801e183b39;hpb=6ed2f3df3112a3a967491f4be9eeacf080b9dce0;p=dbsrgits%2FDBM-Deep.git diff --git a/t/27_filehandle.t b/t/27_filehandle.t index 2c4d04e..11f9eca 100644 --- a/t/27_filehandle.t +++ b/t/27_filehandle.t @@ -2,66 +2,100 @@ # DBM::Deep Test ## use strict; -use Test::More tests => 11; +use Test::More tests => 14; use Test::Exception; -use File::Temp qw( tempfile tempdir ); +use t::common qw( new_fh ); use_ok( 'DBM::Deep' ); -my $dir = tempdir( CLEANUP => 1 ); -my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir ); - -# Create the datafile to be used { - my $db = DBM::Deep->new( $filename ); - $db->{hash} = { foo => [ 'a' .. 'c' ] }; -} + my ($fh, $filename) = new_fh(); -{ - open(FILE, $filename) || die("Can't open '$filename' for reading: $!\n"); + # Create the datafile to be used + { + my $db = DBM::Deep->new( $filename ); + $db->{hash} = { foo => [ 'a' .. 'c' ] }; + } - my $db; + { + open(my $fh, '<', $filename) || die("Can't open '$filename' for reading: $!\n"); - # test if we can open and read a db using its filehandle + # test if we can open and read a db using its filehandle - ok(($db = DBM::Deep->new(fh => *FILE)), "open db in filehandle"); - ok($db->{hash}->{foo}->[1] eq 'b', "and get at stuff in the database"); - throws_ok { - $db->{foo} = 1; - } qr/Cannot write to a readonly filehandle/, - "Can't write to a read-only filehandle"; - ok( !$db->exists( 'foo' ), "foo doesn't exist" ); + my $db; + ok( ($db = DBM::Deep->new( fh => $fh )), "open db in filehandle" ); + ok( $db->{hash}{foo}[1] eq 'b', "and get at stuff in the database" ); + throws_ok { + $db->{foo} = 1; + } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle"; + ok( !$db->exists( 'foo' ), "foo doesn't exist" ); - my $db_obj = $db->_get_self; - ok( $db_obj->_root->{inode}, "The inode has been set" ); + my $db_obj = $db->_get_self; + ok( $db_obj->_storage->{inode}, "The inode has been set" ); - close(FILE); + close($fh); + } } # now the same, but with an offset into the file. Use the database that's # embedded in the test for the DATA filehandle. First, find the database ... -open(FILE, "t/28_DATA.t") || die("Can't open t/28_DATA.t\n"); -while(my $line = ) { - last if($line =~ /^__DATA__/); -} -my $offset = tell(FILE); -close(FILE); - -SKIP: { - skip "File format changed ... gah!", 5; - open(FILE, "t/28_DATA.t"); - - my $db; - - ok(($db = DBM::Deep->new(fh => *FILE, file_offset => $offset)), "open db in filehandle with offset"); +{ + my ($fh,$filename) = new_fh(); - ok($db->{hash}->{foo}->[1] eq 'b', "and get at stuff in the database"); + print $fh "#!$^X\n"; + print $fh <<'__END_FH__'; +use strict; +use Test::More no_plan => 1; +Test::More->builder->no_ending(1); +Test::More->builder->{Curr_Test} = 12; - ok( !$db->exists( 'foo' ), "foo doesn't exist yet" ); - throws_ok { - $db->{foo} = 1; - } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle"; - ok( !$db->exists( 'foo' ), "foo doesn't exist" ); +use_ok( 'DBM::Deep' ); - close FILE; +my $db = DBM::Deep->new({ + fh => *DATA, +}); +is($db->{x}, 'b', "and get at stuff in the database"); +__END_FH__ + print $fh "__DATA__\n"; + close $fh; + + my $offset = do { + open my $fh, '<', $filename; + while(my $line = <$fh>) { + last if($line =~ /^__DATA__/); + } + tell($fh); + }; + + { + my $db = DBM::Deep->new({ + file => $filename, + file_offset => $offset, +#XXX For some reason, this is needed to make the test pass. Figure out why later. +locking => 0, + }); + + $db->{x} = 'b'; + is( $db->{x}, 'b', 'and it was stored' ); + } + + { + open my $fh, '<', $filename; + my $db = DBM::Deep->new({ + fh => $fh, + file_offset => $offset, + }); + + is($db->{x}, 'b', "and get at stuff in the database"); + + ok( !$db->exists( 'foo' ), "foo doesn't exist yet" ); + throws_ok { + $db->{foo} = 1; + } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle"; + ok( !$db->exists( 'foo' ), "foo still doesn't exist" ); + + is( $db->{x}, 'b' ); + } + + exec( "$^X -Iblib/lib $filename" ); }