;;; 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>
;;;
#:use-module (guix gexp)
#:use-module (guix utils)
#: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)
;;;
;;; 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:
(requirement `(udev ,@requirement))
(modules '((ice-9 match)
- (srfi srfi-9 gnu)
- (rnrs bytevectors)))
+ (srfi srfi-9 gnu)))
(start
(with-imported-modules imported-modules
#~(lambda ()
((_ 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
(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))
(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 ...)
(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