1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: lock002.tcl,v 12.8 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST lock002 8# TEST Exercise basic multi-process aspects of lock. 9proc lock002 { {conflicts {0 0 0 0 0 1 0 1 1} } } { 10 source ./include.tcl 11 12 puts "Lock002: Basic multi-process lock tests." 13 14 env_cleanup $testdir 15 16 set nmodes [isqrt [llength $conflicts]] 17 18 # Open the lock 19 mlock_open $nmodes $conflicts 20 mlock_wait 21} 22 23# Make sure that we can create a region; destroy it, attach to it, 24# detach from it, etc. 25proc mlock_open { nmodes conflicts } { 26 source ./include.tcl 27 global lock_curid 28 global lock_maxid 29 30 puts "\tLock002.a multi-process open/close test" 31 32 # Open/Create region here. Then close it and try to open from 33 # other test process. 34 set env_cmd [concat "berkdb_env -create -mode 0644 -lock \ 35 -lock_conflict" [list [list $nmodes $conflicts]] "-home $testdir"] 36 set local_env [eval $env_cmd] 37 $local_env lock_id_set $lock_curid $lock_maxid 38 error_check_good env_open [is_valid_env $local_env] TRUE 39 40 set ret [$local_env close] 41 error_check_good env_close $ret 0 42 43 # Open from other test process 44 set env_cmd "berkdb_env -mode 0644 -home $testdir" 45 46 set f1 [open |$tclsh_path r+] 47 puts $f1 "source $test_path/test.tcl" 48 49 set remote_env [send_cmd $f1 $env_cmd] 50 error_check_good remote:env_open [is_valid_env $remote_env] TRUE 51 52 # Now make sure that we can reopen the region. 53 set local_env [eval $env_cmd] 54 error_check_good env_open [is_valid_env $local_env] TRUE 55 set ret [$local_env close] 56 error_check_good env_close $ret 0 57 58 # Try closing the remote region 59 set ret [send_cmd $f1 "$remote_env close"] 60 error_check_good remote:lock_close $ret 0 61 62 # Try opening for create. Will succeed because region exists. 63 set env_cmd [concat "berkdb_env -create -mode 0644 -lock \ 64 -lock_conflict" [list [list $nmodes $conflicts]] "-home $testdir"] 65 set local_env [eval $env_cmd] 66 error_check_good remote:env_open [is_valid_env $local_env] TRUE 67 68 # close locally 69 reset_env $local_env 70 71 # Close and exit remote 72 set ret [send_cmd $f1 "reset_env $remote_env"] 73 74 catch { close $f1 } result 75} 76 77proc mlock_wait { } { 78 source ./include.tcl 79 80 puts "\tLock002.b multi-process get/put wait test" 81 82 # Open region locally 83 set env_cmd "berkdb_env -home $testdir" 84 set local_env [eval $env_cmd] 85 error_check_good env_open [is_valid_env $local_env] TRUE 86 87 # Open region remotely 88 set f1 [open |$tclsh_path r+] 89 90 puts $f1 "source $test_path/test.tcl" 91 92 set remote_env [send_cmd $f1 $env_cmd] 93 error_check_good remote:env_open [is_valid_env $remote_env] TRUE 94 95 # Get a write lock locally; try for the read lock 96 # remotely. We hold the locks for several seconds 97 # so that we can use timestamps to figure out if the 98 # other process waited. 99 set locker1 [$local_env lock_id] 100 set local_lock [$local_env lock_get write $locker1 object1] 101 error_check_good lock_get [is_valid_lock $local_lock $local_env] TRUE 102 103 # Now request a lock that we expect to hang; generate 104 # timestamps so we can tell if it actually hangs. 105 set locker2 [send_cmd $f1 "$remote_env lock_id"] 106 set remote_lock [send_timed_cmd $f1 1 \ 107 "set lock \[$remote_env lock_get write $locker2 object1\]"] 108 109 # Now sleep before releasing lock 110 tclsleep 5 111 set result [$local_lock put] 112 error_check_good lock_put $result 0 113 114 # Now get the result from the other script 115 set result [rcv_result $f1] 116 error_check_good lock_get:remote_time [expr $result > 4] 1 117 118 # Now get the remote lock 119 set remote_lock [send_cmd $f1 "puts \$lock"] 120 error_check_good remote:lock_get \ 121 [is_valid_lock $remote_lock $remote_env] TRUE 122 123 # Now make the other guy wait 5 seconds and then release his 124 # lock while we try to get a write lock on it. 125 set start [timestamp -r] 126 127 set ret [send_cmd $f1 "tclsleep 5"] 128 129 set ret [send_cmd $f1 "$remote_lock put"] 130 131 set local_lock [$local_env lock_get write $locker1 object1] 132 error_check_good lock_get:time \ 133 [expr [expr [timestamp -r] - $start] > 2] 1 134 error_check_good lock_get:local \ 135 [is_valid_lock $local_lock $local_env] TRUE 136 137 # Now check remote's result 138 set result [rcv_result $f1] 139 error_check_good lock_put:remote $result 0 140 141 # Clean up remote 142 set result [send_cmd $f1 "$remote_env lock_id_free $locker2" ] 143 error_check_good remote_free_id $result 0 144 set ret [send_cmd $f1 "reset_env $remote_env"] 145 146 close $f1 147 148 # Now close up locally 149 set ret [$local_lock put] 150 error_check_good lock_put $ret 0 151 error_check_good lock_id_free [$local_env lock_id_free $locker1] 0 152 153 reset_env $local_env 154} 155