From 5842239a66683b2f5e36e95da8225e2ab7f7dac3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 Nov 2020 22:53:08 +0100 Subject: deploy: Let key-and-args exceptions through. Fixes . Reported by Christopher Lemmer Webber . * guix/ui.scm (guard*): Export. * guix/scripts/deploy.scm (deploy-machine*): Use 'guard*' instead of 'guard'. Add '&exception-with-kind-and-args' case. --- guix/scripts/deploy.scm | 33 ++++++++++++++++++++++----------- guix/ui.scm | 1 + 2 files changed, 23 insertions(+), 11 deletions(-) (limited to 'guix') diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index 1b5be307be..0725fba54b 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -120,17 +120,28 @@ (define (deploy-machine* store machine) (info (G_ "deploying to ~a...~%") (machine-display-name machine)) - (guard (c ((message-condition? c) - (report-error (G_ "failed to deploy ~a: ~a~%") - (machine-display-name machine) - (condition-message c))) - ((deploy-error? c) - (when (deploy-error-should-roll-back c) - (info (G_ "rolling back ~a...~%") - (machine-display-name machine)) - (run-with-store store (roll-back-machine machine))) - (apply throw (deploy-error-captured-args c)))) - (run-with-store store (deploy-machine machine)) + (guard* (c + ;; On Guile 3.0, exceptions such as 'unbound-variable' are compound + ;; and include a '&message'. However, that message only contains + ;; the format string. Thus, special-case it here to avoid + ;; displaying a bare format string. + ((cond-expand + (guile-3 + ((exception-predicate &exception-with-kind-and-args) c)) + (else #f)) + (raise c)) + + ((message-condition? c) + (report-error (G_ "failed to deploy ~a: ~a~%") + (machine-display-name machine) + (condition-message c))) + ((deploy-error? c) + (when (deploy-error-should-roll-back c) + (info (G_ "rolling back ~a...~%") + (machine-display-name machine)) + (run-with-store store (roll-back-machine machine))) + (apply throw (deploy-error-captured-args c)))) + (run-with-store store (deploy-machine machine)) (info (G_ "successfully deployed ~a~%") (machine-display-name machine)))) diff --git a/guix/ui.scm b/guix/ui.scm index 4e686297e8..0c2c6a5e97 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -101,6 +101,7 @@ (define-module (guix ui) show-what-to-build show-what-to-build* show-manifest-transaction + guard* call-with-error-handling with-error-handling with-unbound-variable-handling -- cgit v1.2.3