channels: Call 'build-self.scm' procedure with a trivial build handler.
authorLudovic Courtès <ludo@gnu.org>
Mon, 6 Apr 2020 21:21:43 +0000 (23:21 +0200)
committerLudovic Courtès <ludo@gnu.org>
Mon, 6 Apr 2020 21:56:24 +0000 (23:56 +0200)
Previously, "TESTS=installed-os guix build -m etc/system-tests.scm"
would repeat the "Computing Guix derivation" phase ~5 times due to the
fact that there were several call paths, within a build-accumulator,
leading to (package-derivation store guix).

* guix/channels.scm (with-trivial-build-handler): New procedure.
(build-from-source): Wrap 'build' call in 'with-trivial-build-handler'.

guix/channels.scm

index f0261dc..785b977 100644 (file)
@@ -349,6 +349,15 @@ to '%package-module-path'."
       (((predicate . guile) rest ...)
        (if (predicate source) (guile) (loop rest))))))
 
+(define (with-trivial-build-handler mvalue)
+  "Run MVALUE, a monadic value, with a \"trivial\" build handler installed
+that unconditionally resumes the continuation."
+  (lambda (store)
+    (with-build-handler (lambda (continue . _)
+                          (continue #t))
+      (values (run-with-store store mvalue)
+              store))))
+
 (define* (build-from-source name source
                             #:key core verbose? commit
                             (dependencies '()))
@@ -381,8 +390,14 @@ package modules under SOURCE using CORE, an instance of Guix."
         (mbegin %store-monad
           (mwhen guile
             (set-guile-for-build guile))
-          (build source #:verbose? verbose? #:version commit
-                 #:pull-version %pull-version)))
+
+          ;; BUILD is usually quite costly.  Install a "trivial" build handler
+          ;; so we don't bounce an outer build-accumulator handler that could
+          ;; cause us to redo half of the BUILD computation several times just
+          ;; to realize it gives the same result.
+          (with-trivial-build-handler
+           (build source #:verbose? verbose? #:version commit
+                  #:pull-version %pull-version))))
 
       ;; Build a set of modules that extend Guix using the standard method.
       (standard-module-derivation name source core dependencies)))