2 use warnings FATAL => 'all';
4 # Need to have an explicit plan in order for the sub-testing to work right.
5 #XXX Figure out how to use subtests for that.
6 use Test::More tests => 14;
8 use t::common qw( new_fh );
10 use_ok( 'DBM::Deep' );
13 my ($fh, $filename) = new_fh();
15 # Create the datafile to be used
17 my $db = DBM::Deep->new( $filename );
18 $db->{hash} = { foo => [ 'a' .. 'c' ] };
22 open(my $fh, '<', $filename) || die("Can't open '$filename' for reading: $!\n");
24 # test if we can open and read a db using its filehandle
27 ok( ($db = DBM::Deep->new( fh => $fh )), "open db in filehandle" );
28 ok( $db->{hash}{foo}[1] eq 'b', "and get at stuff in the database" );
31 } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle";
32 ok( !$db->exists( 'foo' ), "foo doesn't exist" );
35 skip( "No inode tests on Win32", 1 )
36 if ( $^O eq 'MSWin32' || $^O eq 'cygwin' );
37 my $db_obj = $db->_get_self;
38 ok( $db_obj->_engine->storage->{inode}, "The inode has been set" );
45 # now the same, but with an offset into the file. Use the database that's
46 # embedded in the test for the DATA filehandle. First, find the database ...
48 my ($fh,$filename) = new_fh();
51 print $fh <<'__END_FH__';
53 use Test::More 'no_plan';
54 Test::More->builder->no_ending(1);
55 Test::More->builder->{Curr_Test} = 12;
57 use_ok( 'DBM::Deep' );
59 my $db = DBM::Deep->new({
62 is($db->{x}, 'b', "and get at stuff in the database");
64 print $fh "__DATA__\n";
68 open my $fh, '<', $filename;
69 while(my $line = <$fh>) {
70 last if($line =~ /^__DATA__/);
76 my $db = DBM::Deep->new({
78 file_offset => $offset,
79 #XXX For some reason, this is needed to make the test pass. Figure
85 is( $db->{x}, 'b', 'and it was stored' );
89 open my $fh, '<', $filename;
90 my $db = DBM::Deep->new({
92 file_offset => $offset,
95 is($db->{x}, 'b', "and get at stuff in the database");
97 ok( !$db->exists( 'foo' ), "foo doesn't exist yet" );
100 } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle";
101 ok( !$db->exists( 'foo' ), "foo still doesn't exist" );
106 exec( "$^X -Iblib/lib $filename" );