@@ -26,11 +26,24 @@
#:use-module (gnu services networking)
#:use-module (gnu services docker)
#:use-module (gnu services desktop)
+ #:use-module (gnu packages bootstrap)
#:use-module (gnu packages docker)
+ #:use-module (guix derivations)
#:use-module (guix gexp)
+ #:use-module (guix grafts)
+ #:use-module (guix monads)
+ #:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module (guix scripts pack)
#:use-module (guix store)
+ #:use-module (guix tests)
+ #:use-module (srfi srfi-64)
+ #:use-module (guix build-system trivial)
#:export (%test-docker))
+;; Globally disable grafts because they can trigger early builds.
+;(%graft? #f)
+
(define %docker-os
(simple-operating-system
(service dhcp-client-service-type)
@@ -39,8 +52,9 @@
(service elogind-service-type)
(service docker-service-type)))
-(define (run-docker-test)
- "Run tests in %DOCKER-OS."
+(define (run-docker-test docker-tarball)
+ "Load the DOCKER-TARBALL as docker image and run it in a Docker container,
+inside %DOCKER-OS."
(define os
(marionette-operating-system
%docker-os
@@ -50,8 +64,8 @@
(define vm
(virtual-machine
(operating-system os)
- (memory-size 500)
- (disk-image-size (* 250 (expt 2 20)))
+ (memory-size 1500)
+ (disk-image-size (* 1500 (expt 2 20)))
(port-forwardings '())))
(define test
@@ -87,13 +101,69 @@
"version"))
marionette))
+ (test-equal "pack guest OS as docker image, load it and run it"
+ "hello world"
+ (marionette-eval
+ `(begin
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (read-line port))
+ (status (close-pipe port)))
+ output)))
+ (let* ((raw-text (slurp ,(string-append #$docker-cli
+ "/bin/docker")
+ "load" "-i"
+ ,#$docker-tarball))
+ (repository&tag (string-drop raw-text
+ (string-length
+ "Loaded image: ")))
+ (response (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "run" "--entrypoint" "bin/Guile"
+ repository&tag
+ "/aa.scm")))
+ response))
+ marionette))
+
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "docker-test" test))
+(define (build-tarball&run-docker-test)
+ (mlet* %store-monad
+ ((_ (set-grafting #f))
+ (guile (set-guile-for-build (default-guile)))
+ (guest-script-package ->
+ (dummy-package "guest-script"
+ (build-system trivial-build-system)
+ (arguments
+ `(#:guile ,%bootstrap-guile
+ #:builder
+ (let ((out (assoc-ref %outputs "out")))
+ (mkdir out)
+ (call-with-output-file (string-append out "/a.scm")
+ (lambda (port)
+ (display "(display \"hello world\n\")" port)))
+ #t)))))
+ (profile (profile-derivation (packages->manifest
+ (list %bootstrap-guile
+ guest-script-package))
+ #:hooks '()
+ #:locales? #f))
+ (tarball (docker-image "docker-pack" profile
+ #:symlinks '(("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm"))
+ #:localstatedir? #t)))
+ (run-docker-test tarball)))
+
(define %test-docker
(system-test
(name "docker")
- (description "Connect to the running Docker service.")
- (value (run-docker-test))))
+ (description "Test Docker container of Guix.")
+ (value (build-tarball&run-docker-test))))
+
+;; Local Variables:
+;; eval: (put 'test-assertm 'scheme-indent-function 2)
+;; End: