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