2 use warnings FATAL => 'all';
6 use t::common qw( new_fh );
8 # Need to have an explicit plan in order for the sub-testing to work right.
9 #XXX Figure out how to use subtests for that.
10 my $pre_fork_tests = 14;
11 plan tests => $pre_fork_tests + 2;
13 use_ok( 'DBM::Deep' );
16 my ($fh, $filename) = new_fh();
18 # Create the datafile to be used
20 my $db = DBM::Deep->new( $filename );
21 $db->{hash} = { foo => [ 'a' .. 'c' ] };
25 open(my $fh, '<', $filename) || die("Can't open '$filename' for reading: $!\n");
27 # test if we can open and read a db using its filehandle
30 ok( ($db = DBM::Deep->new( fh => $fh )), "open db in filehandle" );
31 ok( $db->{hash}{foo}[1] eq 'b', "and get at stuff in the database" );
34 } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle";
35 ok( !$db->exists( 'foo' ), "foo doesn't exist" );
39 } qr/Cannot write to a readonly filehandle/, "Can't delete from a read-only filehandle";
43 } qr/Cannot write to a readonly filehandle/, "Can't clear from a read-only filehandle";
46 skip( "No inode tests on Win32", 1 )
47 if ( $^O eq 'MSWin32' || $^O eq 'cygwin' );
48 my $db_obj = $db->_get_self;
49 ok( $db_obj->_engine->storage->{inode}, "The inode has been set" );
56 # now the same, but with an offset into the file. Use the database that's
57 # embedded in the test for the DATA filehandle. First, find the database ...
59 my ($fh,$filename) = new_fh();
62 print $fh <<"__END_FH__";
64 use Test::More 'no_plan';
65 Test::More->builder->no_ending(1);
66 Test::More->builder->{Curr_Test} = $pre_fork_tests;
68 use_ok( 'DBM::Deep' );
70 my \$db = DBM::Deep->new({
73 is(\$db->{x}, 'b', "and get at stuff in the database");
75 print $fh "__DATA__\n";
79 open my $fh, '<', $filename;
80 while(my $line = <$fh>) {
81 last if($line =~ /^__DATA__/);
87 my $db = DBM::Deep->new({
89 file_offset => $offset,
90 #XXX For some reason, this is needed to make the test pass. Figure
96 is( $db->{x}, 'b', 'and it was stored' );
100 open my $fh, '<', $filename;
101 my $db = DBM::Deep->new({
103 file_offset => $offset,
106 is($db->{x}, 'b', "and get at stuff in the database");
108 ok( !$db->exists( 'foo' ), "foo doesn't exist yet" );
111 } qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle";
112 ok( !$db->exists( 'foo' ), "foo still doesn't exist" );
117 exec( "$^X -Iblib/lib $filename" );