gnu: ruby-pandoc-ruby: Use pandoc instead of ghc-pandoc.
[jackhill/guix/guix.git] / gnu / tests.scm
index 2aef370..83528a4 100644 (file)
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
@@ -20,8 +20,9 @@
 
 (define-module (gnu tests)
   #:use-module (guix gexp)
-  #:use-module (guix utils)
+  #:use-module (guix diagnostics)
   #:use-module (guix records)
+  #:use-module ((guix ui) #:select (warn-about-load-error))
   #:use-module (gnu bootloader)
   #:use-module (gnu bootloader grub)
   #:use-module (gnu system)
@@ -60,7 +61,7 @@
 ;;;
 ;;; This module provides the infrastructure to run operating system tests.
 ;;; The most important part of that is tools to instrument the OS under test,
-;;; essentially allowing to run in a virtual machine controlled by the host
+;;; essentially allowing it to run in a virtual machine controlled by the host
 ;;; system--hence the name "marionette".
 ;;;
 ;;; Code:
@@ -86,8 +87,7 @@
             (requirement `(udev ,@requirement))
 
             (modules '((ice-9 match)
-                       (srfi srfi-9 gnu)
-                       (rnrs bytevectors)))
+                       (srfi srfi-9 gnu)))
             (start
              (with-imported-modules imported-modules
                #~(lambda ()
@@ -97,8 +97,8 @@
                                                ((_ pred rest ...)
                                                 (or (pred x)
                                                     (one-of rest ...))))))
-                       (one-of symbol? string? pair? null? vector?
-                               bytevector? number? boolean?)))
+                       (one-of symbol? string? keyword? pair? null? array?
+                               number? boolean? char?)))
 
                    (match (primitive-fork)
                      (0
@@ -208,8 +208,7 @@ the system under test."
                  (bootloader grub-bootloader)
                  (target "/dev/sdX")))
     (file-systems (cons (file-system
-                          (device "my-root")
-                          (title 'label)
+                          (device (file-system-label "my-root"))
                           (mount-point "/")
                           (type "ext4"))
                         %base-file-systems))
@@ -219,8 +218,7 @@ the system under test."
                   (name "alice")
                   (comment "Bob's sister")
                   (group "users")
-                  (supplementary-groups '("wheel" "audio" "video"))
-                  (home-directory "/home/alice"))
+                  (supplementary-groups '("wheel" "audio" "video")))
                  %base-user-accounts))))
 
 (define-syntax-rule (simple-operating-system user-services ...)
@@ -256,10 +254,17 @@ the system under test."
 
 (set-record-type-printer! <system-test> write-system-test)
 
+(define-gexp-compiler (compile-system-test (test <system-test>)
+                                           system target)
+  "Compile TEST to a derivation."
+  ;; XXX: SYSTEM and TARGET are ignored.
+  (system-test-value test))
+
 (define (test-modules)
   "Return the list of modules that define system tests."
   (scheme-modules (dirname (search-path %load-path "guix.scm"))
-                  "gnu/tests"))
+                  "gnu/tests"
+                  #:warn warn-about-load-error))
 
 (define (fold-system-tests proc seed)
   "Invoke PROC on each system test, passing it the test and the previous