gnu: Add go-github-com-onsi-gomega.

[jackhill/guix/guix.git] / build-aux / compile-all.scm

diff --git a/build-aux/compile-all.scm b/build-aux/compile-all.scm
index 4259ea5..9ffbce4 100644 (file)
--- a/build-aux/compile-all.scm
+++ b/build-aux/compile-all.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
-;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -79,6 +79,14 @@ to 'make'."
                        (current-processor-count))))
                 (loop tail)))))))))
 
+(define (parallel-job-count*)
+  ;; XXX: Work around memory requirements not sustainable on i686 above '-j4'
+  ;; or so: <https://bugs.gnu.org/40522>.
+  (let ((count (parallel-job-count)))
+    (if (string-prefix? "i686" %host-type)
+        (min count 4)
+        count)))
+
 (define (% completed total)
   "Return the completion percentage of COMPLETED over TOTAL as an integer."
   (inexact->exact (round (* 100. (/ completed total)))))
@@ -90,21 +98,53 @@ to 'make'."
     (exit 1)))
 
 (match (command-line)
-  ((_ . files)
-   (compile-files srcdir (getcwd)
-                  (filter file-needs-compilation? files)
-                  #:workers (parallel-job-count)
-                  #:host host
-                  #:report-load (lambda (file total completed)
-                                  (when file
-                                    (format #t "[~3d%] LOAD     ~a~%"
-                                            (% (+ 1 completed) (* 2 total))
-                                            file)
-                                    (force-output)))
-                  #:report-compilation (lambda (file total completed)
-                                         (when file
-                                           (format #t "[~3d%] GUILEC   ~a~%"
-                                                   (% (+ total completed 1)
-                                                      (* 2 total))
-                                                   (scm->go file))
-                                           (force-output))))))
+  ((_ "--total" (= string->number grand-total)
+      "--completed" (= string->number processed)
+      . files)
+   ;; GRAND-TOTAL is the total number of .scm files in the project; PROCESSED
+   ;; is the total number of .scm files already compiled in previous
+   ;; invocations of this script.
+   (catch #t
+     (lambda ()
+       (let* ((to-build  (filter file-needs-compilation? files))
+              (processed (+ processed
+                            (- (length files) (length to-build)))))
+         (compile-files srcdir (getcwd) to-build
+                        #:workers (parallel-job-count*)
+                        #:host host
+                        #:report-load (lambda (file total completed)
+                                        (when file
+                                          (format #t "[~3d%] LOAD     ~a~%"
+                                                  (% (+ 1 completed
+                                                          (* 2 processed))
+                                                     (* 2 grand-total))
+                                                  file)
+                                          (force-output)))
+                        #:report-compilation (lambda (file total completed)
+                                               (when file
+                                                 (format #t "[~3d%] GUILEC   ~a~%"
+                                                         (% (+ total completed 1
+                                                                     (* 2 processed))
+                                                            (* 2 grand-total))
+                                                         (scm->go file))
+                                                 (force-output))))))
+     (lambda _
+       (primitive-exit 1))
+     (lambda args
+       ;; Try to report the error in an intelligible way.
+       (let* ((stack   (make-stack #t))
+              (frame   (if (> (stack-length stack) 1)
+                           (stack-ref stack 1)    ;skip the 'throw' frame
+                           (stack-ref stack 0)))
+              (ui      (false-if-exception
+                        (resolve-module '(guix ui))))
+              (report  (and ui
+                            (false-if-exception
+                             (module-ref ui 'report-load-error)))))
+         (if report
+             (report (or (and=> (current-load-port) port-filename) "?.scm")
+                     args frame)
+             (begin
+               (print-exception (current-error-port) frame
+                                (car args) (cdr args))
+               (display-backtrace stack (current-error-port)))))))))