'with-store' and 'with-database' and written in terms of 'unwind-protect'.

* src/cuirass/base.scm (with-store): Rewrite using 'unwind-protect'.
* src/cuirass/database.scm (with-database): Likewise.
This commit is contained in:
Ludovic Courtès 2018-03-19 22:13:54 +01:00
parent e0e2709863
commit 99d88929a6
2 changed files with 14 additions and 17 deletions

View File

@ -67,19 +67,18 @@
;; currently closes in a 'dynamic-wind' handler, which means it would close
;; the store at each context switch. Remove this when the real 'with-store'
;; has been fixed.
(let* ((store (open-connection))
(result (begin
;; Always set #:keep-going? so we don't stop on the first
;; build failure. Set #:print-build-trace explicitly to
;; make sure 'process-build-log' sees build events.
(set-build-options store
#:use-substitutes? (%use-substitutes?)
#:fallback? (%fallback?)
#:keep-going? #t
#:print-build-trace #t)
exp ...)))
(close-connection store)
result))
(let ((store (open-connection)))
(unwind-protect
;; Always set #:keep-going? so we don't stop on the first build failure.
;; Set #:print-build-trace explicitly to make sure 'process-build-log'
;; sees build events.
(set-build-options store
#:use-substitutes? (%use-substitutes?)
#:fallback? (%fallback?)
#:keep-going? #t
#:print-build-trace #t)
exp ...
(close-connection store))))
(cond-expand
(guile-2.2

View File

@ -253,10 +253,8 @@ INSERT INTO Evaluations (specification, revision) VALUES ("
;; XXX: We don't install an unwind handler to play well with delimited
;; continuations and fibers. But as a consequence, we leak DB when BODY
;; raises an exception.
(let* ((db (db-open))
(result (begin body ...)))
(db-close db)
result))
(let ((db (db-open)))
(unwind-protect body ... (db-close db))))
(define* (read-quoted-string #:optional (port (current-input-port)))
"Read all of the characters out of PORT and return them as a SQL quoted