From patchwork Wed May 26 21:18:13 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 29614 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 0C9FA27BC81; Wed, 26 May 2021 22:19:16 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 3A5CC27BC78 for ; Wed, 26 May 2021 22:19:12 +0100 (BST) Received: from localhost ([::1]:41196 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lm0vn-0002VX-DP for patchwork@mira.cbaines.net; Wed, 26 May 2021 17:19:11 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:37722) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lm0ve-0002Rp-Sk for guix-patches@gnu.org; Wed, 26 May 2021 17:19:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:38497) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lm0ve-0008LC-J6 for guix-patches@gnu.org; Wed, 26 May 2021 17:19:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lm0ve-0003yg-Db for guix-patches@gnu.org; Wed, 26 May 2021 17:19:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#48685] [PATCH 1/2] maint: Require Guile 3.0. References: <20210526211210.16830-1-ludo@gnu.org> In-Reply-To: <20210526211210.16830-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 26 May 2021 21:19:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 48685 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 48685@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 48685-submit@debbugs.gnu.org id=B48685.162206391215247 (code B ref 48685); Wed, 26 May 2021 21:19:02 +0000 Received: (at 48685) by debbugs.gnu.org; 26 May 2021 21:18:32 +0000 Received: from localhost ([127.0.0.1]:50041 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lm0v9-0003xl-IW for submit@debbugs.gnu.org; Wed, 26 May 2021 17:18:32 -0400 Received: from eggs.gnu.org ([209.51.188.92]:43928) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lm0v5-0003xU-3p for 48685@debbugs.gnu.org; Wed, 26 May 2021 17:18:30 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:48778) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lm0uz-0007vu-1T; Wed, 26 May 2021 17:18:21 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=42918 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lm0uy-0003RS-GP; Wed, 26 May 2021 17:18:20 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Wed, 26 May 2021 23:18:13 +0200 Message-Id: <20210526211814.17116-1-ludo@gnu.org> X-Mailer: git-send-email 2.31.1 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * configure.ac: Require Guile 3.0. * doc/guix.texi (Requirements): Adjust accordingly. * gnu/packages/package-management.scm (guile2.2-guix): Remove. * guix/lint.scm (exception-with-kind-and-args?): Remove 'cond-expand'. * guix/scripts/deploy.scm (deploy-machine*): Likewise. * guix/store.scm (call-with-store): Likewise. * guix/swh.scm (http-get*, http-post*): Likewise. * guix/ui.scm (without-compiler-optimizations, guard*) (call-with-error-handling): Likewise. --- configure.ac | 6 +--- doc/guix.texi | 3 +- gnu/packages/package-management.scm | 34 --------------------- guix/lint.scm | 11 ++----- guix/scripts/deploy.scm | 7 ++--- guix/store.scm | 16 +++------- guix/swh.scm | 20 ++++--------- guix/ui.scm | 46 ++++++++++------------------- 8 files changed, 33 insertions(+), 110 deletions(-) diff --git a/configure.ac b/configure.ac index 583b902361..84592f6041 100644 --- a/configure.ac +++ b/configure.ac @@ -96,16 +96,12 @@ m4_pattern_forbid([^GUIX_]) dnl Search for 'guile' and 'guild'. This macro defines dnl 'GUILE_EFFECTIVE_VERSION'. -GUILE_PKG([3.0 2.2]) +GUILE_PKG([3.0]) GUILE_PROGS if test "x$GUILD" = "x"; then AC_MSG_ERROR(['guild' binary not found; please check your Guile installation.]) fi -if test "x$GUILE_EFFECTIVE_VERSION" = "x2.2"; then - PKG_CHECK_MODULES([GUILE], [guile-2.2 >= 2.2.6]) -fi - dnl Get CFLAGS and LDFLAGS for libguile. GUILE_FLAGS diff --git a/doc/guix.texi b/doc/guix.texi index e8b0485f78..05a4f9a6e2 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -833,8 +833,7 @@ GNU Guix is available for download from its website at GNU Guix depends on the following packages: @itemize -@item @url{https://gnu.org/software/guile/, GNU Guile}, version 3.0.x or -2.2.x; +@item @url{https://gnu.org/software/guile/, GNU Guile}, version 3.0.x; @item @url{https://notabug.org/cwebber/guile-gcrypt, Guile-Gcrypt}, version 0.1.0 or later; @item diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 1cea8ed83d..6378d7c2d9 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -518,40 +518,6 @@ the Nix package manager.") (invoke "make" "install-binPROGRAMS"))) (delete 'wrap-program))))))) - -(define-public guile2.2-guix - (package - (inherit guix) - (name "guile2.2-guix") - (native-inputs - `(("guile" ,guile-2.2) - ("gnutls" ,guile2.2-gnutls) - ("guile-gcrypt" ,guile2.2-gcrypt) - ("guile-json" ,guile2.2-json) - ("guile-lib" ,guile2.2-lib) - ("guile-sqlite3" ,guile2.2-sqlite3) - ("guile-ssh" ,guile2.2-ssh) - ("guile-git" ,guile2.2-git) - ("guile-zlib" ,guile2.2-zlib) - ("guile-lzlib" ,guile2.2-lzlib) - ,@(fold alist-delete (package-native-inputs guix) - '("guile" "gnutls" "guile-gcrypt" "guile-json" - "guile-lib" "guile-sqlite3" "guile-ssh" "guile-git" - "guile-zlib" "guile-lzlib")))) - (inputs - `(("guile" ,guile-2.2) - ,@(alist-delete "guile" (package-inputs guix)))) - (propagated-inputs - `(("gnutls" ,gnutls) - ("guile-gcrypt" ,guile2.2-gcrypt) - ("guile-json" ,guile2.2-json) - ("guile-lib" ,guile2.2-lib) - ("guile-sqlite3" ,guile2.2-sqlite3) - ("guile-ssh" ,guile2.2-ssh) - ("guile-git" ,guile2.2-git) - ("guile-zlib" ,guile2.2-zlib) - ("guile-lzlib" ,guile2.2-lzlib))))) - (define-public guile3.0-guix (deprecated-package "guile3.0-guix" guix)) diff --git a/guix/lint.scm b/guix/lint.scm index a2d6418b85..023a179ea6 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -1003,14 +1003,9 @@ descriptions maintained upstream." (origin-uris origin)) '()))) -(cond-expand - (guile-3 - ;; Guile 3.0.0 does not export this predicate. - (define exception-with-kind-and-args? - (exception-predicate &exception-with-kind-and-args))) - (else ;Guile 2 - (define exception-with-kind-and-args? - (const #f)))) +;; Guile 3.0.0 does not export this predicate. +(define exception-with-kind-and-args? + (exception-predicate &exception-with-kind-and-args)) (define* (check-derivation package #:key store) "Emit a warning if we fail to compile PACKAGE to a derivation." diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index 0725fba54b..b2029943e2 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 David Thompson ;;; Copyright © 2019 Jakob L. Kreuze -;;; Copyright © 2020 Ludovic Courtès +;;; Copyright © 2020, 2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -125,10 +125,7 @@ Perform the deployment specified by FILE.\n")) ;; 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)) + (((exception-predicate &exception-with-kind-and-args) c) (raise c)) ((message-condition? c) diff --git a/guix/store.scm b/guix/store.scm index 9d706ae590..cf5d5eeccc 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -648,18 +648,10 @@ connection. Use with care." (close-connection store) (apply values results))))) - (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))))))) + (with-exception-handler (lambda (exception) + (close-connection store) + (raise-exception exception)) + thunk))) (define-syntax-rule (with-store store exp ...) "Bind STORE to an open connection to the store and evaluate EXPs; diff --git a/guix/swh.scm b/guix/swh.scm index 06d2957252..f6d5241e06 100644 --- a/guix/swh.scm +++ b/guix/swh.scm @@ -148,20 +148,12 @@ url (string-append url "/"))) -(cond-expand - (guile-3 - ;; XXX: Work around a bug in Guile 3.0.2 where #:verify-certificate? would - ;; be ignored (). - (define* (http-get* uri #:rest rest) - (apply http-request uri #:method 'GET rest)) - (define* (http-post* uri #:rest rest) - (apply http-request uri #:method 'POST rest))) - (else ;Guile 2.2 - ;; Guile 2.2 did not have #:verify-certificate? so ignore it. - (define* (http-get* uri #:key verify-certificate? streaming?) - (http-request uri #:method 'GET #:streaming? streaming?)) - (define* (http-post* uri #:key verify-certificate? streaming?) - (http-request uri #:method 'POST #:streaming? streaming?)))) +;; XXX: Work around a bug in Guile 3.0.2 where #:verify-certificate? would +;; be ignored (). +(define* (http-get* uri #:rest rest) + (apply http-request uri #:method 'GET rest)) +(define* (http-post* uri #:rest rest) + (apply http-request uri #:method 'POST rest)) (define %date-regexp ;; Match strings like "2014-11-17T22:09:38+01:00" or diff --git a/guix/ui.scm b/guix/ui.scm index 05b3f5f84c..6b0155f563 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -196,17 +196,11 @@ information, or #f if it could not be found." (stack-ref stack 1) ;skip the 'throw' frame last)))) -(cond-expand - (guile-3 - (define-syntax-rule (without-compiler-optimizations exp) - ;; Compile with the baseline compiler (-O1), which is much less expensive - ;; than -O2. - (parameterize (((@ (system base compile) default-optimization-level) 1)) - exp))) - (else - (define-syntax-rule (without-compiler-optimizations exp) - ;; No easy way to turn off optimizations on Guile 2.2. - exp))) +(define-syntax-rule (without-compiler-optimizations exp) + ;; Compile with the baseline compiler (-O1), which is much less expensive + ;; than -O2. + (parameterize (((@ (system base compile) default-optimization-level) 1)) + exp)) (define* (load* file user-module #:key (on-error 'nothing-special)) @@ -674,22 +668,17 @@ or variants of @code{~a} in the same profile.") or remove one of them from the profile.") name1 name2))))) -(cond-expand - (guile-3 - ;; On Guile 3.0, in 'call-with-error-handling' we need to re-raise. To - ;; preserve useful backtraces in case of unhandled errors, we want that to - ;; happen before the stack has been unwound, hence 'guard*'. - (define-syntax-rule (guard* (var clauses ...) exp ...) - "This variant of SRFI-34 'guard' does not unwind the stack before +;; On Guile 3.0, in 'call-with-error-handling' we need to re-raise. To +;; preserve useful backtraces in case of unhandled errors, we want that to +;; happen before the stack has been unwound, hence 'guard*'. +(define-syntax-rule (guard* (var clauses ...) exp ...) + "This variant of SRFI-34 'guard' does not unwind the stack before evaluating the tests and bodies of CLAUSES." - (with-exception-handler - (lambda (var) - (cond clauses ... (else (raise var)))) - (lambda () exp ...) - #:unwind? #f))) - (else - (define-syntax-rule (guard* (var clauses ...) exp ...) - (guard (var clauses ...) exp ...)))) + (with-exception-handler + (lambda (var) + (cond clauses ... (else (raise var)))) + (lambda () exp ...) + #:unwind? #f)) (define (call-with-error-handling thunk) "Call THUNK within a user-friendly error handler." @@ -822,10 +811,7 @@ directories:~{ ~a~}~%") ;; Furthermore, use of 'guard*' ensures that the stack has not ;; been unwound when we re-raise, since that would otherwise show ;; useless backtraces. - ((cond-expand - (guile-3 - ((exception-predicate &exception-with-kind-and-args) c)) - (else #f)) + (((exception-predicate &exception-with-kind-and-args) c) (raise c)) ((message-condition? c) From patchwork Wed May 26 21:18:14 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 29615 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id EEC0927BC81; Wed, 26 May 2021 22:31:41 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9EA1727BC78 for ; Wed, 26 May 2021 22:31:41 +0100 (BST) Received: from localhost ([::1]:41258 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lm17s-0004wa-S2 for patchwork@mira.cbaines.net; Wed, 26 May 2021 17:31:40 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:37726) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lm0vf-0002Sl-6j for guix-patches@gnu.org; Wed, 26 May 2021 17:19:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:38498) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lm0ve-0008LK-Tn for guix-patches@gnu.org; Wed, 26 May 2021 17:19:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lm0ve-0003yn-Pr for guix-patches@gnu.org; Wed, 26 May 2021 17:19:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#48685] [PATCH 2/2] ui, lint: Simplify exception handling in Guile 3 style. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 26 May 2021 21:19:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 48685 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 48685@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 48685-submit@debbugs.gnu.org id=B48685.162206391515258 (code B ref 48685); Wed, 26 May 2021 21:19:02 +0000 Received: (at 48685) by debbugs.gnu.org; 26 May 2021 21:18:35 +0000 Received: from localhost ([127.0.0.1]:50043 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lm0vD-0003y1-Cr for submit@debbugs.gnu.org; Wed, 26 May 2021 17:18:35 -0400 Received: from eggs.gnu.org ([209.51.188.92]:43944) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lm0v9-0003xZ-BI for 48685@debbugs.gnu.org; Wed, 26 May 2021 17:18:31 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:48782) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lm0v3-0007zP-RY; Wed, 26 May 2021 17:18:25 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=42918 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lm0v3-0003RS-IA; Wed, 26 May 2021 17:18:25 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Wed, 26 May 2021 23:18:14 +0200 Message-Id: <20210526211814.17116-2-ludo@gnu.org> X-Mailer: git-send-email 2.31.1 In-Reply-To: <20210526211814.17116-1-ludo@gnu.org> References: <20210526211814.17116-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/lint.scm (check-derivation)[try]: Remove "catch #t" wrapping. * guix/ui.scm (call-with-error-handling): Remove "catch 'system-error" and move 'system-error handling to the &exception-with-kind-and-args clause. --- guix/lint.scm | 70 +++++++++++++++++++++++---------------------------- guix/ui.scm | 14 +++++------ 2 files changed, 39 insertions(+), 45 deletions(-) diff --git a/guix/lint.scm b/guix/lint.scm index 023a179ea6..41dd5d0633 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -1010,45 +1010,39 @@ descriptions maintained upstream." (define* (check-derivation package #:key store) "Emit a warning if we fail to compile PACKAGE to a derivation." (define (try store system) - (catch #t ;TODO: Remove 'catch' when Guile 2.x is no longer supported. - (lambda () - (guard (c ((store-protocol-error? c) - (make-warning package - (G_ "failed to create ~a derivation: ~a") - (list system - (store-protocol-error-message c)))) - ((exception-with-kind-and-args? c) - (make-warning package - (G_ "failed to create ~a derivation: ~s") - (list system - (cons (exception-kind c) - (exception-args c))))) - ((message-condition? c) - (make-warning package - (G_ "failed to create ~a derivation: ~a") - (list system - (condition-message c)))) - ((formatted-message? c) - (let ((str (apply format #f - (formatted-message-string c) - (formatted-message-arguments c)))) - (make-warning package - (G_ "failed to create ~a derivation: ~a") - (list system str))))) - (parameterize ((%graft? #f)) - (package-derivation store package system #:graft? #f) + (guard (c ((store-protocol-error? c) + (make-warning package + (G_ "failed to create ~a derivation: ~a") + (list system + (store-protocol-error-message c)))) + ((exception-with-kind-and-args? c) + (make-warning package + (G_ "failed to create ~a derivation: ~s") + (list system + (cons (exception-kind c) + (exception-args c))))) + ((message-condition? c) + (make-warning package + (G_ "failed to create ~a derivation: ~a") + (list system + (condition-message c)))) + ((formatted-message? c) + (let ((str (apply format #f + (formatted-message-string c) + (formatted-message-arguments c)))) + (make-warning package + (G_ "failed to create ~a derivation: ~a") + (list system str))))) + (parameterize ((%graft? #f)) + (package-derivation store package system #:graft? #f) - ;; If there's a replacement, make sure we can compute its - ;; derivation. - (match (package-replacement package) - (#f #t) - (replacement - (package-derivation store replacement system - #:graft? #f)))))) - (lambda args - (make-warning package - (G_ "failed to create ~a derivation: ~s") - (list system args))))) + ;; If there's a replacement, make sure we can compute its + ;; derivation. + (match (package-replacement package) + (#f #t) + (replacement + (package-derivation store replacement system + #:graft? #f)))))) (define (check-with-store store) (filter lint-warning? diff --git a/guix/ui.scm b/guix/ui.scm index 6b0155f563..d3e01f846d 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -812,7 +812,12 @@ directories:~{ ~a~}~%") ;; been unwound when we re-raise, since that would otherwise show ;; useless backtraces. (((exception-predicate &exception-with-kind-and-args) c) - (raise c)) + (if (eq? 'system-error (exception-kind c)) ;EPIPE & co. + (match (exception-args c) + ((proc format-string format-args . _) + (leave (G_ "~a: ~a~%") proc + (apply format #f format-string format-args)))) + (raise c))) ((message-condition? c) ;; Normally '&message' error conditions have an i18n'd message. @@ -822,12 +827,7 @@ directories:~{ ~a~}~%") (when (fix-hint? c) (display-hint (condition-fix-hint c))) (exit 1))) - ;; Catch EPIPE and the likes. - (catch 'system-error - thunk - (lambda (key proc format-string format-args . rest) - (leave (G_ "~a: ~a~%") proc - (apply format #f format-string format-args)))))) + (thunk))) (define-syntax-rule (leave-on-EPIPE exp ...) "Run EXP... in a context where EPIPE errors are caught and lead to 'exit'