1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: lock001.tcl,v 12.7 2008/01/08 20:58:53 bostic Exp $ 6# 7 8# TEST lock001 9# TEST Make sure that the basic lock tests work. Do some simple gets 10# TEST and puts for a single locker. 11proc lock001 { {iterations 1000} } { 12 source ./include.tcl 13 global lock_curid 14 global lock_maxid 15 16 set save_curid $lock_curid 17 set save_maxid $lock_maxid 18 19 # Set defaults 20 # Adjusted to make exact match of isqrt 21 #set conflicts { 3 0 0 0 0 0 1 0 1 1} 22 #set conflicts { 3 0 0 0 0 1 0 1 1} 23 24 set conflicts { 0 0 0 0 0 1 0 1 1} 25 set nmodes [isqrt [llength $conflicts]] 26 27 # Cleanup 28 env_cleanup $testdir 29 30 # Open the region we'll use for testing. 31 set eflags "-create -lock -home $testdir -mode 0644 \ 32 -lock_conflict {$nmodes {$conflicts}}" 33 set env [eval {berkdb_env} $eflags] 34 error_check_good env [is_valid_env $env] TRUE 35 error_check_good lock_id_set \ 36 [$env lock_id_set $lock_curid $lock_maxid] 0 37 38 puts "Lock001: test basic lock operations" 39 set locker [$env lock_id] 40 # Get and release each type of lock 41 puts "\tLock001.a: get and release each type of lock" 42 foreach m {ng write read} { 43 set obj obj$m 44 set lockp [$env lock_get $m $locker $obj] 45 error_check_good lock_get:a [is_blocked $lockp] 0 46 error_check_good lock_get:a [is_substr $lockp $env] 1 47 set ret [ $lockp put ] 48 error_check_good lock_put $ret 0 49 } 50 51 # Get a bunch of locks for the same locker; these should work 52 set obj OBJECT 53 puts "\tLock001.b: Get a bunch of locks for the same locker" 54 foreach m {ng write read} { 55 set lockp [$env lock_get $m $locker $obj ] 56 lappend locklist $lockp 57 error_check_good lock_get:b [is_blocked $lockp] 0 58 error_check_good lock_get:b [is_substr $lockp $env] 1 59 } 60 release_list $locklist 61 62 set locklist {} 63 # Check that reference counted locks work 64 puts "\tLock001.c: reference counted locks." 65 for {set i 0} { $i < 10 } {incr i} { 66 set lockp [$env lock_get -nowait write $locker $obj] 67 error_check_good lock_get:c [is_blocked $lockp] 0 68 error_check_good lock_get:c [is_substr $lockp $env] 1 69 lappend locklist $lockp 70 } 71 release_list $locklist 72 73 # Finally try some failing locks 74 set locklist {} 75 foreach i {ng write read} { 76 set lockp [$env lock_get $i $locker $obj] 77 lappend locklist $lockp 78 error_check_good lock_get:d [is_blocked $lockp] 0 79 error_check_good lock_get:d [is_substr $lockp $env] 1 80 } 81 82 # Change the locker 83 set locker [$env lock_id] 84 set blocklist {} 85 # Skip NO_LOCK lock. 86 puts "\tLock001.d: Change the locker, acquire read and write." 87 foreach i {write read} { 88 catch {$env lock_get -nowait $i $locker $obj} ret 89 error_check_good lock_get:e [is_substr $ret "not granted"] 1 90 #error_check_good lock_get:e [is_substr $lockp $env] 1 91 #error_check_good lock_get:e [is_blocked $lockp] 0 92 } 93 # Now release original locks 94 release_list $locklist 95 96 # Now re-acquire blocking locks 97 set locklist {} 98 puts "\tLock001.e: Re-acquire blocking locks." 99 foreach i {write read} { 100 set lockp [$env lock_get -nowait $i $locker $obj ] 101 error_check_good lock_get:f [is_substr $lockp $env] 1 102 error_check_good lock_get:f [is_blocked $lockp] 0 103 lappend locklist $lockp 104 } 105 106 # Now release new locks 107 release_list $locklist 108 error_check_good free_id [$env lock_id_free $locker] 0 109 110 error_check_good envclose [$env close] 0 111 112} 113 114# Blocked locks appear as lockmgrN.lockM\nBLOCKED 115proc is_blocked { l } { 116 if { [string compare $l BLOCKED ] == 0 } { 117 return 1 118 } else { 119 return 0 120 } 121} 122