[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
From: |
Mathieu Othacehe |
Date: |
Sun, 30 Jul 2017 06:45:55 -0400 (EDT) |
branch: master
commit c6ee3d9b1a741d49c5058d5b336b6e753aab55a1
Author: Mathieu Othacehe <address@hidden>
Date: Tue Jul 11 19:15:08 2017 +0200
base: Report evaluation error.
* src/cuirass/base.scm (&evaluation-error): New condition type.
(evaluate): Report an &evaluation-error if eof-object? is true on
data read from port. Otherwise, suppose that data are correct and keep
things
going.
(process-specs): Catch &evaluation-error, report the error in the log and
keep
going.
---
src/cuirass/base.scm | 25 +++++++++++++++++++++----
1 file changed, 21 insertions(+), 4 deletions(-)
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 326a530..cc3dd39 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -32,6 +32,7 @@
#:use-module (ice-9 receive)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:export (;; Procedures.
call-with-time-display
fetch-repository
@@ -137,6 +138,10 @@ directory and the sha1 of the top level commit in this
directory."
(system* "./configure" "--localstatedir=/var"))
(zero? (system* "make" "-j" (number->string (current-processor-count))))))
+(define-condition-type &evaluation-error &error
+ evaluation-error?
+ (name evaluation-error-spec-name))
+
(define (evaluate store db spec)
"Evaluate and build package derivations. Return a list of jobs."
(let* ((port (open-pipe* OPEN_READ
@@ -148,7 +153,15 @@ directory and the sha1 of the top level commit in this
directory."
(%package-cachedir)
(object->string spec)
(%package-database)))
- (jobs (read port)))
+ (jobs (match (read port)
+ ;; If an error occured during evaluation report it,
+ ;; otherwise, suppose that data read from port are
+ ;; correct and keep things going.
+ ((? eof-object?)
+ (raise (condition
+ (&evaluation-error
+ (name (assq-ref spec #:name))))))
+ (data data))))
(close-pipe port)
jobs))
@@ -212,9 +225,13 @@ directory and the sha1 of the top level commit in this
directory."
#:fallback? (%fallback?)
#:keep-going? #t)
- (let* ((spec* (acons #:current-commit commit spec))
- (jobs (evaluate store db spec*)))
- (build-packages store db jobs)))
+ (guard (c ((evaluation-error? c)
+ (format #t "Failed to evaluate ~s specification.~%"
+ (evaluation-error-spec-name c))
+ #f))
+ (let* ((spec* (acons #:current-commit commit spec))
+ (jobs (evaluate store db spec*)))
+ (build-packages store db jobs))))
(db-add-stamp db spec commit))))))
(for-each process jobspecs))