Final fixes before releasing last developer release
[dbsrgits/DBM-Deep.git] / t / 27_filehandle.t
1 use strict;
2 use warnings FATAL => 'all';
3
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;
7 use Test::Exception;
8 use t::common qw( new_fh );
9
10 use_ok( 'DBM::Deep' );
11
12 {
13     my ($fh, $filename) = new_fh();
14
15     # Create the datafile to be used
16     {
17         my $db = DBM::Deep->new( $filename );
18         $db->{hash} = { foo => [ 'a' .. 'c' ] };
19     }
20
21     {
22         open(my $fh, '<', $filename) || die("Can't open '$filename' for reading: $!\n");
23
24         # test if we can open and read a db using its filehandle
25
26         my $db;
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" );
29         throws_ok {
30             $db->{foo} = 1;
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" );
33
34         SKIP: {
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" );
39         }
40
41         close($fh);
42     }
43 }
44
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 ...
47 {
48     my ($fh,$filename) = new_fh();
49
50     print $fh "#!$^X\n";
51     print $fh <<'__END_FH__';
52 use strict;
53 use Test::More 'no_plan';
54 Test::More->builder->no_ending(1);
55 Test::More->builder->{Curr_Test} = 12;
56
57 use_ok( 'DBM::Deep' );
58
59 my $db = DBM::Deep->new({
60     fh => *DATA,
61 });
62 is($db->{x}, 'b', "and get at stuff in the database");
63 __END_FH__
64     print $fh "__DATA__\n";
65     close $fh;
66
67     my $offset = do {
68         open my $fh, '<', $filename;
69         while(my $line = <$fh>) {
70             last if($line =~ /^__DATA__/);
71         }
72         tell($fh);
73     };
74
75     {
76         my $db = DBM::Deep->new({
77             file        => $filename,
78             file_offset => $offset,
79             #XXX For some reason, this is needed to make the test pass. Figure
80             #XXX out why later.
81             locking => 0,
82         });
83
84         $db->{x} = 'b';
85         is( $db->{x}, 'b', 'and it was stored' );
86     }
87
88     {
89         open my $fh, '<', $filename;
90         my $db = DBM::Deep->new({
91             fh          => $fh,
92             file_offset => $offset,
93         });
94
95         is($db->{x}, 'b', "and get at stuff in the database");
96
97         ok( !$db->exists( 'foo' ), "foo doesn't exist yet" );
98         throws_ok {
99             $db->{foo} = 1;
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" );
102
103         is( $db->{x}, 'b' );
104     }
105
106     exec( "$^X -Iblib/lib $filename" );
107 }