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
52
|
# See the file LICENSE for redistribution information.
#
# Copyright (c) 2009, 2013 Oracle and/or its affiliates. All rights reserved.
#
# $Id$
#
# TEST mut002
# TEST Two-process mutex test.
# TEST
# TEST Allocate and lock a self-blocking mutex. Start another process.
# TEST Try to lock the mutex again -- it will block.
# TEST Unlock the mutex from the other process, and the blocked
# TEST lock should be obtained. Clean up.
# TEST Do another test with a "-process-only" mutex. The second
# TEST process should not be able to unlock the mutex.
proc mut002 { } {
source ./include.tcl
puts "Mut002: Two process mutex test."
# Open an env.
set env [berkdb_env -create -home $testdir]
puts "\tMut002.a: Allocate and lock a mutex."
set mutex [$env mutex -self_block]
error_check_good obtained_lock [$env mutex_lock $mutex] 0
# Start a second process.
puts "\tMut002.b: Start another process."
set p2 [exec $tclsh_path $test_path/wrap.tcl mut002script.tcl\
$testdir/mut002.log $testdir $mutex &]
# Try to lock the mutex again. This will hang until the second
# process unlocks it.
$env mutex_lock $mutex
watch_procs $p2 1 20
# Clean up, and check the log file from process 2.
error_check_good mutex_unlock [$env mutex_unlock $mutex] 0
error_check_good env_close [$env close] 0
# We expect the log file to be empty. If there are any
# messages, report them as failures.
set fd [open $testdir/mut002.log r]
while { [gets $fd line] >= 0 } {
puts "FAIL: unexpected output in log file mut002: $line"
}
close $fd
}
|
