blob: d8e16cb439ecf71a77b6d4a1911e4b35ea6f4ebe (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996-2009 Oracle. All rights reserved.
#
# $Id$
#
# TEST memp004
# TEST Test that small read-only databases are mapped into memory.
proc memp004 { } {
global is_qnx_test
source ./include.tcl
puts "Memp004: Test of memory-mapped read-only databases"
if { $is_qnx_test } {
puts "Memp004: skipping for QNX"
return
}
env_cleanup $testdir
set testfile memp004.db
# Create an environment.
puts "memp004.a: Create an environment and database"
set dbenv [eval {berkdb_env -create -home $testdir -private}]
error_check_good dbenv [is_valid_env $dbenv] TRUE
set db [berkdb_open -env $dbenv -create -mode 0644 -btree $testfile]
error_check_good dbopen/$testfile/RW [is_valid_db $db] TRUE
# Put each key/data pair.
set did [open $dict]
set keys ""
set count 0
while { [gets $did str] != -1 && $count < 1000 } {
lappend keys $str
set ret [eval {$db put} {$str $str}]
error_check_good put $ret 0
incr count
}
close $did
error_check_good close [$db close] 0
# Discard the environment.
error_check_good close [$dbenv close] 0
puts "memp004.b: Re-create the environment and open database read-only"
set dbenv [eval {berkdb_env -create -home $testdir}]
error_check_good dbenv [is_valid_env $dbenv] TRUE
set db [berkdb_open -env $dbenv -rdonly $testfile]
error_check_good dbopen/$testfile/RO [is_substr $db db] 1
# Read a couple of keys.
set c [eval {$db cursor}]
for { set i 0 } { $i < 500 } { incr i } {
set ret [$c get -next]
}
puts "memp004.c: Check mpool statistics"
set tmp [memp004_stat $dbenv "Pages mapped into address space"]
error_check_good "mmap check: $tmp >= 500" [expr $tmp >= 500] 1
error_check_good db_close [$db close] 0
reset_env $dbenv
}
# memp004_stat --
# Return the current mpool statistics.
proc memp004_stat { env s } {
set stat [$env mpool_stat]
foreach statpair $stat {
set statmsg [lindex $statpair 0]
set statval [lindex $statpair 1]
if {[is_substr $statmsg $s] != 0} {
return $statval
}
}
puts "FAIL: memp004: stat string $s not found"
return 0
}
|
