1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 2003,2008 Oracle. All rights reserved. 4# 5# $Id: lock006.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST lock006 8# TEST Test lock_vec interface. We do all the same things that 9# TEST lock001 does, using lock_vec instead of lock_get and lock_put, 10# TEST plus a few more things like lock-coupling. 11# TEST 1. Get and release one at a time. 12# TEST 2. Release with put_obj (all locks for a given locker/obj). 13# TEST 3. Release with put_all (all locks for a given locker). 14# TEST Regularly check lock_stat to verify all locks have been 15# TEST released. 16proc lock006 { } { 17 source ./include.tcl 18 global lock_curid 19 global lock_maxid 20 21 set save_curid $lock_curid 22 set save_maxid $lock_maxid 23 24 # Cleanup 25 env_cleanup $testdir 26 27 # Open the region we'll use for testing. 28 set eflags "-create -lock -home $testdir" 29 set env [eval {berkdb_env} $eflags] 30 error_check_good env [is_valid_env $env] TRUE 31 error_check_good lock_id_set \ 32 [$env lock_id_set $lock_curid $lock_maxid] 0 33 34 puts "Lock006: test basic lock operations using lock_vec interface" 35 set locker [$env lock_id] 36 set modes {ng write read iwrite iread iwr} 37 38 # Get and release each type of lock. 39 puts "\tLock006.a: get and release one at a time" 40 foreach m $modes { 41 set obj obj$m 42 set lockp [$env lock_vec $locker "get $obj $m"] 43 error_check_good lock_vec_get:a [is_blocked $lockp] 0 44 error_check_good lock_vec_get:a [is_valid_lock $lockp $env] TRUE 45 error_check_good lock_vec_put:a \ 46 [$env lock_vec $locker "put $lockp"] 0 47 } 48 how_many_locks 0 $env 49 50 # Get a bunch of locks for the same locker; these should work 51 set obj OBJECT 52 puts "\tLock006.b: Get many locks for 1 locker,\ 53 release with put_all." 54 foreach m $modes { 55 set lockp [$env lock_vec $locker "get $obj $m"] 56 error_check_good lock_vec_get:b [is_blocked $lockp] 0 57 error_check_good lock_vec_get:b [is_valid_lock $lockp $env] TRUE 58 } 59 how_many_locks 6 $env 60 error_check_good release [$env lock_vec $locker put_all] 0 61 how_many_locks 0 $env 62 63 puts "\tLock006.c: Get many locks for 1 locker,\ 64 release with put_obj." 65 foreach m $modes { 66 set lockp [$env lock_vec $locker "get $obj $m"] 67 error_check_good lock_vec_get:b [is_blocked $lockp] 0 68 error_check_good lock_vec_get:b [is_valid_lock $lockp $env] TRUE 69 } 70 error_check_good release [$env lock_vec $locker "put_obj $obj"] 0 71# how_many_locks 0 $env 72 how_many_locks 6 $env 73 74 # Get many locks for the same locker on more than one object. 75 # Release with put_all. 76 set obj2 OBJECT2 77 puts "\tLock006.d: Get many locks on 2 objects for 1 locker,\ 78 release with put_all." 79 foreach m $modes { 80 set lockp [$env lock_vec $locker "get $obj $m"] 81 error_check_good lock_vec_get:b [is_blocked $lockp] 0 82 error_check_good lock_vec_get:b [is_valid_lock $lockp $env] TRUE 83 } 84 foreach m $modes { 85 set lockp [$env lock_vec $locker "get $obj2 $m"] 86 error_check_good lock_vec_get:b [is_blocked $lockp] 0 87 error_check_good lock_vec_get:b [is_valid_lock $lockp $env] TRUE 88 } 89 error_check_good release [$env lock_vec $locker put_all] 0 90# how_many_locks 0 $env 91 how_many_locks 6 $env 92 93 # Check that reference counted locks work. 94 puts "\tLock006.e: reference counted locks." 95 for {set i 0} { $i < 10 } {incr i} { 96 set lockp [$env lock_vec -nowait $locker "get $obj write"] 97 error_check_good lock_vec_get:c [is_blocked $lockp] 0 98 error_check_good lock_vec_get:c [is_valid_lock $lockp $env] TRUE 99 } 100 error_check_good put_all [$env lock_vec $locker put_all] 0 101# how_many_locks 0 $env 102 how_many_locks 6 $env 103 104 # Lock-coupling. Get a lock on object 1. Get a lock on object 2, 105 # release object 1, and so on. 106 puts "\tLock006.f: Lock-coupling." 107 set locker2 [$env lock_id] 108 109 foreach m { read write iwrite iread iwr } { 110 set lockp [$env lock_vec $locker "get OBJ0 $m"] 111 set iter 0 112 set nobjects 10 113 while { $iter < 3 } { 114 for { set i 1 } { $i <= $nobjects } { incr i } { 115 set lockv [$env lock_vec $locker \ 116 "get OBJ$i $m" "put $lockp"] 117 118 # Make sure another locker can get an exclusive 119 # lock on the object just released. 120 set lock2p [$env lock_vec -nowait $locker2 \ 121 "get OBJ[expr $i - 1] write" ] 122 error_check_good release_lock2 [$env lock_vec \ 123 $locker2 "put $lock2p"] 0 124 125 # Make sure another locker can't get an exclusive 126 # lock on the object just locked. 127 catch {$env lock_vec -nowait $locker2 \ 128 "get OBJ$i write"} ret 129 error_check_good not_granted \ 130 [is_substr $ret "not granted"] 1 131 132 set lockp [lindex $lockv 0] 133 if { $i == $nobjects } { 134 incr iter 135 } 136 } 137 } 138 error_check_good lock_put [$env lock_vec $locker "put $lockp"] 0 139# how_many_locks 0 $env 140 how_many_locks 6 $env 141 } 142 143 # Finally try some failing locks. Set up a write lock on object. 144 foreach m { write } { 145 set lockp [$env lock_vec $locker "get $obj $m"] 146 error_check_good lock_vec_get:d [is_blocked $lockp] 0 147 error_check_good lock_vec_get:d [is_valid_lock $lockp $env] TRUE 148 } 149 150 # Change the locker 151 set newlocker [$env lock_id] 152 # Skip NO_LOCK. 153 puts "\tLock006.g: Change the locker, try to acquire read and write." 154 foreach m { read write iwrite iread iwr } { 155 catch {$env lock_vec -nowait $newlocker "get $obj $m"} ret 156 error_check_good lock_vec_get:d [is_substr $ret "not granted"] 1 157 } 158 159 # Now release original locks 160 error_check_good put_all [$env lock_vec $locker {put_all}] 0 161 error_check_good free_id [$env lock_id_free $locker] 0 162 163 # Now re-acquire blocking locks 164 puts "\tLock006.h: Re-acquire blocking locks." 165 foreach m { read write iwrite iread iwr } { 166 set lockp [$env lock_vec -nowait $newlocker "get $obj $m"] 167 error_check_good lock_get:e [is_valid_lock $lockp $env] TRUE 168 error_check_good lock_get:e [is_blocked $lockp] 0 169 } 170 171 # Now release new locks 172 error_check_good put_all [$env lock_vec $newlocker {put_all}] 0 173 error_check_good free_id [$env lock_id_free $newlocker] 0 174 175 error_check_good envclose [$env close] 0 176 177} 178 179# Blocked locks appear as lockmgrN.lockM\nBLOCKED 180proc is_blocked { l } { 181 if { [string compare $l BLOCKED ] == 0 } { 182 return 1 183 } else { 184 return 0 185 } 186} 187