← Back to branch summary

~ubuntu-branches/ubuntu/edgy/rpm/edgy

« back to all changes in this revision

Viewing changes to db/perl.BerkeleyDB/t/destroy.t

  • Committer: Bazaar Package Importer
  • Author(s): Joey Hess
  • Date: 2002-01-22 20:56:57 UTC
  • Revision ID: james.westby@ubuntu.com-20020122205657-l74j50mr9z8ofcl5
Tags: upstream-4.0.3
Import upstream version 4.0.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
db/perl.BerkeleyDB/t/destroy.t
 
1
#!./perl -w
 
2
 
 
3
use strict ;
 
4
 
 
5
BEGIN {
 
6
    unless(grep /blib/, @INC) {
 
7
        chdir 't' if -d 't';
 
8
        @INC = '../lib' if -d '../lib';
 
9
    }
 
10
}
 
11
 
 
12
use BerkeleyDB; 
 
13
use File::Path qw(rmtree);
 
14
 
 
15
print "1..13\n";
 
16
 
 
17
 
 
18
{
 
19
    package LexFile ;
 
20
 
 
21
    sub new
 
22
    {
 
23
        my $self = shift ;
 
24
        unlink @_ ;
 
25
        bless [ @_ ], $self ;
 
26
    }
 
27
 
 
28
    sub DESTROY
 
29
    {
 
30
        my $self = shift ;
 
31
        unlink @{ $self } ;
 
32
    }
 
33
}
 
34
 
 
35
sub ok
 
36
{
 
37
    my $no = shift ;
 
38
    my $result = shift ;
 
39
 
 
40
    print "not " unless $result ;
 
41
    print "ok $no\n" ;
 
42
}
 
43
 
 
44
sub docat
 
45
{
 
46
    my $file = shift;
 
47
    local $/ = undef;
 
48
    open(CAT,$file) || die "Cannot open $file:$!";
 
49
    my $result = <CAT>;
 
50
    close(CAT);
 
51
    return $result;
 
52
}
 
53
 
 
54
 
 
55
my $Dfile = "dbhash.tmp";
 
56
my $home = "./fred" ;
 
57
 
 
58
umask(0);
 
59
 
 
60
{
 
61
    # let object destroction kill everything
 
62
 
 
63
    my $lex = new LexFile $Dfile ;
 
64
    my %hash ;
 
65
    my $value ;
 
66
 
 
67
    rmtree $home if -e $home ;
 
68
    ok 1, mkdir($home, 0777) ;
 
69
    ok 2, my $env = new BerkeleyDB::Env -Home => $home,
 
70
                                     -Flags => DB_CREATE|DB_INIT_TXN|
 
71
                                                DB_INIT_MPOOL|DB_INIT_LOCK ;
 
72
    ok 3, my $txn = $env->txn_begin() ;
 
73
    ok 4, my $db1 = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile,
 
74
                                                -Flags     => DB_CREATE ,
 
75
                                                -Env       => $env,
 
76
                                                -Txn       => $txn  ;
 
77
 
 
78
    
 
79
    # create some data
 
80
    my %data =  (
 
81
                "red"   => "boat",
 
82
                "green" => "house",
 
83
                "blue"  => "sea",
 
84
                ) ;
 
85
 
 
86
    my $ret = 0 ;
 
87
    while (my ($k, $v) = each %data) {
 
88
        $ret += $db1->db_put($k, $v) ;
 
89
    }
 
90
    ok 5, $ret == 0 ;
 
91
 
 
92
    # should be able to see all the records
 
93
 
 
94
    ok 6, my $cursor = $db1->db_cursor() ;
 
95
    my ($k, $v) = ("", "") ;
 
96
    my $count = 0 ;
 
97
    # sequence forwards
 
98
    while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
 
99
        ++ $count ;
 
100
    }
 
101
    ok 7, $count == 3 ;
 
102
    undef $cursor ;
 
103
 
 
104
    # now abort the transaction
 
105
    ok 8, $txn->txn_abort() == 0 ;
 
106
 
 
107
    # there shouldn't be any records in the database
 
108
    $count = 0 ;
 
109
    # sequence forwards
 
110
    ok 9, $cursor = $db1->db_cursor() ;
 
111
    while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
 
112
        ++ $count ;
 
113
    }
 
114
    ok 10, $count == 0 ;
 
115
 
 
116
    #undef $txn ;
 
117
    #undef $cursor ;
 
118
    #undef $db1 ;
 
119
    #undef $env ;
 
120
    #untie %hash ;
 
121
 
 
122
}
 
123
{
 
124
    my $lex = new LexFile $Dfile ;
 
125
    my %hash ;
 
126
    my $cursor ;
 
127
    my ($k, $v) = ("", "") ;
 
128
    ok 11, my $db1 = tie %hash, 'BerkeleyDB::Hash', 
 
129
                -Filename       => $Dfile,
 
130
                -Flags          => DB_CREATE ;
 
131
    my $count = 0 ;
 
132
    # sequence forwards
 
133
    ok 12, $cursor = $db1->db_cursor() ;
 
134
    while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
 
135
        ++ $count ;
 
136
    }
 
137
    ok 13, $count == 0 ;
 
138
}
 
139
 
 
140
rmtree $home ;
 
141