summary refs log tree commit diff
path: root/build-aux/hydra
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-06-27 09:30:01 +0200
committerLudovic Courtès <ludo@gnu.org>2016-06-27 09:30:01 +0200
commit01497dfe6c0a2ce69287d0fd0008747965a000df (patch)
treef7f6f53baf6e81a8bce26144c550da3bf4b9df5c /build-aux/hydra
parent74c8b174e8015de753ba5cab44f76f944e6fd4ba (diff)
downloadguix-01497dfe6c0a2ce69287d0fd0008747965a000df.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'build-aux/hydra')
-rw-r--r--build-aux/hydra/evaluate.scm15
-rw-r--r--build-aux/hydra/gnu-system.scm37
2 files changed, 50 insertions, 2 deletions
diff --git a/build-aux/hydra/evaluate.scm b/build-aux/hydra/evaluate.scm
index afc7730ff2..ab10253f31 100644
--- a/build-aux/hydra/evaluate.scm
+++ b/build-aux/hydra/evaluate.scm
@@ -49,6 +49,17 @@ values."
                  (/ (time-nanosecond time) 1e9)))
       (apply values results))))
 
+(define (assert-valid-job job thing)
+  "Raise an error if THING is not an alist with a valid 'derivation' entry.
+Otherwise return THING."
+  (unless (and (list? thing)
+               (and=> (assoc-ref thing 'derivation)
+                      (lambda (value)
+                        (and (string? value)
+                             (string-suffix? ".drv" value)))))
+    (error "job did not produce a valid alist" job thing))
+  thing)
+
 
 ;; Without further ado...
 (match (command-line)
@@ -83,7 +94,9 @@ values."
            (map (lambda (job thunk)
                   (format (current-error-port) "evaluating '~a'... " job)
                   (force-output (current-error-port))
-                  (cons job (call-with-time-display thunk)))
+                  (cons job
+                        (assert-valid-job job
+                                          (call-with-time-display thunk))))
                 names thunks)))
         port))))
   ((command _ ...)
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index d15be1bad2..a84cdebbad 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -59,6 +59,7 @@
              (gnu system)
              (gnu system vm)
              (gnu system install)
+             (gnu tests)
              (srfi srfi-1)
              (srfi srfi-26)
              (ice-9 match))
@@ -129,6 +130,9 @@ SYSTEM."
          (file (string-append dir "/demo-os.scm")))
     (read-operating-system file)))
 
+(define %guixsd-supported-systems
+  '("x86_64-linux" "i686-linux"))
+
 (define (qemu-jobs store system)
   "Return a list of jobs that build QEMU images for SYSTEM."
   (define (->alist drv)
@@ -150,7 +154,7 @@ system.")
   (define MiB
     (expt 2 20))
 
-  (if (member system '("x86_64-linux" "i686-linux"))
+  (if (member system %guixsd-supported-systems)
       (list (->job 'qemu-image
                    (run-with-store store
                      (mbegin %store-monad
@@ -167,6 +171,36 @@ system.")
                                           (* 1024 MiB))))))
       '()))
 
+(define (system-test-jobs store system)
+  "Return a list of jobs for the system tests."
+  (define (test->thunk test)
+    (lambda ()
+      (define drv
+        (run-with-store store
+          (mbegin %store-monad
+            (set-current-system system)
+            (set-grafting #f)
+            (set-guile-for-build (default-guile))
+            (system-test-value test))))
+
+      `((derivation . ,(derivation-file-name drv))
+        (description . ,(format #f "GuixSD '~a' system test"
+                                (system-test-name test)))
+        (long-description . ,(system-test-description test))
+        (license . ,gpl3+)
+        (home-page . ,%guix-home-page-url)
+        (maintainers . ("bug-guix@gnu.org")))))
+
+  (define (->job test)
+    (let ((name (string->symbol
+                 (string-append "test." (system-test-name test)
+                                "." system))))
+      (cons name (test->thunk test))))
+
+  (if (member system %guixsd-supported-systems)
+      (map ->job (all-system-tests))
+      '()))
+
 (define (tarball-jobs store system)
   "Return Hydra jobs to build the self-contained Guix binary tarball."
   (define (->alist drv)
@@ -274,6 +308,7 @@ valid."
                                                 system))))
                        (append (filter-map job all)
                                (qemu-jobs store system)
+                               (system-test-jobs store system)
                                (tarball-jobs store system)
                                (cross-jobs system))))
                     ((core)