me/guix
Archived
1
0
Fork 0
Code Activity

tests: 'marionette-service-type' nows takes a <marionette-configuration>.

Browse source 
* gnu/tests.scm (<marionette-configuration>): New record type.
(marionette-shepherd-service): Argument now is a <marionette-configuration>.
(marionette-operating-system): Adjust accordingly.  Add #:requirements
parameter and honor it.
This commit is contained in:
Ludovic Courtès 2016-06-27 21:09:08 +02:00
parent 858d372c98
commit 037f9e07cd
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 98 additions and 73 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
gnu/tests.scm
View file

@ -27,7 +27,13 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-9 gnu)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (marionette-service-type #:export (marionette-configuration
marionette-configuration?
marionette-configuration-device
marionette-configuration-imported-modules
marionette-configuration-requirements
marionette-service-type
marionette-operating-system marionette-operating-system
define-os-with-source define-os-with-source
@ -50,14 +56,26 @@
;;; ;;;
;;; Code: ;;; Code:
(define (marionette-shepherd-service imported-modules) (define-record-type* <marionette-configuration>
"Return the Shepherd service for the marionette REPL" marionette-configuration make-marionette-configuration
(define device marionette-configuration?
"/dev/hvc0") (device marionette-configuration-device ;string
(default "/dev/hvc0"))
(imported-modules marionette-configuration-imported-modules
(default '()))
(requirements marionette-configuration-requirements ;list of symbols
(default '())))
(define (marionette-shepherd-service config)
"Return the Shepherd service for the marionette REPL"
(match config
(($ <marionette-configuration> device imported-modules requirement)
(list (shepherd-service (list (shepherd-service
(provision '(marionette)) (provision '(marionette))
(requirement '(udev)) ;so that DEVICE is available
;; Always depend on UDEV so that DEVICE is available.
(requirement `(udev ,@requirement))
(modules '((ice-9 match) (modules '((ice-9 match)
(srfi srfi-9 gnu) (srfi srfi-9 gnu)
(guix build syscalls) (guix build syscalls)
@ -124,7 +142,7 @@
(primitive-exit 1)))) (primitive-exit 1))))
(pid (pid
pid)))) pid))))
(stop #~(make-kill-destructor))))) (stop #~(make-kill-destructor)))))))
(define marionette-service-type (define marionette-service-type
;; This is the type of the "marionette" service, allowing a guest system to ;; This is the type of the "marionette" service, allowing a guest system to
@ -136,12 +154,19 @@
marionette-shepherd-service))))) marionette-shepherd-service)))))
(define* (marionette-operating-system os (define* (marionette-operating-system os
#:key (imported-modules '())) #:key
"Return a marionetteed variant of OS such that OS can be used as a marionette (imported-modules '())
in a virtual machine--i.e., controlled from the host system." (requirements '()))
"Return a marionetteed variant of OS such that OS can be used as a
marionette in a virtual machine--i.e., controlled from the host system. The
marionette service in the guest is started after the Shepherd services listed
in REQUIREMENTS."
(operating-system (operating-system
(inherit os) (inherit os)
(services (cons (service marionette-service-type imported-modules) (services (cons (service marionette-service-type
(marionette-configuration
(requirements requirements)
(imported-modules imported-modules)))
(operating-system-user-services os))))) (operating-system-user-services os)))))
(define-syntax define-os-with-source (define-syntax define-os-with-source