Evaluate derivations in a separate process.

This fixes a bug where different Guix branches gave the same
derivations.

4 files changed, 87 insertions, 97 deletions

diff --git a/tests/database.scm b/tests/database.scm
index 232eab4..869d73c 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -21,10 +21,9 @@
              (cuirass job)
              (srfi srfi-64))
 
-(define* (make-dummy-job #:optional (name "foo") #:key (metadata '()))
-  (make-job #:name name
-            #:derivation (string-append name ".drv")
-            #:metadata metadata))
+(define* (make-dummy-job #:optional (name "foo"))
+  `((#:name . ,name)
+    (#:derivation . ,(string-append name ".drv"))))
 
 (define %db
   ;; Global Slot for a database object.
@@ -51,11 +50,11 @@
         (db-get-evaluation (%db) (%id)))
 
       (test-equal "db-add-build-log"
-        (let ((job (make-dummy-job #:metadata `((id . ,(%id)))))
+        "foo log"
+        (let ((job (acons #:id (%id) (make-dummy-job)))
               (log-column 3))
           (db-add-build-log (%db) job "foo log")
-          (vector-ref (db-get-evaluation (%db) (%id)) log-column))
-        "foo log")
+          (vector-ref (db-get-evaluation (%db) (%id)) log-column)))
 
       (test-assert "db-close"
         (db-close (%db))))
diff --git a/tests/gnu-system.scm b/tests/gnu-system.scm
index 520c33d..fc7c15f 100644
--- a/tests/gnu-system.scm
+++ b/tests/gnu-system.scm
@@ -25,8 +25,7 @@
   ;; newer, even though they may not correspond.
   (set! %fresh-auto-compile #t))
 
-(use-modules (cuirass job)
-             (guix config)
+(use-modules (guix config)
              (guix store)
              (guix grafts)
              (guix packages)
@@ -55,36 +54,38 @@
 
 (define (package-metadata package)
   "Convert PACKAGE to an alist suitable for Hydra."
-  `((description . ,(package-synopsis package))
-    (long-description . ,(package-description package))
-    (license . ,(package-license package))
-    (home-page . ,(package-home-page package))
-    (maintainers . ("bug-guix@gnu.org"))
-    (max-silent-time . ,(or (assoc-ref (package-properties package)
-                                       'max-silent-time)
-                            3600))      ;1 hour by default
-    (timeout . ,(or (assoc-ref (package-properties package) 'timeout)
-                    72000))))           ;20 hours by default
+  `((#:description . ,(package-synopsis package))
+    (#:long-description . ,(package-description package))
+    ;; (#:license . ,(package-license package))
+    (#:home-page . ,(package-home-page package))
+    (#:maintainers . ("bug-guix@gnu.org"))
+    (#:max-silent-time . ,(or (assoc-ref (package-properties package)
+                                         'max-silent-time)
+                              3600))      ;1 hour by default
+    (#:timeout . ,(or (assoc-ref (package-properties package) 'timeout)
+                      72000))))           ;20 hours by default
 
 (define (package-job store job-name package system)
   "Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
-  (make-job
-   #:name (string-append (symbol->string job-name) "." system)
-   #:derivation (derivation-file-name
-                 (parameterize ((%graft? #f))
-                   (package-derivation store package system #:graft? #f)))
-   #:metadata (package-metadata package)))
+  (λ ()
+    `((#:job-name . ,(string-append (symbol->string job-name) "." system))
+      (#:derivation . ,(derivation-file-name
+                        (parameterize ((%graft? #f))
+                          (package-derivation store package system
+                                              #:graft? #f))))
+      ,@(package-metadata package))))
 
 (define (package-cross-job store job-name package target system)
   "Return a job called TARGET.JOB-NAME that cross-builds PACKAGE
 for TARGET on SYSTEM."
-  (make-job
-   #:name (string-append target "." (symbol->string job-name) "." system)
-   #:derivation (derivation-file-name
-                 (parameterize ((%graft? #f))
-                   (package-cross-derivation store package target system
-                                             #:graft? #f)))
-   #:metadata (package-metadata package)))
+  (λ ()
+    `((#:job-name . ,(string-join (list target (symbol->string job-name) system)
+                                  "."))
+      (#:derivation . ,(derivation-file-name
+                        (parameterize ((%graft? #f))
+                          (package-cross-derivation store package target system
+                                                    #:graft? #f))))
+      ,@(package-metadata package))))
 
 (define %core-packages
   ;; Note: Don't put the '-final' package variants because (1) that's
@@ -107,25 +108,24 @@ for TARGET on SYSTEM."
   '("mips64el-linux-gnu"
     "mips64el-linux-gnuabi64"))
 
-(define (tarball-jobs store system)
+(define (tarball-job store system)
   "Return Hydra jobs to build the self-contained Guix binary tarball."
-  (list
-   (make-job
-    #:name (string-append "binary-tarball." system)
-    #:derivation (derivation-file-name
-                  (parameterize ((%graft? #f))
-                    (run-with-store store
-                      (mbegin %store-monad
-                        (set-guile-for-build (default-guile))
-                        (self-contained-tarball))
-                      #:system system)))
-    #:metadata
-    `((description . "Stand-alone binary Guix tarball")
-      (long-description . "This is a tarball containing binaries of Guix and
-all its dependencies, and ready to be installed on non-GuixSD distributions.")
-      (license . ,gpl3+)
-      (home-page . ,%guix-home-page-url)
-      (maintainers . ("bug-guix@gnu.org"))))))
+  (λ ()
+    `((#:job-name . (string-append "binary-tarball." system))
+      (#:derivation . ,(derivation-file-name
+                        (parameterize ((%graft? #f))
+                          (run-with-store store
+                            (mbegin %store-monad
+                              (set-guile-for-build (default-guile))
+                              (self-contained-tarball))
+                            #:system system))))
+      (#:description . "Stand-alone binary Guix tarball")
+      (#:long-description . "This is a tarball containing binaries of Guix
+and all its dependencies, and ready to be installed on non-GuixSD
+distributions.")
+      ;; (#:license . ,gpl3+)
+      (#:home-page . ,%guix-home-page-url)
+      (#:maintainers . ("bug-guix@gnu.org")))))
 
 (define %job-name
   ;; Return the name of a package's job.
@@ -207,7 +207,7 @@ valid."
                        (append (filter-map (lambda (pkg)
                                              (package->job store pkg system))
                                            pkgs)
-                               (tarball-jobs store system)
+                               (list (tarball-job store system))
                                (cross-jobs system))))
                     ((core)
                      ;; Build core packages only.
diff --git a/tests/guix-jobs.scm b/tests/guix-jobs.scm
index 9196147..470305f 100644
--- a/tests/guix-jobs.scm
+++ b/tests/guix-jobs.scm
@@ -17,24 +17,20 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Cuirass.  If not, see <http://www.gnu.org/licenses/>.
 
-(use-modules (cuirass job))
-
-;; In the common case jobs will be defined relative to the repository.
-;; However for testing purpose use local gnu-system.scm instead.
 (define (local-file file)
+  ;; In the common case jobs will be defined relative to the repository.
+  ;; However for testing purpose use local gnu-system.scm instead.
   (string-append (dirname (current-filename)) "/" file))
 
-(list (make-job-spec
-       #:name "guix"
-       #:url "git://git.savannah.gnu.org/guix.git"
-       #:load-path "."
-       #:branch "master"
-       #:file (local-file "gnu-system.scm")
-       #:proc 'hydra-jobs)
-      (make-job-spec
-       #:name "guix"
-       #:url "git://git.savannah.gnu.org/guix.git"
-       #:load-path "."
-       #:tag "v0.10.0"
-       #:file (local-file "gnu-system.scm")
-       #:proc 'hydra-jobs))
+`(((#:name . "guix")
+   (#:url . "git://git.savannah.gnu.org/guix.git")
+   (#:load-path . ".")
+   (#:branch . "master")
+   (#:file . ,(local-file "gnu-system.scm"))
+   (#:proc . hydra-jobs))
+  ((#:name . "guix")
+   (#:url . "git://git.savannah.gnu.org/guix.git")
+   (#:load-path . ".")
+   (#:tag . "v0.10.0")
+   (#:file . ,(local-file "gnu-system.scm"))
+   (#:proc . hydra-jobs)))
diff --git a/tests/hello-subset.scm b/tests/hello-subset.scm
index f904782..76136ef 100644
--- a/tests/hello-subset.scm
+++ b/tests/hello-subset.scm
@@ -17,34 +17,29 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Cuirass.  If not, see <http://www.gnu.org/licenses/>.
 
-(use-modules (cuirass job))
-
-;; In the common case jobs will be defined relative to the repository.
-;; However for testing purpose use local gnu-system.scm instead.
 (define (local-file file)
+  ;; In the common case jobs will be defined relative to the repository.
+  ;; However for testing purpose use local gnu-system.scm instead.
   (string-append (dirname (current-filename)) "/" file))
 
-(list (make-job-spec
-       #:name "guix"
-       #:url "git://git.savannah.gnu.org/guix.git"
-       #:load-path "."
-       #:branch "master"
-       #:file (local-file "gnu-system.scm")
-       #:proc 'hydra-jobs
-       #:arguments '((subset . "hello")))
-      (make-job-spec
-       #:name "guix"
-       #:url "git://git.savannah.gnu.org/guix.git"
-       #:load-path "."
-       #:branch "core-updates"
-       #:file (local-file "gnu-system.scm")
-       #:proc 'hydra-jobs
-       #:arguments '((subset . "hello")))
-      (make-job-spec
-       #:name "guix"
-       #:url "git://git.savannah.gnu.org/guix.git"
-       #:load-path "."
-       #:tag "v0.9.0"
-       #:file (local-file "gnu-system.scm")
-       #:proc 'hydra-jobs
-       #:arguments '((subset . "hello"))))
+`(((#:name . "guix")
+   (#:url . "git://git.savannah.gnu.org/guix.git")
+   (#:load-path . ".")
+   (#:branch . "master")
+   (#:file . ,(local-file "gnu-system.scm"))
+   (#:proc . hydra-jobs)
+   (#:arguments (subset . "hello")))
+  ((#:name . "guix")
+   (#:url . "git://git.savannah.gnu.org/guix.git")
+   (#:load-path . ".")
+   (#:branch . "core-updates")
+   (#:file . ,(local-file "gnu-system.scm"))
+   (#:proc . hydra-jobs)
+   (#:arguments (subset . "hello")))
+  ((#:name . "guix")
+   (#:url . "git://git.savannah.gnu.org/guix.git")
+   (#:load-path . ".")
+   (#:tag . "v0.9.0")
+   (#:file . ,(local-file "gnu-system.scm"))
+   (#:proc . hydra-jobs)
+   (#:arguments (subset . "hello"))))