1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996-2002
# Sleepycat Software. All rights reserved.
#
# $Id: mutex001.tcl,v 1.1.1.1 2003/11/20 22:13:57 toshok Exp $
#
# TEST mutex001
# TEST Test basic mutex functionality
proc mutex001 { } {
source ./include.tcl
puts "Mutex001: Basic functionality"
env_cleanup $testdir
set nlocks 20
# Test open w/out create; should fail
error_check_bad \
env_open [catch {berkdb_env -lock -home $testdir} env] 0
puts "\tMutex001.a: Create lock env"
# Now open for real
set env [berkdb_env -create -mode 0644 -lock -home $testdir]
error_check_good env_open [is_valid_env $env] TRUE
puts "\tMutex001.b: Create $nlocks mutexes"
set m [$env mutex 0644 $nlocks]
error_check_good mutex_init [is_valid_mutex $m $env] TRUE
# Get, set each mutex; sleep, then get Release
puts "\tMutex001.c: Get/set loop"
for { set i 0 } { $i < $nlocks } { incr i } {
set r [$m get $i ]
error_check_good mutex_get $r 0
set r [$m setval $i $i]
error_check_good mutex_setval $r 0
}
tclsleep 5
for { set i 0 } { $i < $nlocks } { incr i } {
set r [$m getval $i]
error_check_good mutex_getval $r $i
set r [$m release $i ]
error_check_good mutex_get $r 0
}
error_check_good mutex_close [$m close] 0
error_check_good env_close [$env close] 0
}
|
