From cbdfa50d9fb19704caa60818d7635047a6a26d71 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 16 Mar 2018 18:29:31 -0400 Subject: utils: invoke: Raise exceptions using SRFI-34 and SRFI-35. * guix/build/utils.scm (&invoke-error): New condition type. (invoke-error?, invoke-error-program, invoke-error-arguments) (invoke-error-exit-status, invoke-error-term-signal) (invoke-error-stop-signal): New exported procedures. (invoke): Raise exceptions using SRFI-34 and SRFI-35. * guix/ui.scm (call-with-error-handling): Add a guard clause for &invoke-error conditions. --- guix/build/utils.scm | 35 ++++++++++++++++++++++++++++------- 1 file changed, 28 insertions(+), 7 deletions(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index ab309aa0df..c58a1afd1c 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2013 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov -;;; Copyright © 2015 Mark H Weaver +;;; Copyright © 2015, 2018 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +23,8 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-60) #:use-module (ice-9 ftw) #:use-module (ice-9 match) @@ -86,7 +88,14 @@ fold-port-matches remove-store-references wrap-program + invoke + invoke-error? + invoke-error-program + invoke-error-arguments + invoke-error-exit-status + invoke-error-term-signal + invoke-error-stop-signal locale-category->string)) @@ -591,13 +600,25 @@ Where every <*-phase-name> is an expression evaluating to a symbol, and ((_ phases (add-after old-phase-name new-phase-name new-phase)) (alist-cons-after old-phase-name new-phase-name new-phase phases)))) +(define-condition-type &invoke-error &error + invoke-error? + (program invoke-error-program) + (arguments invoke-error-arguments) + (exit-status invoke-error-exit-status) + (term-signal invoke-error-term-signal) + (stop-signal invoke-error-stop-signal)) + (define (invoke program . args) - "Invoke PROGRAM with the given ARGS. Raise an error if the exit -code is non-zero; otherwise return #t." - (let ((status (apply system* program args))) - (unless (zero? status) - (error (format #f "program ~s exited with non-zero code" program) - status)) + "Invoke PROGRAM with the given ARGS. Raise an exception +if the exit code is non-zero; otherwise return #t." + (let ((code (apply system* program args))) + (unless (zero? code) + (raise (condition (&invoke-error + (program program) + (arguments args) + (exit-status (status:exit-val code)) + (term-signal (status:term-sig code)) + (stop-signal (status:stop-sig code)))))) #t)) -- cgit v1.2.3