From 376ba0ce570993cf6cdbed19596a245826308382 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 4 Apr 2020 23:58:05 +0200 Subject: 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 8ed597f4a261fe188de82cd1f5daed83dba948eb, 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. --- guix/store.scm | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) (limited to 'guix/store.scm') diff --git a/guix/store.scm b/guix/store.scm index 1dd5c9545b..fb4b92e0c4 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -623,16 +623,25 @@ connection. Use with care." (define (call-with-store proc) "Call PROC with an open store connection." (let ((store (open-connection))) - (catch #t - (lambda () - (parameterize ((current-store-protocol-version - (store-connection-version store))) - (let ((result (proc store))) - (close-connection store) - result))) - (lambda (key . args) - (close-connection store) - (apply throw key args))))) + (define (thunk) + (parameterize ((current-store-protocol-version + (store-connection-version store))) + (let ((result (proc store))) + (close-connection store) + result))) + + (cond-expand + (guile-3 + (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 ...) "Bind STORE to an open connection to the store and evaluate EXPs; -- cgit v1.2.3