blob: e7b0b2db4cfbcfc873980af1003c22b3812d51df (
plain)
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
53
54
55
56
57
58
59
60
61
|
# This test file covers POSIX file locking
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 2003-2009 Donal K. Fellows
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
source [file dirname [info script]]/testing.tcl
needs constraint jim
testConstraint aio.lock [expr {"lock" in [stdin -commands]}]
needs constraint aio.lock
set fh [open locktest.file w]
test lock-1.1 {grab lock} {
$fh lock
} 1
test lock-1.2 {grab lock again} {
$fh lock
} 1
test lock-1.j {release lock} {
$fh unlock
} 1
test lock-1.4 {release lock again} {
$fh unlock
} 1
test lock-1.5 {grab lock from sub-process} {
# Run a child process that grabs the lock for 0.5 seconds
set pid [exec [info nameofexecutable] -e {set fh [open locktest.file r+]; $fh lock; sleep 0.5} >/dev/null &]
sleep 0.1
# Try to grab the lock - should fail
set stat [$fh lock]
sleep 0.5
set stat
} 0
test lock-1.6 {wait for lock} {
# Run a child process that grabs the lock for 0.5 seconds
set pid [exec [info nameofexecutable] -e {set fh [open locktest.file r+]; $fh lock; sleep 0.5} >/dev/null &]
# And wait to acquire the lock in the parent. Should take ~500ms
set start [clock millis]
sleep 0.1
$fh lock -wait
set delta [expr {[clock millis] - $start}]
if {$delta < 100} {
error "Lock acquired after ${delta}ms"
}
} {}
$fh close
file delete locktest.file
testreport
|
