Add dot-locking library
This commit is contained in:
parent
4f00dba463
commit
4e62182c00
|
|
@ -26,3 +26,4 @@ venv*
|
||||||
retropikzel/wasm/plus.sld
|
retropikzel/wasm/plus.sld
|
||||||
retropikzel/*.c
|
retropikzel/*.c
|
||||||
retropikzel/*.meta
|
retropikzel/*.meta
|
||||||
|
test-program
|
||||||
|
|
|
||||||
18
Makefile
18
Makefile
|
|
@ -12,7 +12,7 @@ LIBRARY_FILE=retropikzel/${LIBRARY}.sld
|
||||||
TESTFILE=retropikzel/${LIBRARY}/test.scm
|
TESTFILE=retropikzel/${LIBRARY}/test.scm
|
||||||
VERSION != cat retropikzel/${LIBRARY}/VERSION
|
VERSION != cat retropikzel/${LIBRARY}/VERSION
|
||||||
DESCRIPTION != head -n1 retropikzel/${LIBRARY}/README.md
|
DESCRIPTION != head -n1 retropikzel/${LIBRARY}/README.md
|
||||||
README=retropikzel/${LIBRARY}/README.html
|
DOCFILE=retropikzel/${LIBRARY}/README.html
|
||||||
|
|
||||||
ifeq "${SCHEME}" "capyscheme"
|
ifeq "${SCHEME}" "capyscheme"
|
||||||
DOCKER_TAG=head
|
DOCKER_TAG=head
|
||||||
|
|
@ -32,12 +32,12 @@ endif
|
||||||
all: package
|
all: package
|
||||||
|
|
||||||
package: retropikzel/${LIBRARY}/LICENSE retropikzel/${LIBRARY}/VERSION retropikzel/${LIBRARY}/README.md
|
package: retropikzel/${LIBRARY}/LICENSE retropikzel/${LIBRARY}/VERSION retropikzel/${LIBRARY}/README.md
|
||||||
echo "<pre>$$(cat retropikzel/${LIBRARY}/README.md)</pre>" > ${README}
|
echo "<pre>$$(cat retropikzel/${LIBRARY}/README.md)</pre>" > ${DOCFILE}
|
||||||
snow-chibi package \
|
snow-chibi package \
|
||||||
--always-yes \
|
--always-yes \
|
||||||
--version=${VERSION} \
|
--version=${VERSION} \
|
||||||
--authors=${AUTHOR} \
|
--authors=${AUTHOR} \
|
||||||
--doc-from-scribble=1 \
|
--doc=${DOCFILE} \
|
||||||
--description="${DESCRIPTION}" \
|
--description="${DESCRIPTION}" \
|
||||||
--test=${TESTFILE} \
|
--test=${TESTFILE} \
|
||||||
${LIBRARY_FILE}
|
${LIBRARY_FILE}
|
||||||
|
|
@ -47,16 +47,12 @@ ${PKG}: package
|
||||||
install: ${PKG}
|
install: ${PKG}
|
||||||
snow-chibi install --impls=${SCHEME} --always-yes --install-tests?=1 --show-tests?=1 ${PKG}
|
snow-chibi install --impls=${SCHEME} --always-yes --install-tests?=1 --show-tests?=1 ${PKG}
|
||||||
|
|
||||||
test: package
|
test:
|
||||||
snow-chibi install --impls=${SCHEME} --always-yes --install-tests?=1 --show-tests?=1 ${PKG}
|
COMPILE_R7RS=${SCHEME} compile-r7rs -o test-program ${TESTFILE}
|
||||||
snow-chibi install --impls=${SCHEME} --always-yes --install-tests?=1 --show-tests?=1 ${PKG}
|
./test-program
|
||||||
|
|
||||||
old-test:
|
|
||||||
cd ${tmpdir} && COMPILE_R7RS=${SCHEME} CSC_OPIONS="-L -lcurl" compile-r7rs -o test-program test.${SFX}
|
|
||||||
cd ${tmpdir} && ./test-program
|
|
||||||
|
|
||||||
test-docker:
|
test-docker:
|
||||||
SNOW_PACKAGES="srfi.19 srfi.64 srfi.180 ${PKG}" \
|
SNOW_PACKAGES="srfi.19 srfi.64 srfi.180 retropikzel.tap ${PKG}" \
|
||||||
APT_PACKAGES="libcurl4-openssl-dev" \
|
APT_PACKAGES="libcurl4-openssl-dev" \
|
||||||
AKKU_PACKAGES="${AKKU_PACKAGES}" \
|
AKKU_PACKAGES="${AKKU_PACKAGES}" \
|
||||||
DOCKER_TAG=${DOCKER_TAG} \
|
DOCKER_TAG=${DOCKER_TAG} \
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,100 @@
|
||||||
|
(define (make-lock-file-name file-name) (string-append file-name ".lock"))
|
||||||
|
(define (sleep time)
|
||||||
|
(letrec*
|
||||||
|
((end-time
|
||||||
|
(let ((end-time (current-time))
|
||||||
|
(seconds (quotient time 1000))
|
||||||
|
(nanoseconds (* (remainder time 1000) 1000000)))
|
||||||
|
(set-time-second! end-time (+ (time-second end-time) seconds))
|
||||||
|
(set-time-nanosecond! end-time (+ (time-nanosecond end-time) nanoseconds))
|
||||||
|
end-time))
|
||||||
|
(looper (lambda () (when (time<? (current-time) end-time) (looper)))))
|
||||||
|
(looper)))
|
||||||
|
|
||||||
|
(define (obtain-dot-lock file-name . args)
|
||||||
|
(let* ((interval
|
||||||
|
(* (if (>= (length args) 1)
|
||||||
|
(let ((interval (list-ref args 0)))
|
||||||
|
(when (not (integer? interval))
|
||||||
|
(error (string-append "obtain-dot-lock error: interval must"
|
||||||
|
" be integer"
|
||||||
|
interval)))
|
||||||
|
interval)
|
||||||
|
1000)))
|
||||||
|
(retry-number
|
||||||
|
(if (>= (length args) 2)
|
||||||
|
(let ((retry-number (list-ref args 1)))
|
||||||
|
(when (and (not (integer? retry-number))
|
||||||
|
(not (equal? retry-number #f)))
|
||||||
|
(error (string-append "obtain-dot-lock error: retry-number must"
|
||||||
|
" be integer or #f")
|
||||||
|
retry-number))
|
||||||
|
retry-number)
|
||||||
|
#f))
|
||||||
|
(stale-time-seconds
|
||||||
|
(if (>= (length args) 3)
|
||||||
|
(let ((stale-time (list-ref args 2)))
|
||||||
|
(when (and (not (integer? stale-time))
|
||||||
|
(not (equal? stale-time #f)))
|
||||||
|
(error (string-append "obtain-dot-lock error: stale time must"
|
||||||
|
" be integer or #f")
|
||||||
|
stale-time))
|
||||||
|
stale-time)
|
||||||
|
300))
|
||||||
|
(stale-time
|
||||||
|
(if stale-time-seconds
|
||||||
|
(add-duration (current-time time-utc)
|
||||||
|
(make-time time-duration 0 stale-time-seconds))
|
||||||
|
#f))
|
||||||
|
(lock-file-name (make-lock-file-name file-name))
|
||||||
|
(lock-time (lambda ()
|
||||||
|
(guard (condition (else #f))
|
||||||
|
(file-info:ctime (file-info lock-file-name))))))
|
||||||
|
(letrec
|
||||||
|
((locker
|
||||||
|
(lambda (try-count)
|
||||||
|
(cond ((not (file-exists? lock-file-name))
|
||||||
|
(guard (condition (else (locker (+ try-count 1))))
|
||||||
|
(create-hard-link file-name lock-file-name)
|
||||||
|
#t))
|
||||||
|
((and retry-number (> try-count retry-number)) #f)
|
||||||
|
((and stale-time (time>? lock-time stale-time))
|
||||||
|
(break-dot-lock file-name)
|
||||||
|
(create-hard-link file-name lock-file-name)
|
||||||
|
(guard (condition (else #f))
|
||||||
|
(create-hard-link file-name lock-file-name)
|
||||||
|
'broken))
|
||||||
|
((or (not retry-number)
|
||||||
|
(<= try-count retry-number))
|
||||||
|
(sleep interval)
|
||||||
|
(locker (+ try-count)))))))
|
||||||
|
(locker 0))))
|
||||||
|
|
||||||
|
(define (break-dot-lock file-name)
|
||||||
|
(let ((lock-file-name (make-lock-file-name file-name)))
|
||||||
|
(when (file-exists? lock-file-name) (delete-file lock-file-name))))
|
||||||
|
|
||||||
|
(define (release-dot-lock file-name)
|
||||||
|
(let ((lock-file-name (make-lock-file-name file-name)))
|
||||||
|
(guard (condition (else #f))
|
||||||
|
(when (file-exists? lock-file-name)
|
||||||
|
(delete-file lock-file-name))
|
||||||
|
#t)))
|
||||||
|
|
||||||
|
(define-syntax with-dot-lock*
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ file-name thunk)
|
||||||
|
(letrec* ((locked? (obtain-dot-lock file-name))
|
||||||
|
(unlock (lambda ()
|
||||||
|
(when locked? (break-dot-lock file-name))
|
||||||
|
(set! locked? #f))))
|
||||||
|
(when locked?
|
||||||
|
(dynamic-wind (lambda () #t)
|
||||||
|
(lambda () (guard (condition (else (unlock))) (thunk)))
|
||||||
|
unlock))
|
||||||
|
(unlock)))))
|
||||||
|
|
||||||
|
(define-syntax with-dot-lock
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ file-name body ...)
|
||||||
|
(with-dot-lock* file-name (lambda () body ...)))))
|
||||||
|
|
@ -0,0 +1,13 @@
|
||||||
|
(define-library
|
||||||
|
(retropikzel dot-locking)
|
||||||
|
(import (scheme base)
|
||||||
|
(scheme write)
|
||||||
|
(scheme file)
|
||||||
|
(srfi 19)
|
||||||
|
(srfi 170))
|
||||||
|
(export obtain-dot-lock
|
||||||
|
break-dot-lock
|
||||||
|
release-dot-lock
|
||||||
|
with-dot-lock*
|
||||||
|
with-dot-lock)
|
||||||
|
(include "dot-locking.scm"))
|
||||||
|
|
@ -0,0 +1,165 @@
|
||||||
|
GNU LESSER GENERAL PUBLIC LICENSE
|
||||||
|
Version 3, 29 June 2007
|
||||||
|
|
||||||
|
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
|
||||||
|
Everyone is permitted to copy and distribute verbatim copies
|
||||||
|
of this license document, but changing it is not allowed.
|
||||||
|
|
||||||
|
|
||||||
|
This version of the GNU Lesser General Public License incorporates
|
||||||
|
the terms and conditions of version 3 of the GNU General Public
|
||||||
|
License, supplemented by the additional permissions listed below.
|
||||||
|
|
||||||
|
0. Additional Definitions.
|
||||||
|
|
||||||
|
As used herein, "this License" refers to version 3 of the GNU Lesser
|
||||||
|
General Public License, and the "GNU GPL" refers to version 3 of the GNU
|
||||||
|
General Public License.
|
||||||
|
|
||||||
|
"The Library" refers to a covered work governed by this License,
|
||||||
|
other than an Application or a Combined Work as defined below.
|
||||||
|
|
||||||
|
An "Application" is any work that makes use of an interface provided
|
||||||
|
by the Library, but which is not otherwise based on the Library.
|
||||||
|
Defining a subclass of a class defined by the Library is deemed a mode
|
||||||
|
of using an interface provided by the Library.
|
||||||
|
|
||||||
|
A "Combined Work" is a work produced by combining or linking an
|
||||||
|
Application with the Library. The particular version of the Library
|
||||||
|
with which the Combined Work was made is also called the "Linked
|
||||||
|
Version".
|
||||||
|
|
||||||
|
The "Minimal Corresponding Source" for a Combined Work means the
|
||||||
|
Corresponding Source for the Combined Work, excluding any source code
|
||||||
|
for portions of the Combined Work that, considered in isolation, are
|
||||||
|
based on the Application, and not on the Linked Version.
|
||||||
|
|
||||||
|
The "Corresponding Application Code" for a Combined Work means the
|
||||||
|
object code and/or source code for the Application, including any data
|
||||||
|
and utility programs needed for reproducing the Combined Work from the
|
||||||
|
Application, but excluding the System Libraries of the Combined Work.
|
||||||
|
|
||||||
|
1. Exception to Section 3 of the GNU GPL.
|
||||||
|
|
||||||
|
You may convey a covered work under sections 3 and 4 of this License
|
||||||
|
without being bound by section 3 of the GNU GPL.
|
||||||
|
|
||||||
|
2. Conveying Modified Versions.
|
||||||
|
|
||||||
|
If you modify a copy of the Library, and, in your modifications, a
|
||||||
|
facility refers to a function or data to be supplied by an Application
|
||||||
|
that uses the facility (other than as an argument passed when the
|
||||||
|
facility is invoked), then you may convey a copy of the modified
|
||||||
|
version:
|
||||||
|
|
||||||
|
a) under this License, provided that you make a good faith effort to
|
||||||
|
ensure that, in the event an Application does not supply the
|
||||||
|
function or data, the facility still operates, and performs
|
||||||
|
whatever part of its purpose remains meaningful, or
|
||||||
|
|
||||||
|
b) under the GNU GPL, with none of the additional permissions of
|
||||||
|
this License applicable to that copy.
|
||||||
|
|
||||||
|
3. Object Code Incorporating Material from Library Header Files.
|
||||||
|
|
||||||
|
The object code form of an Application may incorporate material from
|
||||||
|
a header file that is part of the Library. You may convey such object
|
||||||
|
code under terms of your choice, provided that, if the incorporated
|
||||||
|
material is not limited to numerical parameters, data structure
|
||||||
|
layouts and accessors, or small macros, inline functions and templates
|
||||||
|
(ten or fewer lines in length), you do both of the following:
|
||||||
|
|
||||||
|
a) Give prominent notice with each copy of the object code that the
|
||||||
|
Library is used in it and that the Library and its use are
|
||||||
|
covered by this License.
|
||||||
|
|
||||||
|
b) Accompany the object code with a copy of the GNU GPL and this license
|
||||||
|
document.
|
||||||
|
|
||||||
|
4. Combined Works.
|
||||||
|
|
||||||
|
You may convey a Combined Work under terms of your choice that,
|
||||||
|
taken together, effectively do not restrict modification of the
|
||||||
|
portions of the Library contained in the Combined Work and reverse
|
||||||
|
engineering for debugging such modifications, if you also do each of
|
||||||
|
the following:
|
||||||
|
|
||||||
|
a) Give prominent notice with each copy of the Combined Work that
|
||||||
|
the Library is used in it and that the Library and its use are
|
||||||
|
covered by this License.
|
||||||
|
|
||||||
|
b) Accompany the Combined Work with a copy of the GNU GPL and this license
|
||||||
|
document.
|
||||||
|
|
||||||
|
c) For a Combined Work that displays copyright notices during
|
||||||
|
execution, include the copyright notice for the Library among
|
||||||
|
these notices, as well as a reference directing the user to the
|
||||||
|
copies of the GNU GPL and this license document.
|
||||||
|
|
||||||
|
d) Do one of the following:
|
||||||
|
|
||||||
|
0) Convey the Minimal Corresponding Source under the terms of this
|
||||||
|
License, and the Corresponding Application Code in a form
|
||||||
|
suitable for, and under terms that permit, the user to
|
||||||
|
recombine or relink the Application with a modified version of
|
||||||
|
the Linked Version to produce a modified Combined Work, in the
|
||||||
|
manner specified by section 6 of the GNU GPL for conveying
|
||||||
|
Corresponding Source.
|
||||||
|
|
||||||
|
1) Use a suitable shared library mechanism for linking with the
|
||||||
|
Library. A suitable mechanism is one that (a) uses at run time
|
||||||
|
a copy of the Library already present on the user's computer
|
||||||
|
system, and (b) will operate properly with a modified version
|
||||||
|
of the Library that is interface-compatible with the Linked
|
||||||
|
Version.
|
||||||
|
|
||||||
|
e) Provide Installation Information, but only if you would otherwise
|
||||||
|
be required to provide such information under section 6 of the
|
||||||
|
GNU GPL, and only to the extent that such information is
|
||||||
|
necessary to install and execute a modified version of the
|
||||||
|
Combined Work produced by recombining or relinking the
|
||||||
|
Application with a modified version of the Linked Version. (If
|
||||||
|
you use option 4d0, the Installation Information must accompany
|
||||||
|
the Minimal Corresponding Source and Corresponding Application
|
||||||
|
Code. If you use option 4d1, you must provide the Installation
|
||||||
|
Information in the manner specified by section 6 of the GNU GPL
|
||||||
|
for conveying Corresponding Source.)
|
||||||
|
|
||||||
|
5. Combined Libraries.
|
||||||
|
|
||||||
|
You may place library facilities that are a work based on the
|
||||||
|
Library side by side in a single library together with other library
|
||||||
|
facilities that are not Applications and are not covered by this
|
||||||
|
License, and convey such a combined library under terms of your
|
||||||
|
choice, if you do both of the following:
|
||||||
|
|
||||||
|
a) Accompany the combined library with a copy of the same work based
|
||||||
|
on the Library, uncombined with any other library facilities,
|
||||||
|
conveyed under the terms of this License.
|
||||||
|
|
||||||
|
b) Give prominent notice with the combined library that part of it
|
||||||
|
is a work based on the Library, and explaining where to find the
|
||||||
|
accompanying uncombined form of the same work.
|
||||||
|
|
||||||
|
6. Revised Versions of the GNU Lesser General Public License.
|
||||||
|
|
||||||
|
The Free Software Foundation may publish revised and/or new versions
|
||||||
|
of the GNU Lesser General Public License from time to time. Such new
|
||||||
|
versions will be similar in spirit to the present version, but may
|
||||||
|
differ in detail to address new problems or concerns.
|
||||||
|
|
||||||
|
Each version is given a distinguishing version number. If the
|
||||||
|
Library as you received it specifies that a certain numbered version
|
||||||
|
of the GNU Lesser General Public License "or any later version"
|
||||||
|
applies to it, you have the option of following the terms and
|
||||||
|
conditions either of that published version or of any later version
|
||||||
|
published by the Free Software Foundation. If the Library as you
|
||||||
|
received it does not specify a version number of the GNU Lesser
|
||||||
|
General Public License, you may choose any version of the GNU Lesser
|
||||||
|
General Public License ever published by the Free Software Foundation.
|
||||||
|
|
||||||
|
If the Library as you received it specifies that a proxy can decide
|
||||||
|
whether future versions of the GNU Lesser General Public License shall
|
||||||
|
apply, that proxy's public statement of acceptance of any version is
|
||||||
|
permanent authorization for you to choose that version for the
|
||||||
|
Library.
|
||||||
|
|
@ -0,0 +1,55 @@
|
||||||
|
Dot locking for files
|
||||||
|
|
||||||
|
This is an implementation of dot-locking from [scsh](https://scsh.net/).
|
||||||
|
|
||||||
|
## Documentation
|
||||||
|
|
||||||
|
From [https://scsh.net/docu/html/man-Z-H-11.html#node_sec_10.3](https://scsh.net/docu/html/man-Z-H-11.html#node_sec_10.3)
|
||||||
|
|
||||||
|
Copied here for convenience.
|
||||||
|
|
||||||
|
|
||||||
|
(__obtain-dot-lock__ file-name)
|
||||||
|
|
||||||
|
Tries to obtain the lock for file-name. If the file is already locked, the thread
|
||||||
|
sleeps for interval seconds (default is 1) before it retries. If the lock cannot
|
||||||
|
be obtained after retry-number attempts, the procedure returns #f, other-
|
||||||
|
wise #t. The default value of retry-number is #f which corresponds to an
|
||||||
|
infinite number of retires.
|
||||||
|
If stale-time is non-#f, it specifies the minimum age a lock may have
|
||||||
|
(in seconds) before it is considered stale. Obtain-dot-lock attempts to
|
||||||
|
delete stale locks. If it was succcessful obtaining a lock after breaking
|
||||||
|
it, obtain-dot-lock returns broken. If stale-time is #f, obtain-dot-lock
|
||||||
|
never considers a lock stale. The default for stale-time is 300.
|
||||||
|
Note that it is possible that obtain-dot-lock breaks a lock but never-
|
||||||
|
theless fails to obtain it otherwise. If it is necessary to handle this case
|
||||||
|
specially, use break-dot-lock directly (see below) rather than specifying
|
||||||
|
a non-#f stale-time
|
||||||
|
|
||||||
|
|
||||||
|
(__break-dot-lock__ file-name)
|
||||||
|
|
||||||
|
Breaks the lock for file-name if one exists. Note that breaking a lock
|
||||||
|
does not imply a subsequent obtain-dot-lock will succeed, as an-
|
||||||
|
other party may have acquired the lock between break-dot-lock and
|
||||||
|
obtain-dot-lock.
|
||||||
|
|
||||||
|
|
||||||
|
(__release-dot-lock__ file-name)
|
||||||
|
|
||||||
|
Releases the lock for file-name. On success, release-dot-lock returns #t,
|
||||||
|
otherwise #f. Note that this procedure can also be used to break the lock
|
||||||
|
for file-name.
|
||||||
|
|
||||||
|
|
||||||
|
(__with-dot-lock*__ file-name thunk)
|
||||||
|
(__with-dot-lock__ file-name body ...)
|
||||||
|
|
||||||
|
The procedure with-dot-lock* obtains the requested lock, and then calls
|
||||||
|
(thunk). When thunk returns, the lock is released. A non-local exit (e.g.,
|
||||||
|
throwing to a saved continuation or raising an exception) also causes the
|
||||||
|
lock to be released.
|
||||||
|
After a normal return from thunk, its return values are returned by
|
||||||
|
with-dot-lock*. The with-dot-lock special form is equivalent syntac-
|
||||||
|
tic sugar.
|
||||||
|
|
||||||
|
|
@ -0,0 +1 @@
|
||||||
|
1.0.0
|
||||||
|
|
@ -0,0 +1,73 @@
|
||||||
|
(import (scheme base)
|
||||||
|
(scheme write)
|
||||||
|
(scheme read)
|
||||||
|
(scheme char)
|
||||||
|
(scheme file)
|
||||||
|
(scheme process-context)
|
||||||
|
(retropikzel tap)
|
||||||
|
(retropikzel dot-locking)
|
||||||
|
(srfi 64))
|
||||||
|
|
||||||
|
(test-runner-current (tap-runner))
|
||||||
|
|
||||||
|
(test-begin "dot-locking")
|
||||||
|
|
||||||
|
|
||||||
|
(test-begin "obtain-dot-lock")
|
||||||
|
(let* ((testfile "/tmp/scshtestfile.txt")
|
||||||
|
(lockfile (string-append testfile ".lock")))
|
||||||
|
(when (file-exists? testfile) (delete-file testfile))
|
||||||
|
(when (file-exists? lockfile) (delete-file lockfile))
|
||||||
|
(with-output-to-file testfile (lambda () (display 1)))
|
||||||
|
(obtain-dot-lock testfile)
|
||||||
|
(test-assert (file-exists? lockfile)))
|
||||||
|
(test-end "obtain-dot-lock")
|
||||||
|
|
||||||
|
|
||||||
|
(test-begin "break-dot-lock")
|
||||||
|
(let* ((testfile "/tmp/scshtestfile.txt")
|
||||||
|
(lockfile (string-append testfile ".lock")))
|
||||||
|
(when (file-exists? testfile) (delete-file testfile))
|
||||||
|
(when (file-exists? lockfile) (delete-file lockfile))
|
||||||
|
(with-output-to-file testfile (lambda () (display 1)))
|
||||||
|
(obtain-dot-lock testfile)
|
||||||
|
(break-dot-lock testfile)
|
||||||
|
(test-assert (not (file-exists? lockfile))))
|
||||||
|
(test-end "break-dot-lock")
|
||||||
|
|
||||||
|
|
||||||
|
(test-begin "release-dot-lock")
|
||||||
|
(let* ((testfile "/tmp/scshtestfile.txt")
|
||||||
|
(lockfile (string-append testfile ".lock")))
|
||||||
|
(when (file-exists? testfile) (delete-file testfile))
|
||||||
|
(when (file-exists? lockfile) (delete-file lockfile))
|
||||||
|
(with-output-to-file testfile (lambda () (display 1)))
|
||||||
|
(obtain-dot-lock testfile)
|
||||||
|
(test-assert (release-dot-lock testfile)))
|
||||||
|
(test-end "release-dot-lock")
|
||||||
|
|
||||||
|
|
||||||
|
(test-begin "with-dot-lock*")
|
||||||
|
(let* ((testfile "/tmp/scshtestfile.txt")
|
||||||
|
(lockfile (string-append testfile ".lock")))
|
||||||
|
(when (file-exists? testfile) (delete-file testfile))
|
||||||
|
(when (file-exists? lockfile) (delete-file lockfile))
|
||||||
|
(with-output-to-file testfile (lambda () (display 1)))
|
||||||
|
(with-dot-lock*
|
||||||
|
testfile
|
||||||
|
(lambda ()
|
||||||
|
(test-assert (file-exists? lockfile)))))
|
||||||
|
(test-end "with-dot-lock*")
|
||||||
|
|
||||||
|
|
||||||
|
(test-begin "with-dot-lock")
|
||||||
|
(let* ((testfile "/tmp/scshtestfile.txt")
|
||||||
|
(lockfile (string-append testfile ".lock")))
|
||||||
|
(when (file-exists? testfile) (delete-file testfile))
|
||||||
|
(when (file-exists? lockfile) (delete-file lockfile))
|
||||||
|
(with-output-to-file testfile (lambda () (display 1)))
|
||||||
|
(with-dot-lock testfile (test-assert (file-exists? lockfile))))
|
||||||
|
(test-end "with-dot-lock")
|
||||||
|
|
||||||
|
|
||||||
|
(test-end "dot-locking")
|
||||||
Loading…
Reference in New Issue