test/tcl/sdb019.tcl

   1 # See the file LICENSE for redistribution information.
   2 #
   3 # Copyright (c) 1999, 2012 Oracle and/or its affiliates.  All rights reserved.
   4 #
   5 # $Id$
   6 #
   7 # TEST  sdb019
   8 # TEST  Tests in-memory subdatabases.
   9 # TEST  Create an in-memory subdb.  Test for persistence after
  10 # TEST  overflowing the cache.  Test for conflicts when we have
  11 # TEST  two in-memory files.
  12
  13 proc sdb019 { method { nentries 100 } args } {
  14         source ./include.tcl
  15
  16         set tnum "019"
  17         set args [convert_args $method $args]
  18         set omethod [convert_method $method]
  19
  20        if { [is_queueext $method] == 1 || [is_heap $method] == 1 } {
  21                 puts "Subdb$tnum: skipping for method $method"
  22                 return
  23         }
  24         puts "Subdb$tnum: $method ($args) in-memory subdb tests"
  25
  26         # If we are using an env, then skip this test.  It needs its own.
  27         set eindex [lsearch -exact $args "-env"]
  28         if { $eindex != -1 } {
  29                 set env NULL
  30                 incr eindex
  31                 set env [lindex $args $eindex]
  32                 puts "Subdb019 skipping for env $env"
  33                 return
  34         }
  35
  36         # In-memory dbs never go to disk, so we can't do checksumming.
  37         # If the test module sent in the -chksum arg, get rid of it.
  38         set chkindex [lsearch -exact $args "-chksum"]
  39         if { $chkindex != -1 } {
  40                 set args [lreplace $args $chkindex $chkindex]
  41         }
  42
  43         # The standard cachesize isn't big enough for 64k pages.
  44         set csize "0 262144 1"
  45         set pgindex [lsearch -exact $args "-pagesize"]
  46         if { $pgindex != -1 } {
  47                 incr pgindex
  48                 set pagesize [lindex $args $pgindex]
  49                 if { $pagesize > 16384 } {
  50                         set cache [expr 8 * $pagesize]
  51                         set csize "0 $cache 1"
  52                 }
  53         }
  54
  55         # Create the env.
  56         env_cleanup $testdir
  57         set env [eval berkdb_env -create {-cachesize $csize} \
  58             -home $testdir -txn]
  59         error_check_good dbenv [is_valid_env $env] TRUE
  60
  61         # Set filename to NULL; this allows us to create an in-memory
  62         # named database.
  63         set testfile ""
  64
  65         # Create two in-memory subdb and test for conflicts.  Try all the
  66         # combinations of named (NULL/NAME) and purely temporary
  67         # (NULL/NULL) databases.
  68         #
  69         foreach s1 { S1 "" } {
  70                 foreach s2 { S2 "" } {
  71                         puts "\tSubdb$tnum.a:\
  72                             2 in-memory subdbs (NULL/$s1, NULL/$s2)."
  73                         set sdb1 [eval {berkdb_open -create -mode 0644} \
  74                             $args -env $env {$omethod $testfile $s1}]
  75                         error_check_good sdb1_open [is_valid_db $sdb1] TRUE
  76                         set sdb2 [eval {berkdb_open -create -mode 0644} \
  77                             $args -env $env {$omethod $testfile $s2}]
  78                         error_check_good sdb1_open [is_valid_db $sdb2] TRUE
  79
  80                         # Subdatabases are open, now put something in.
  81                         set string1 STRING1
  82                         set string2 STRING2
  83                         for { set i 1 } { $i <= $nentries } { incr i } {
  84                                 set key $i
  85                                 error_check_good sdb1_put [$sdb1 put $key \
  86                                     [chop_data $method $string1.$key]] 0
  87                                 error_check_good sdb2_put [$sdb2 put $key \
  88                                     [chop_data $method $string2.$key]] 0
  89                         }
  90
  91                         # If the subs are both NULL/NULL, we have two handles
  92                         # on the same db.  Skip testing the contents.
  93                         if { $s1 != "" || $s2 != "" } {
  94                                 # This can't work when both subs are NULL/NULL.
  95                                 # Check contents.
  96                                 for { set i 1 } { $i <= $nentries } { incr i } {
  97                                         set key $i
  98                                         set ret1 [lindex \
  99                                             [lindex [$sdb1 get $key] 0] 1]
 100                                         error_check_good sdb1_get $ret1 \
 101                                             [pad_data $method $string1.$key]
 102                                         set ret2 [lindex \
 103                                             [lindex [$sdb2 get $key] 0] 1]
 104                                         error_check_good sdb2_get $ret2 \
 105                                             [pad_data $method $string2.$key]
 106                                 }
 107
 108                                 error_check_good sdb1_close [$sdb1 close] 0
 109                                 error_check_good sdb2_close [$sdb2 close] 0
 110
 111                                 # Reopen, make sure we get the right data.
 112                                 set sdb1 [eval {berkdb_open -mode 0644} \
 113                                     $args -env $env {$omethod $testfile $s1}]
 114                                 error_check_good \
 115                                     sdb1_open [is_valid_db $sdb1] TRUE
 116                                 set sdb2 [eval {berkdb_open -mode 0644} \
 117                                     $args -env $env {$omethod $testfile $s2}]
 118                                 error_check_good \
 119                                     sdb1_open [is_valid_db $sdb2] TRUE
 120
 121                                 for { set i 1 } { $i <= $nentries } { incr i } {
 122                                         set key $i
 123                                         set ret1 [lindex \
 124                                             [lindex [$sdb1 get $key] 0] 1]
 125                                         error_check_good sdb1_get $ret1 \
 126                                             [pad_data $method $string1.$key]
 127                                         set ret2 [lindex \
 128                                             [lindex [$sdb2 get $key] 0] 1]
 129                                         error_check_good sdb2_get $ret2 \
 130                                             [pad_data $method $string2.$key]
 131                                 }
 132                         }
 133                         error_check_good sdb1_close [$sdb1 close] 0
 134                         error_check_good sdb2_close [$sdb2 close] 0
 135                 }
 136         }
 137         error_check_good env_close [$env close] 0
 138 }
 139