mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
tests: Add ‘guix-daemon’ test.
* gnu/tests/base.scm (manifest-entry-without-grafts): New procedure. (%hello-dependencies-manifest): New variable. (run-guix-daemon-test): New procedure. (%test-guix-daemon): New variable. Change-Id: Ia37966de1f61fb428e6fb2244271bf389a74af6d
This commit is contained in:
parent
75e3d34295
commit
9e07d889c4
1 changed files with 190 additions and 1 deletions
|
@ -34,6 +34,8 @@
|
|||
#:use-module (gnu services networking)
|
||||
#:use-module (gnu packages base)
|
||||
#:use-module (gnu packages bash)
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (gnu packages guile)
|
||||
#:use-module (gnu packages imagemagick)
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module (gnu packages ocr)
|
||||
|
@ -45,6 +47,7 @@
|
|||
#:use-module (guix monads)
|
||||
#:use-module (guix modules)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix profiles)
|
||||
#:use-module (guix utils)
|
||||
#:use-module ((srfi srfi-1) #:hide (partition))
|
||||
#:use-module (ice-9 match)
|
||||
|
@ -56,7 +59,8 @@
|
|||
%test-halt
|
||||
%test-root-unmount
|
||||
%test-cleanup
|
||||
%test-activation))
|
||||
%test-activation
|
||||
%test-guix-daemon))
|
||||
|
||||
(define %simple-os
|
||||
(simple-operating-system))
|
||||
|
@ -981,3 +985,188 @@ non-ASCII names from /tmp.")
|
|||
(name "activation")
|
||||
(description "Test that activation scripts are run in the correct order")
|
||||
(value (run-activation-test name))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Build daemon.
|
||||
;;;
|
||||
|
||||
(define (manifest-entry-without-grafts entry)
|
||||
"Return ENTRY with grafts disabled on its contents."
|
||||
(manifest-entry
|
||||
(inherit entry)
|
||||
(item (with-parameters ((%graft? #f))
|
||||
(manifest-entry-item entry)))))
|
||||
|
||||
(define %hello-dependencies-manifest ;TODO: Share with (gnu tests foreign).
|
||||
;; Build dependencies of 'hello' needed to test 'guix build hello'.
|
||||
(concatenate-manifests
|
||||
(list (map-manifest-entries
|
||||
manifest-entry-without-grafts
|
||||
(package->development-manifest hello))
|
||||
|
||||
;; Add the source of 'hello'.
|
||||
(manifest
|
||||
(list (manifest-entry
|
||||
(name "hello-source")
|
||||
(version (package-version hello))
|
||||
(item (let ((file (origin-actual-file-name
|
||||
(package-source hello))))
|
||||
(computed-file
|
||||
"hello-source"
|
||||
#~(begin
|
||||
;; Put the tarball in a subdirectory since
|
||||
;; profile union crashes otherwise.
|
||||
(mkdir #$output)
|
||||
(mkdir (in-vicinity #$output "src"))
|
||||
(symlink #$(package-source hello)
|
||||
(in-vicinity #$output
|
||||
(string-append "src/"
|
||||
#$file))))))))))
|
||||
|
||||
;; Include 'guile-final', which is needed when building derivations
|
||||
;; such as that of 'hello' but missing from the development manifest.
|
||||
;; Add '%bootstrap-guile', used by 'guix install --bootstrap'.
|
||||
(map-manifest-entries
|
||||
manifest-entry-without-grafts
|
||||
(packages->manifest (list (canonical-package guile-3.0)
|
||||
%bootstrap-guile))))))
|
||||
|
||||
(define (run-guix-daemon-test os)
|
||||
(define test-image
|
||||
(image (operating-system os)
|
||||
(format 'compressed-qcow2)
|
||||
(volatile-root? #f)
|
||||
(shared-store? #f)
|
||||
(partition-table-type 'mbr)
|
||||
(partitions
|
||||
(list (partition
|
||||
(size (* 4 (expt 2 30)))
|
||||
(offset (* 512 2048)) ;leave room for GRUB
|
||||
(flags '(boot))
|
||||
(label "root"))))))
|
||||
|
||||
(define test
|
||||
(with-imported-modules (source-module-closure
|
||||
'((gnu build marionette)
|
||||
(guix build utils)))
|
||||
#~(begin
|
||||
(use-modules (gnu build marionette)
|
||||
(guix build utils)
|
||||
(srfi srfi-64))
|
||||
|
||||
(define marionette
|
||||
(make-marionette
|
||||
(list (string-append #$qemu-minimal "/bin/" (qemu-command))
|
||||
#$@(common-qemu-options (system-image test-image) '()
|
||||
#:image-format "qcow2"
|
||||
#:rw-image? #t)
|
||||
"-m" "512"
|
||||
"-nographic" "-serial" "stdio"
|
||||
"-snapshot")))
|
||||
|
||||
(test-runner-current (system-test-runner #$output))
|
||||
(test-begin "guix-daemon")
|
||||
|
||||
(test-equal "guix describe"
|
||||
0
|
||||
(marionette-eval '(system* "guix" "describe")
|
||||
marionette))
|
||||
|
||||
;; XXX: What follows is largely copied form (gnu tests foreign).
|
||||
|
||||
(test-equal "hello not already built"
|
||||
#f
|
||||
;; Check that the next test will really build 'hello'.
|
||||
(marionette-eval '(file-exists?
|
||||
#$(with-parameters ((%graft? #f))
|
||||
hello))
|
||||
marionette))
|
||||
|
||||
(test-equal "guix build hello"
|
||||
0
|
||||
;; Check that guix-daemon is up and running and that the build
|
||||
;; environment is properly set up (build users, etc.).
|
||||
(marionette-eval '(system* "guix" "build" "hello" "--no-grafts")
|
||||
marionette))
|
||||
|
||||
(test-assert "hello indeed built"
|
||||
(marionette-eval '(file-exists?
|
||||
#$(with-parameters ((%graft? #f))
|
||||
hello))
|
||||
marionette))
|
||||
|
||||
(test-equal "guix install hello"
|
||||
0
|
||||
;; Check that ~/.guix-profile & co. are properly created.
|
||||
(marionette-eval '(let ((pw (getpwuid (getuid))))
|
||||
(setenv "USER" (passwd:name pw))
|
||||
(setenv "HOME" (pk 'home (passwd:dir pw)))
|
||||
(system* "guix" "install" "hello"
|
||||
"--no-grafts" "--bootstrap"))
|
||||
marionette))
|
||||
|
||||
(test-equal "user profile created"
|
||||
0
|
||||
(marionette-eval '(system "ls -lad ~/.guix-profile")
|
||||
marionette))
|
||||
|
||||
(test-equal "hello"
|
||||
0
|
||||
(marionette-eval '(system "~/.guix-profile/bin/hello")
|
||||
marionette))
|
||||
|
||||
(test-equal "guix install hello, unprivileged user"
|
||||
0
|
||||
;; Check that 'guix' is in $PATH for new users and that
|
||||
;; ~user/.guix-profile also gets created.
|
||||
(marionette-eval '(system "su - user -c \
|
||||
'guix install hello --no-grafts --bootstrap'")
|
||||
marionette))
|
||||
|
||||
(test-equal "user hello"
|
||||
0
|
||||
(marionette-eval '(system "~user/.guix-profile/bin/hello")
|
||||
marionette))
|
||||
|
||||
(test-equal "unprivileged user profile created"
|
||||
0
|
||||
(marionette-eval '(system "ls -lad ~user/.guix-profile")
|
||||
marionette))
|
||||
|
||||
(test-equal "store is read-only"
|
||||
EROFS
|
||||
(marionette-eval '(catch 'system-error
|
||||
(lambda ()
|
||||
(mkdir (in-vicinity #$(%store-prefix)
|
||||
"whatever"))
|
||||
0)
|
||||
(lambda args
|
||||
(system-error-errno args)))
|
||||
marionette))
|
||||
|
||||
(test-end))))
|
||||
|
||||
(gexp->derivation "guix-daemon-test" test))
|
||||
|
||||
(define %test-guix-daemon
|
||||
(system-test
|
||||
(name "guix-daemon")
|
||||
(description
|
||||
"Test 'guix-daemon' behavior on a multi-user system.")
|
||||
(value
|
||||
(let ((os (marionette-operating-system
|
||||
(operating-system
|
||||
(inherit (operating-system-with-gc-roots
|
||||
%simple-os
|
||||
(list (profile
|
||||
(name "hello-build-dependencies")
|
||||
(content %hello-dependencies-manifest)))))
|
||||
(kernel-arguments '("console=ttyS0"))
|
||||
(users (cons (user-account
|
||||
(name "user")
|
||||
(group "users"))
|
||||
%base-user-accounts)))
|
||||
#:imported-modules '((gnu services herd)
|
||||
(guix combinators)))))
|
||||
(run-guix-daemon-test os)))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue