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