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:
Ludovic Courtès 2020-04-04 23:58:05 +02:00
parent 524a4e357c
commit 376ba0ce57
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5

View File

@ -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;