test/tcl/memp004.tcl

   1 # See the file LICENSE for redistribution information.
   2 #
   3 # Copyright (c) 1996, 2012 Oracle and/or its affiliates.  All rights reserved.
   4 #
   5 # $Id$
   6 #
   7
   8 # TEST  memp004
   9 # TEST  Test that small read-only databases are mapped into memory.
  10 proc 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.
  71 proc 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 }