62 lines
1.6 KiB
Plaintext
62 lines
1.6 KiB
Plaintext
# 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
|