2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/data-service.git synced 2023-12-14 03:23:03 +01:00

Better handle failures when computing the transative supported inputs

This commit is contained in:
Christopher Baines 2019-03-29 09:14:03 +00:00
parent 944492bd79
commit d62ea8857d
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577

View file

@ -63,38 +63,52 @@
#t
(lambda ()
(let ((supported-systems
(package-transitive-supported-systems package)))
(append-map
(lambda (system)
(filter-map
(lambda (target)
(catch
'misc-error
(lambda ()
(guard (c ((package-cross-build-system-error? c)
#f))
(list inferior-package-id
system
target
(derivation-file-name
(if (string=? system target)
(package-derivation store package system)
(package-cross-derivation store package
target
system))))))
(lambda args
;; misc-error #f ~A ~S (No
;; cross-compilation for
;; clojure-build-system yet:
#f)))
(lset-intersection
string=?
supported-systems
(list ,@(map cdr system-target-pairs)))))
(lset-intersection
string=?
supported-systems
(list ,@(map car system-target-pairs))))))
(catch
#t
(lambda ()
(package-transitive-supported-systems package))
(lambda (key . args)
(simple-format
(current-error-port)
"error: while processing ~A, unable to compute transitive supported systems\n"
(package-name package))
(simple-format
(current-error-port)
"error ~A: ~A\n" key args)
#f))))
(if supported-systems
(append-map
(lambda (system)
(filter-map
(lambda (target)
(catch
'misc-error
(lambda ()
(guard (c ((package-cross-build-system-error? c)
#f))
(list inferior-package-id
system
target
(derivation-file-name
(if (string=? system target)
(package-derivation store package system)
(package-cross-derivation store package
target
system))))))
(lambda args
;; misc-error #f ~A ~S (No
;; cross-compilation for
;; clojure-build-system yet:
#f)))
(lset-intersection
string=?
supported-systems
(list ,@(map cdr system-target-pairs)))))
(lset-intersection
string=?
supported-systems
(list ,@(map car system-target-pairs))))
'())))
(lambda args
(simple-format (current-error-port)
"error: while processing ~A ignoring error: ~A\n"