TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Mark H Weaver 2018-03-16 18:29:31 -04:00
parent 23c0d40e13
commit cbdfa50d9f
No known key found for this signature in database
GPG Key ID: 7CEF29847562C516
2 changed files with 45 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
guix/build/utils.scm
View File

@ -2,7 +2,7 @@
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
;;;
;;; 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))

18
guix/ui.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2013, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Cyrill Schenkel <cyrill.schenkel@gmail.com>
@ -41,6 +41,12 @@
#:use-module ((guix licenses) #:select (license? license-name))
#:use-module ((guix build syscalls)
#:select (free-disk-space terminal-columns))
#:use-module ((guix build utils)
#:select (invoke-error? invoke-error-program
invoke-error-arguments
invoke-error-exit-status
invoke-error-term-signal
invoke-error-stop-signal))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
@ -636,6 +642,16 @@ or remove one of them from the profile.")
directories:~{ ~a~}~%")
(file-search-error-file-name c)
(file-search-error-search-path c)))
((invoke-error? c)
(leave (G_ "program exited\
~@[ with non-zero exit status ~a~]\
~@[ terminated by signal ~a~]\
~@[ stopped by signal ~a~]: ~s~%")
(invoke-error-exit-status c)
(invoke-error-term-signal c)
(invoke-error-stop-signal c)
(cons (invoke-error-program c)
(invoke-error-arguments c))))
((and (error-location? c) (message-condition? c))
(format (current-error-port)
(G_ "~a: error: ~a~%")