aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-04-04 23:58:05 +0200
committerLudovic Courtès <ludo@gnu.org>2020-04-05 00:36:44 +0200
commit376ba0ce570993cf6cdbed19596a245826308382 (patch)
tree753671173fffe2fbd3eb79f2456fd34f525c113d
parent524a4e357cd71566841aaf405e8548fa3600b11b (diff)
downloadguix-376ba0ce570993cf6cdbed19596a245826308382.tar
guix-376ba0ce570993cf6cdbed19596a245826308382.tar.gz
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.
-rw-r--r--guix/store.scm29
1 files changed, 19 insertions, 10 deletions
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;