1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996,2008 Oracle. All rights reserved. 4# 5# $Id: lock003.tcl,v 12.6 2008/01/08 20:58:53 bostic Exp $ 6# 7# TEST lock003 8# TEST Exercise multi-process aspects of lock. Generate a bunch of parallel 9# TEST testers that try to randomly obtain locks; make sure that the locks 10# TEST correctly protect corresponding objects. 11proc lock003 { {iter 500} {max 1000} {procs 5} } { 12 source ./include.tcl 13 global lock_curid 14 global lock_maxid 15 16 set ldegree 5 17 set objs 75 18 set reads 65 19 set wait 1 20 set conflicts { 0 0 0 0 0 1 0 1 1} 21 set seeds {} 22 23 puts "Lock003: Multi-process random lock test" 24 25 # Clean up after previous runs 26 env_cleanup $testdir 27 28 # Open/create the lock region 29 puts "\tLock003.a: Create environment" 30 set e [berkdb_env -create -lock -home $testdir] 31 error_check_good env_open [is_substr $e env] 1 32 $e lock_id_set $lock_curid $lock_maxid 33 34 error_check_good env_close [$e close] 0 35 36 # Now spawn off processes 37 set pidlist {} 38 39 for { set i 0 } {$i < $procs} {incr i} { 40 if { [llength $seeds] == $procs } { 41 set s [lindex $seeds $i] 42 } 43# puts "$tclsh_path\ 44# $test_path/wrap.tcl \ 45# lockscript.tcl $testdir/$i.lockout\ 46# $testdir $iter $objs $wait $ldegree $reads &" 47 set p [exec $tclsh_path $test_path/wrap.tcl \ 48 lockscript.tcl $testdir/lock003.$i.out \ 49 $testdir $iter $objs $wait $ldegree $reads &] 50 lappend pidlist $p 51 } 52 53 puts "\tLock003.b: $procs independent processes now running" 54 watch_procs $pidlist 30 10800 55 56 # Check for test failure 57 set errstrings [eval findfail [glob $testdir/lock003.*.out]] 58 foreach str $errstrings { 59 puts "FAIL: error message in .out file: $str" 60 } 61 62 # Remove log files 63 for { set i 0 } {$i < $procs} {incr i} { 64 fileremove -f $testdir/lock003.$i.out 65 } 66} 67 68# Create and destroy flag files to show we have an object locked, and 69# verify that the correct files exist or don't exist given that we've 70# just read or write locked a file. 71proc lock003_create { rw obj } { 72 source ./include.tcl 73 74 set pref $testdir/L3FLAG 75 set f [open $pref.$rw.[pid].$obj w] 76 close $f 77} 78 79proc lock003_destroy { obj } { 80 source ./include.tcl 81 82 set pref $testdir/L3FLAG 83 set f [glob -nocomplain $pref.*.[pid].$obj] 84 error_check_good l3_destroy [llength $f] 1 85 fileremove $f 86} 87 88proc lock003_vrfy { rw obj } { 89 source ./include.tcl 90 91 set pref $testdir/L3FLAG 92 if { [string compare $rw "write"] == 0 } { 93 set fs [glob -nocomplain $pref.*.*.$obj] 94 error_check_good "number of other locks on $obj" [llength $fs] 0 95 } else { 96 set fs [glob -nocomplain $pref.write.*.$obj] 97 error_check_good "number of write locks on $obj" [llength $fs] 0 98 } 99} 100 101