Search-TokyoDystopia/t/12-tcj.t

#!/usr/bin/perl

use warnings;
use strict;

use blib;

use Test::More tests => 30;
use Test::Exception;
use Data::Dump qw/dump/;

BEGIN {
use_ok( 'Search::TokyoDystopia' );
}

my $path = 'casket-jdb';

cmp_ok( $Search::TokyoDystopia::debug, '==', 0, '$debug' );

cmp_ok( tcjdberrmsg(0), 'eq', 'success', 'tcjdberrmsg' );

ok( my $jdb = tcjdbnew, 'tcjdbnew' );   # FIXME check better

ok( ! tcjdbdel( $jdb ), 'tcjdbdel' );

ok( $jdb = tcjdbnew, 'tcjdbnew again' );

is( tcjdbecode( $jdb ), 0, 'tcjdbecode' );

ok( tcjdbtune( $jdb, 0, 0, 0, JDBTLARGE | JDBTDEFLATE ), 'tcjdbtune' );

ok( tcjdbsetcache( $jdb, 0, 0 ), 'tcjdbsetcache' );

ok( tcjdbsetfwmmax( $jdb, 0 ), 'tcjdbsetfwmmax' );

ok( tcjdbopen( $jdb, $path, JDBOWRITER | JDBOCREAT | JDBOTRUNC ), "tcjdbopen $path" );

SKIP: {
        skip 'close on empty database makes next open segfault', 2;

        ok( tcjdbclose( $jdb ), 'tcjdbclose' );

        ok( tcjdbopen( $jdb, $path, JDBOWRITER | JDBOCREAT ), "tcjdbopen $path again" );

}

ok( tcjdbput( $jdb, 1, [ 'foobar' ] ), 'tcjdbput' );
diag tcjdberrmsg( tcjdbecode( $jdb ) );

ok( tcjdbout( $jdb, 1 ), 'tcjdbout' );

ok( tcjdbput( $jdb, 42, [ 'some', 'data' ] ), 'tcjdbput again' );

ok( tcjdbput2( $jdb, 99, 'some more data again', ' ' ), 'tcjdbput2' );

is_deeply( tcjdbsearch( $jdb, 'some', JDBSSUBSTR ), [ 42 ], 'tcjdbsearch' );
ok( tcjdbput( $jdb, 65536, [ 'some', 'more', 'data' ] ), 'tcjdbput more data' );
is_deeply( tcjdbsearch( $jdb, 'some', JDBSSUBSTR ), [ 42, 65536 ], 'tcjdbsearch' );

ok( tcjdbsync( $jdb ), 'tcjdbsync' );

ok( tcjdboptimize( $jdb ), 'tcjdboptimize' );

my $copy_path = $path . '-copy';

ok( tcjdbcopy( $jdb, $copy_path ), "tcjdbcopy $copy_path" );
ok( -e $copy_path, 'copy exists' );

is( tcjdbpath( $jdb ), $path, 'tcjdbpath' );

is( tcjdbrnum( $jdb ), 3, 'tcjdbrnum' );

ok( my $file_size = tcjdbfsiz( $jdb ), 'tcjdbfsiz' );

ok( tcjdbvanish( $jdb ), 'tcjdbvanish' );

is( tcjdbrnum( $jdb ), 0, 'tcjdbrnum' );

cmp_ok( tcjdbfsiz( $jdb ), '<=', $file_size, 'tcjdbfsiz' );

diag tcjdberrmsg( tcjdbecode( $jdb ) );
1	dpavlin	37	#!/usr/bin/perl
2
3			use warnings;
4			use strict;
5
6			use blib;
7
8			use Test::More tests => 30;
9			use Test::Exception;
10			use Data::Dump qw/dump/;
11
12			BEGIN {
13			use_ok( 'Search::TokyoDystopia' );
14			}
15
16			my $path = 'casket-jdb';
17
18			cmp_ok( $Search::TokyoDystopia::debug, '==', 0, '$debug' );
19
20			cmp_ok( tcjdberrmsg(0), 'eq', 'success', 'tcjdberrmsg' );
21
22			ok( my $jdb = tcjdbnew, 'tcjdbnew' ); # FIXME check better
23
24			ok( ! tcjdbdel( $jdb ), 'tcjdbdel' );
25
26			ok( $jdb = tcjdbnew, 'tcjdbnew again' );
27
28			is( tcjdbecode( $jdb ), 0, 'tcjdbecode' );
29
30			ok( tcjdbtune( $jdb, 0, 0, 0, JDBTLARGE \| JDBTDEFLATE ), 'tcjdbtune' );
31
32			ok( tcjdbsetcache( $jdb, 0, 0 ), 'tcjdbsetcache' );
33
34			ok( tcjdbsetfwmmax( $jdb, 0 ), 'tcjdbsetfwmmax' );
35
36			ok( tcjdbopen( $jdb, $path, JDBOWRITER \| JDBOCREAT \| JDBOTRUNC ), "tcjdbopen $path" );
37
38	dpavlin	38	SKIP: {
39			skip 'close on empty database makes next open segfault', 2;
40	dpavlin	37
41	dpavlin	38	ok( tcjdbclose( $jdb ), 'tcjdbclose' );
42	dpavlin	37
43	dpavlin	38	ok( tcjdbopen( $jdb, $path, JDBOWRITER \| JDBOCREAT ), "tcjdbopen $path again" );
44
45			}
46
47	dpavlin	37	ok( tcjdbput( $jdb, 1, [ 'foobar' ] ), 'tcjdbput' );
48			diag tcjdberrmsg( tcjdbecode( $jdb ) );
49
50			ok( tcjdbout( $jdb, 1 ), 'tcjdbout' );
51
52			ok( tcjdbput( $jdb, 42, [ 'some', 'data' ] ), 'tcjdbput again' );
53
54			ok( tcjdbput2( $jdb, 99, 'some more data again', ' ' ), 'tcjdbput2' );
55
56			is_deeply( tcjdbsearch( $jdb, 'some', JDBSSUBSTR ), [ 42 ], 'tcjdbsearch' );
57			ok( tcjdbput( $jdb, 65536, [ 'some', 'more', 'data' ] ), 'tcjdbput more data' );
58			is_deeply( tcjdbsearch( $jdb, 'some', JDBSSUBSTR ), [ 42, 65536 ], 'tcjdbsearch' );
59
60			ok( tcjdbsync( $jdb ), 'tcjdbsync' );
61
62			ok( tcjdboptimize( $jdb ), 'tcjdboptimize' );
63
64			my $copy_path = $path . '-copy';
65
66			ok( tcjdbcopy( $jdb, $copy_path ), "tcjdbcopy $copy_path" );
67			ok( -e $copy_path, 'copy exists' );
68
69			is( tcjdbpath( $jdb ), $path, 'tcjdbpath' );
70
71	dpavlin	38	is( tcjdbrnum( $jdb ), 3, 'tcjdbrnum' );
72	dpavlin	37
73			ok( my $file_size = tcjdbfsiz( $jdb ), 'tcjdbfsiz' );
74
75			ok( tcjdbvanish( $jdb ), 'tcjdbvanish' );
76
77			is( tcjdbrnum( $jdb ), 0, 'tcjdbrnum' );
78
79			cmp_ok( tcjdbfsiz( $jdb ), '<=', $file_size, 'tcjdbfsiz' );
80
81			diag tcjdberrmsg( tcjdbecode( $jdb ) );