diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-11-26 22:53:08 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-11-26 23:39:15 +0100 |
| commit | 5842239a66683b2f5e36e95da8225e2ab7f7dac3 (patch) | |
| tree | 4177d1c5e80fe8e3822c4373b4900d2d87a5f781 | |
| parent | 3c881facced4cad373b7e0770fff9e5c5b01333f (diff) | |
| download | guix-5842239a66683b2f5e36e95da8225e2ab7f7dac3.tar guix-5842239a66683b2f5e36e95da8225e2ab7f7dac3.tar.gz | |
deploy: Let key-and-args exceptions through.
Fixes <https://bugs.gnu.org/44825>.
Reported by Christopher Lemmer Webber <cwebber@dustycloud.org>.
* guix/ui.scm (guard*): Export.
* guix/scripts/deploy.scm (deploy-machine*): Use 'guard*' instead of
'guard'. Add '&exception-with-kind-and-args' case.
| -rw-r--r-- | guix/scripts/deploy.scm | 33 | ||||
| -rw-r--r-- | guix/ui.scm | 1 |
2 files changed, 23 insertions, 11 deletions
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 @@ Perform the deployment specified by FILE.\n")) (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 @@ show-what-to-build show-what-to-build* show-manifest-transaction + guard* call-with-error-handling with-error-handling with-unbound-variable-handling |