store: 'with-store' uses 'with-exception-handler'.
This ensures the stack is not unwound before the exception is re-thrown,
as was the case since 8ed597f4a2
, leading
to '&store-protocol-error' being uncaught by 'with-error-handling'
in (guix scripts build) & co.
* guix/store.scm (call-with-store): Define 'thunk'. Add 'cond-expand'
to use 'with-exception-handler' on 'guile-3' and 'catch' otherwise.
This commit is contained in:
parent
524a4e357c
commit
376ba0ce57
@ -623,16 +623,25 @@ connection. Use with care."
|
|||||||
(define (call-with-store proc)
|
(define (call-with-store proc)
|
||||||
"Call PROC with an open store connection."
|
"Call PROC with an open store connection."
|
||||||
(let ((store (open-connection)))
|
(let ((store (open-connection)))
|
||||||
(catch #t
|
(define (thunk)
|
||||||
(lambda ()
|
(parameterize ((current-store-protocol-version
|
||||||
(parameterize ((current-store-protocol-version
|
(store-connection-version store)))
|
||||||
(store-connection-version store)))
|
(let ((result (proc store)))
|
||||||
(let ((result (proc store)))
|
(close-connection store)
|
||||||
(close-connection store)
|
result)))
|
||||||
result)))
|
|
||||||
(lambda (key . args)
|
(cond-expand
|
||||||
(close-connection store)
|
(guile-3
|
||||||
(apply throw key args)))))
|
(with-exception-handler (lambda (exception)
|
||||||
|
(close-connection store)
|
||||||
|
(raise-exception exception))
|
||||||
|
thunk))
|
||||||
|
(else ;Guile 2.2
|
||||||
|
(catch #t
|
||||||
|
thunk
|
||||||
|
(lambda (key . args)
|
||||||
|
(close-connection store)
|
||||||
|
(apply throw key args)))))))
|
||||||
|
|
||||||
(define-syntax-rule (with-store store exp ...)
|
(define-syntax-rule (with-store store exp ...)
|
||||||
"Bind STORE to an open connection to the store and evaluate EXPs;
|
"Bind STORE to an open connection to the store and evaluate EXPs;
|
||||||
|
Loading…
Reference in New Issue
Block a user