/[Search-TokyoDystopia]/t/10-tci.t
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /t/10-tci.t

Parent Directory Parent Directory | Revision Log Revision Log


Revision 26 - (hide annotations)
Mon Aug 18 19:04:10 2008 UTC (15 years, 7 months ago) by dpavlin
Original Path: t/10-xs.t
File MIME type: application/x-troff
File size: 2062 byte(s)
tcidbpath
1 dpavlin 1 #!/usr/bin/perl
2    
3     use warnings;
4     use strict;
5    
6     use blib;
7    
8 dpavlin 26 use Test::More tests => 32;
9 dpavlin 1 use Test::Exception;
10     use Data::Dump qw/dump/;
11    
12     BEGIN {
13     use_ok( 'Search::TokyoDystopia' );
14     }
15    
16 dpavlin 13 my $path = 'casket';
17    
18 dpavlin 1 cmp_ok( $Search::TokyoDystopia::debug, '==', 0, '$debug' );
19 dpavlin 2
20 dpavlin 10 cmp_ok( tcidberrmsg(0), 'eq', 'success', 'tcidberrmsg' );
21 dpavlin 1
22 dpavlin 10 ok( my $idb = tcidbnew, 'tcidbnew' ); # FIXME check better
23 dpavlin 3
24 dpavlin 10 ok( ! tcidbdel( $idb ), 'tcidbdel' );
25 dpavlin 4
26 dpavlin 10 ok( $idb = tcidbnew, 'tcidbnew again' );
27 dpavlin 5
28 dpavlin 10 is( tcidbecode( $idb ), 0, 'tcidbecode' );
29 dpavlin 5
30 dpavlin 13 ok( tcidbtune( $idb, 0, 0, 0, IDBTLARGE | IDBTDEFLATE ), 'tcidbtune' );
31 dpavlin 7
32 dpavlin 10 ok( tcidbsetcache( $idb, 0, 0 ), 'tcidbsetcache' );
33 dpavlin 9
34 dpavlin 10 ok( tcidbsetfwmmax( $idb, 0 ), 'tcidbsetfwmmax' );
35 dpavlin 9
36 dpavlin 21 ok( tcidbopen( $idb, $path, IDBOWRITER | IDBOCREAT | IDBOTRUNC ), "tcidbopen $path" );
37 dpavlin 10
38 dpavlin 11 ok( tcidbclose( $idb ), 'tcidbclose' );
39 dpavlin 14
40     ok( tcidbopen( $idb, $path, IDBOWRITER | IDBOCREAT ), "tcidbopen $path again" );
41    
42     ok( tcidbput( $idb, 1, 'foobar' ), 'tcidbput' );
43    
44 dpavlin 15 ok( tcidbout( $idb, 1, ), 'tcidbout' );
45    
46 dpavlin 17 ok( tcidbput( $idb, 42, 'some data' ), 'tcidbput again' );
47     is( tcidbget( $idb, 42 ), 'some data', 'tcidbget' );
48     ok( ! tcidbget( $idb, 1 ), 'tcidbget non-existing' );
49 dpavlin 18
50     is_deeply( tcidbsearch( $idb, 'some', IDBSSUBSTR ), [ 42 ], 'tcidbsearch' );
51     ok( tcidbput( $idb, 65536, 'some more data' ), 'tcidbput more data' );
52     is_deeply( tcidbsearch( $idb, 'some', IDBSSUBSTR ), [ 42, 65536 ], 'tcidbsearch' );
53    
54 dpavlin 22 is_deeply( tcidbsearch2( $idb, 'some' ), [ 42, 65536 ], 'tcidbsearch2' );
55    
56 dpavlin 19 ok( tcidbiterinit( $idb ), 'tcidbiterinit' );
57    
58 dpavlin 20 my @ids;
59    
60     while ( my $id = tcidbiternext( $idb ) ) {
61     ok( $id, "tcidbiternext $id" );
62     push @ids, $id;
63     }
64    
65     # order is not defined, so we need to sort it
66     is_deeply( [ sort @ids ], [ 42, 65536 ], 'all records' );
67    
68 dpavlin 21 ok( tcidbsync( $idb ), 'tcidbsync' );
69    
70 dpavlin 23 ok( tcidboptimize( $idb ), 'tcidboptimize' );
71    
72 dpavlin 24 ok( tcidbvanish( $idb ), 'tcidbvanish' );
73    
74 dpavlin 25 my $copy_path = $path . '-copy';
75    
76     ok( tcidbcopy( $idb, $copy_path ), "tcidbcopy $copy_path" );
77     ok( -e $copy_path, 'copy exists' );
78    
79 dpavlin 26 is( tcidbpath( $idb ), $path, 'tcidbpath' );
80 dpavlin 14 diag tcidberrmsg( tcidbecode( $idb ) );

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26