* [bug#49981] wip: Introduce unit-tests.
@ 2021-08-10 15:04 Mathieu Othacehe
2021-08-10 18:15 ` Christopher Baines
` (3 more replies)
0 siblings, 4 replies; 7+ messages in thread
From: Mathieu Othacehe @ 2021-08-10 15:04 UTC (permalink / raw)
To: 49981
[-- Attachment #1: Type: text/plain, Size: 673 bytes --]
Hello,
I would like to convert the Guix tests in the "tests/" directory to
derivations, in the exact same way as for the system tests in the
"gnu/tests/" directory.
For that, I propose to introduce a new <unit-test> record. This would
allow us to select all the unit tests using the "all-unit-tests"
procedure, and add them to the (gnu ci) module.
This way, we could have a Cuirass specification for the unit tests, as
we already have for the system tests, to spot regressions early on.
Here's a patch that translates the "account.scm" test module to the new
proposed mechanism. If there are no objections, I plan to convert all
the remaining tests.
Thanks,
Mathieu
[-- Attachment #2: 0001-wip-Introduce-unit-tests.patch --]
[-- Type: text/x-patch, Size: 38173 bytes --]
From eecedc74d8a3fa1a4dc1b99879def3571c9667cf Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Tue, 10 Aug 2021 16:56:38 +0200
Subject: [PATCH] wip: Introduce unit-tests.
---
Makefile.am | 1 +
etc/unit-tests.scm | 98 ++++++++
tests/accounts.scm | 545 +++++++++++++++++++++++----------------------
unit-tests.scm | 69 ++++++
4 files changed, 442 insertions(+), 271 deletions(-)
create mode 100644 etc/unit-tests.scm
create mode 100644 unit-tests.scm
diff --git a/Makefile.am b/Makefile.am
index 5542aa1c56..a5517f10d5 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -431,6 +431,7 @@ TEST_EXTENSIONS = .scm .sh
if CAN_RUN_TESTS
SCM_TESTS = \
+ unit-tests.scm \
tests/accounts.scm \
tests/base16.scm \
tests/base32.scm \
diff --git a/etc/unit-tests.scm b/etc/unit-tests.scm
new file mode 100644
index 0000000000..3daf69df3d
--- /dev/null
+++ b/etc/unit-tests.scm
@@ -0,0 +1,98 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(use-modules (unit-tests)
+ (gnu packages package-management)
+ ((gnu ci) #:select (channel-source->package))
+ ((guix git-download) #:select (git-predicate))
+ ((guix utils) #:select (current-source-directory))
+ (git)
+ (ice-9 match))
+
+(define (source-commit directory)
+ "Return the commit of the head of DIRECTORY or #f if it could not be
+determined."
+ (let ((repository #f))
+ (catch 'git-error
+ (lambda ()
+ (set! repository (repository-open directory))
+ (let* ((head (repository-head repository))
+ (target (reference-target head))
+ (commit (oid->string target)))
+ (repository-close! repository)
+ commit))
+ (lambda _
+ (when repository
+ (repository-close! repository))
+ #f))))
+
+(define (tests-for-current-guix source commit)
+ "Return a list of tests for perform, using Guix built from SOURCE, a channel
+instance."
+ ;; Honor the 'TESTS' environment variable so that one can select a subset
+ ;; of tests to run in the usual way:
+ ;;
+ ;; make check TESTS=accounts
+ (parameterize ((current-guix-package
+ (channel-source->package source #:commit commit)))
+ (match (getenv "TESTS")
+ (#f
+ (all-unit-tests))
+ ((= string-tokenize (tests ...))
+ (filter (lambda (test)
+ (member (unit-test-name test) tests))
+ (all-unit-tests))))))
+
+(define (unit-test->manifest-entry test)
+ "Return a manifest entry for TEST, a unit test."
+ (manifest-entry
+ (name (string-append "test." (unit-test-name test)))
+ (version "0")
+ (item test)))
+
+(define (unit-test-manifest)
+ "Return a manifest containing all the unit tests, or all those selected by
+the 'TESTS' environment variable."
+ (define source
+ (string-append (current-source-directory) "/.."))
+
+ (define commit
+ ;; Fetch the current commit ID so we can potentially build the same
+ ;; derivation as ci.guix.gnu.org.
+ (source-commit source))
+
+ ;; Intern SOURCE so that 'build-from-source' in (guix channels) sees
+ ;; "fresh" file names and thus doesn't find itself loading .go files
+ ;; from ~/.cache/guile when it loads 'build-aux/build-self.scm'.
+ (let* ((source (local-file source
+ (if commit
+ (string-append "guix-"
+ (string-take commit 7))
+ "guix-source")
+ #:recursive? #t
+ #:select?
+ (or (git-predicate source)
+ (const #t))))
+ (tests (tests-for-current-guix source commit)))
+ (format (current-error-port) "Selected ~a unit tests...~%"
+ (length tests))
+
+ (manifest (map unit-test->manifest-entry tests))))
+
+;; Return the manifest.
+(unit-test-manifest)
diff --git a/tests/accounts.scm b/tests/accounts.scm
index 78136390bb..302fcff567 100644
--- a/tests/accounts.scm
+++ b/tests/accounts.scm
@@ -16,13 +16,11 @@
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
-(define-module (test-accounts)
- #:use-module (gnu build accounts)
- #:use-module (gnu system accounts)
- #:use-module (srfi srfi-19)
- #:use-module (srfi srfi-64)
- #:use-module (ice-9 vlist)
- #:use-module (ice-9 match))
+(define-module (tests accounts)
+ #:use-module (unit-tests)
+ #:use-module (guix gexp)
+ #:use-module (guix modules)
+ #:export (%test-accounts))
(define %passwd-sample
"\
@@ -42,283 +40,288 @@ charlie:" (crypt "hey!" "$6$abc") ":17169::::::
nobody:!:0::::::\n"))
\f
-(test-begin "accounts")
-(test-equal "write-passwd"
- %passwd-sample
- (call-with-output-string
- (lambda (port)
- (write-passwd (list (password-entry
- (name "root")
- (uid 0) (gid 0)
- (real-name "Admin")
- (directory "/root")
- (shell "/bin/sh"))
- (password-entry
- (name "charlie")
- (uid 1000) (gid 998)
- (real-name "Charlie")
- (directory "/home/charlie")
- (shell "/bin/sh")))
- port))))
+(define (run-accounts-test)
+ (define test
+ (with-imported-modules
+ (source-module-closure '((gnu build accounts)
+ (gnu system accounts)))
+ #~(begin
+ (use-modules (srfi srfi-19)
+ (srfi srfi-64)
+ (ice-9 vlist)
+ (ice-9 match)
+ (gnu build accounts)
+ (gnu system accounts))
-(test-equal "write-passwd with duplicate entry"
- %passwd-sample
- (call-with-output-string
- (lambda (port)
- (let ((charlie (password-entry
- (name "charlie")
- (uid 1000) (gid 998)
- (real-name "Charlie")
- (directory "/home/charlie")
- (shell "/bin/sh"))))
- (write-passwd (list (password-entry
- (name "root")
- (uid 0) (gid 0)
- (real-name "Admin")
- (directory "/root")
- (shell "/bin/sh"))
- charlie charlie)
- port)))))
+ (mkdir #$output)
+ (chdir #$output)
-(test-equal "read-passwd + write-passwd"
- %passwd-sample
- (call-with-output-string
- (lambda (port)
- (write-passwd (call-with-input-string %passwd-sample
- read-passwd)
- port))))
+ (test-begin "accounts")
-(test-equal "write-group"
- %group-sample
- (call-with-output-string
- (lambda (port)
- (write-group (list (group-entry
- (name "root") (gid 0))
- (group-entry
- (name "wheel") (gid 999)
- (members '("alice" "bob")))
- (group-entry
- (name "hackers") (gid 65000)
- (members '("alice" "charlie"))))
- port))))
+ (test-equal "write-passwd"
+ #$%passwd-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-passwd (list (password-entry
+ (name "root")
+ (uid 0) (gid 0)
+ (real-name "Admin")
+ (directory "/root")
+ (shell "/bin/sh"))
+ (password-entry
+ (name "charlie")
+ (uid 1000) (gid 998)
+ (real-name "Charlie")
+ (directory "/home/charlie")
+ (shell "/bin/sh")))
+ port))))
-(test-equal "read-group + write-group"
- %group-sample
- (call-with-output-string
- (lambda (port)
- (write-group (call-with-input-string %group-sample
- read-group)
- port))))
+ (test-equal "read-passwd + write-passwd"
+ #$%passwd-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-passwd (call-with-input-string #$%passwd-sample
+ read-passwd)
+ port))))
-(test-equal "write-shadow"
- %shadow-sample
- (call-with-output-string
- (lambda (port)
- (write-shadow (list (shadow-entry
- (name "root")
- (password (crypt "secret" "$6$abc"))
- (last-change 17169))
- (shadow-entry
- (name "charlie")
- (password (crypt "hey!" "$6$abc"))
- (last-change 17169))
- (shadow-entry
- (name "nobody")))
- port))))
+ (test-equal "write-group"
+ #$%group-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-group (list (group-entry
+ (name "root") (gid 0))
+ (group-entry
+ (name "wheel") (gid 999)
+ (members '("alice" "bob")))
+ (group-entry
+ (name "hackers") (gid 65000)
+ (members '("alice" "charlie"))))
+ port))))
-(test-equal "read-shadow + write-shadow"
- %shadow-sample
- (call-with-output-string
- (lambda (port)
- (write-shadow (call-with-input-string %shadow-sample
- read-shadow)
- port))))
+ (test-equal "read-group + write-group"
+ #$%group-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-group (call-with-input-string #$%group-sample
+ read-group)
+ port))))
-\f
-(define allocate-groups (@@ (gnu build accounts) allocate-groups))
-(define allocate-passwd (@@ (gnu build accounts) allocate-passwd))
+ (test-equal "write-shadow"
+ #$%shadow-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-shadow (list (shadow-entry
+ (name "root")
+ (password (crypt "secret" "$6$abc"))
+ (last-change 17169))
+ (shadow-entry
+ (name "charlie")
+ (password (crypt "hey!" "$6$abc"))
+ (last-change 17169))
+ (shadow-entry
+ (name "nobody")))
+ port))))
+
+ (test-equal "read-shadow + write-shadow"
+ #$%shadow-sample
+ (call-with-output-string
+ (lambda (port)
+ (write-shadow (call-with-input-string #$%shadow-sample
+ read-shadow)
+ port))))
+
+ (define allocate-groups (@@ (gnu build accounts) allocate-groups))
+ (define allocate-passwd (@@ (gnu build accounts) allocate-passwd))
+
+ (test-equal "allocate-groups"
+ ;; Allocate GIDs in a stateless fashion.
+ (list (group-entry (name "s") (gid %system-id-max))
+ (group-entry (name "x") (gid 900))
+ (group-entry (name "t") (gid 899))
+ (group-entry (name "a") (gid %id-min) (password "foo")
+ (members '("alice" "bob")))
+ (group-entry (name "b") (gid (+ %id-min 1))
+ (members '("charlie"))))
+ (allocate-groups (list (user-group (name "s") (system? #t))
+ (user-group (name "x") (id 900))
+ (user-group (name "t") (system? #t))
+ (user-group (name "a") (password "foo"))
+ (user-group (name "b")))
+ (alist->vhash `(("a" . "bob")
+ ("a" . "alice")
+ ("b" . "charlie")))))
-(test-equal "allocate-groups"
- ;; Allocate GIDs in a stateless fashion.
- (list (group-entry (name "s") (gid %system-id-max))
- (group-entry (name "x") (gid 900))
- (group-entry (name "t") (gid 899))
- (group-entry (name "a") (gid %id-min) (password "foo")
- (members '("alice" "bob")))
- (group-entry (name "b") (gid (+ %id-min 1))
- (members '("charlie"))))
- (allocate-groups (list (user-group (name "s") (system? #t))
- (user-group (name "x") (id 900))
- (user-group (name "t") (system? #t))
- (user-group (name "a") (password "foo"))
- (user-group (name "b")))
- (alist->vhash `(("a" . "bob")
- ("a" . "alice")
- ("b" . "charlie")))))
+ (test-equal "allocate-groups with requested GIDs"
+ ;; Make sure the requested GID for "b" is honored.
+ (list (group-entry (name "a") (gid (+ 1 %id-min)))
+ (group-entry (name "b") (gid %id-min))
+ (group-entry (name "c") (gid (+ 2 %id-min))))
+ (allocate-groups (list (user-group (name "a"))
+ (user-group (name "b") (id %id-min))
+ (user-group (name "c")))
+ vlist-null))
-(test-equal "allocate-groups with requested GIDs"
- ;; Make sure the requested GID for "b" is honored.
- (list (group-entry (name "a") (gid (+ 1 %id-min)))
- (group-entry (name "b") (gid %id-min))
- (group-entry (name "c") (gid (+ 2 %id-min))))
- (allocate-groups (list (user-group (name "a"))
- (user-group (name "b") (id %id-min))
- (user-group (name "c")))
- vlist-null))
+ (test-equal "allocate-groups with previous state"
+ ;; Make sure bits of state are preserved: password, GID, no reuse of
+ ;; previously-used GIDs.
+ (list (group-entry (name "s") (gid (- %system-id-max 1)))
+ (group-entry (name "t") (gid (- %system-id-max 2)))
+ (group-entry (name "a") (gid 30000) (password #f)
+ (members '("alice" "bob")))
+ (group-entry (name "b") (gid 30001) (password "bar")
+ (members '("charlie"))))
+ (allocate-groups (list (user-group (name "s") (system? #t))
+ (user-group (name "t") (system? #t))
+ (user-group (name "a") (password "foo"))
+ (user-group (name "b")))
+ (alist->vhash `(("a" . "bob")
+ ("a" . "alice")
+ ("b" . "charlie")))
+ (list (group-entry (name "a") (gid 30000))
+ (group-entry (name "b") (gid 30001)
+ (password "bar"))
+ (group-entry (name "removed")
+ (gid %system-id-max)))))
-(test-equal "allocate-groups with previous state"
- ;; Make sure bits of state are preserved: password, GID, no reuse of
- ;; previously-used GIDs.
- (list (group-entry (name "s") (gid (- %system-id-max 1)))
- (group-entry (name "t") (gid (- %system-id-max 2)))
- (group-entry (name "a") (gid 30000) (password #f)
- (members '("alice" "bob")))
- (group-entry (name "b") (gid 30001) (password "bar")
- (members '("charlie"))))
- (allocate-groups (list (user-group (name "s") (system? #t))
- (user-group (name "t") (system? #t))
- (user-group (name "a") (password "foo"))
- (user-group (name "b")))
- (alist->vhash `(("a" . "bob")
- ("a" . "alice")
- ("b" . "charlie")))
- (list (group-entry (name "a") (gid 30000))
- (group-entry (name "b") (gid 30001)
- (password "bar"))
- (group-entry (name "removed")
- (gid %system-id-max)))))
+ (test-equal "allocate-groups with previous state, looping"
+ ;; Check that allocation starts after the highest previously-used GID, and
+ ;; loops back to the lowest GID.
+ (list (group-entry (name "a") (gid (- %id-max 1)))
+ (group-entry (name "b") (gid %id-min))
+ (group-entry (name "c") (gid (+ 1 %id-min))))
+ (allocate-groups (list (user-group (name "a"))
+ (user-group (name "b"))
+ (user-group (name "c")))
+ vlist-null
+ (list (group-entry (name "d")
+ (gid (- %id-max 2))))))
-(test-equal "allocate-groups with previous state, looping"
- ;; Check that allocation starts after the highest previously-used GID, and
- ;; loops back to the lowest GID.
- (list (group-entry (name "a") (gid (- %id-max 1)))
- (group-entry (name "b") (gid %id-min))
- (group-entry (name "c") (gid (+ 1 %id-min))))
- (allocate-groups (list (user-group (name "a"))
- (user-group (name "b"))
- (user-group (name "c")))
- vlist-null
- (list (group-entry (name "d")
- (gid (- %id-max 2))))))
+ (test-equal "allocate-passwd"
+ ;; Allocate UIDs in a stateless fashion.
+ (list (password-entry (name "alice") (uid %id-min) (gid 1000)
+ (real-name "Alice") (shell "/bin/sh")
+ (directory "/home/alice"))
+ (password-entry (name "bob") (uid (+ 1 %id-min)) (gid 1001)
+ (real-name "Bob") (shell "/bin/gash")
+ (directory "/home/bob"))
+ (password-entry (name "sshd") (uid %system-id-max) (gid 500)
+ (real-name "sshd") (shell "/nologin")
+ (directory "/var/empty"))
+ (password-entry (name "guix") (uid 30000) (gid 499)
+ (real-name "Guix") (shell "/nologin")
+ (directory "/var/empty")))
+ (allocate-passwd (list (user-account (name "alice")
+ (comment "Alice")
+ (shell "/bin/sh")
+ (group "users"))
+ (user-account (name "bob")
+ (comment "Bob")
+ (shell "/bin/gash")
+ (group "wheel"))
+ (user-account (name "sshd") (system? #t)
+ (comment "sshd")
+ (home-directory "/var/empty")
+ (shell "/nologin")
+ (group "sshd"))
+ (user-account (name "guix") (system? #t)
+ (comment "Guix")
+ (home-directory "/var/empty")
+ (shell "/nologin")
+ (group "guix")
+ (uid 30000)))
+ (list (group-entry (name "users") (gid 1000))
+ (group-entry (name "wheel") (gid 1001))
+ (group-entry (name "sshd") (gid 500))
+ (group-entry (name "guix") (gid 499)))))
-(test-equal "allocate-passwd"
- ;; Allocate UIDs in a stateless fashion.
- (list (password-entry (name "alice") (uid %id-min) (gid 1000)
- (real-name "Alice") (shell "/bin/sh")
- (directory "/home/alice"))
- (password-entry (name "bob") (uid (+ 1 %id-min)) (gid 1001)
- (real-name "Bob") (shell "/bin/gash")
- (directory "/home/bob"))
- (password-entry (name "sshd") (uid %system-id-max) (gid 500)
- (real-name "sshd") (shell "/nologin")
- (directory "/var/empty"))
- (password-entry (name "guix") (uid 30000) (gid 499)
- (real-name "Guix") (shell "/nologin")
- (directory "/var/empty")))
- (allocate-passwd (list (user-account (name "alice")
- (comment "Alice")
- (shell "/bin/sh")
- (group "users"))
- (user-account (name "bob")
- (comment "Bob")
- (shell "/bin/gash")
- (group "wheel"))
- (user-account (name "sshd") (system? #t)
- (comment "sshd")
- (home-directory "/var/empty")
- (shell "/nologin")
- (group "sshd"))
- (user-account (name "guix") (system? #t)
- (comment "Guix")
- (home-directory "/var/empty")
- (shell "/nologin")
- (group "guix")
- (uid 30000)))
- (list (group-entry (name "users") (gid 1000))
- (group-entry (name "wheel") (gid 1001))
- (group-entry (name "sshd") (gid 500))
- (group-entry (name "guix") (gid 499)))))
+ (test-equal "allocate-passwd with previous state"
+ ;; Make sure bits of state are preserved: UID, no reuse of previously-used
+ ;; UIDs, and shell.
+ (list (password-entry (name "alice") (uid 1234) (gid 1000)
+ (real-name "Alice Smith") (shell "/bin/sh")
+ (directory "/home/alice"))
+ (password-entry (name "charlie") (uid 1236) (gid 1000)
+ (real-name "Charlie") (shell "/bin/sh")
+ (directory "/home/charlie")))
+ (allocate-passwd (list (user-account (name "alice")
+ (comment "Alice")
+ (shell "/bin/sh") ;honored
+ (group "users"))
+ (user-account (name "charlie")
+ (comment "Charlie")
+ (shell "/bin/sh")
+ (group "users")))
+ (list (group-entry (name "users") (gid 1000)))
+ (list (password-entry (name "alice") (uid 1234) (gid 9999)
+ (real-name "Alice Smith")
+ (shell "/gnu/.../bin/gash") ;ignored
+ (directory "/home/alice"))
+ (password-entry (name "bob") (uid 1235) (gid 1001)
+ (real-name "Bob") (shell "/bin/sh")
+ (directory "/home/bob")))))
-(test-equal "allocate-passwd with previous state"
- ;; Make sure bits of state are preserved: UID, no reuse of previously-used
- ;; UIDs, and shell.
- (list (password-entry (name "alice") (uid 1234) (gid 1000)
- (real-name "Alice Smith") (shell "/bin/sh")
- (directory "/home/alice"))
- (password-entry (name "charlie") (uid 1236) (gid 1000)
- (real-name "Charlie") (shell "/bin/sh")
- (directory "/home/charlie")))
- (allocate-passwd (list (user-account (name "alice")
- (comment "Alice")
- (shell "/bin/sh") ;honored
- (group "users"))
- (user-account (name "charlie")
- (comment "Charlie")
- (shell "/bin/sh")
- (group "users")))
- (list (group-entry (name "users") (gid 1000)))
- (list (password-entry (name "alice") (uid 1234) (gid 9999)
- (real-name "Alice Smith")
- (shell "/gnu/.../bin/gash") ;ignored
- (directory "/home/alice"))
- (password-entry (name "bob") (uid 1235) (gid 1001)
- (real-name "Bob") (shell "/bin/sh")
- (directory "/home/bob")))))
+ (test-equal "user+group-databases"
+ ;; The whole shebang.
+ (list (list (group-entry (name "a") (gid %id-min)
+ (members '("bob")))
+ (group-entry (name "b") (gid (+ 1 %id-min))
+ (members '("alice")))
+ (group-entry (name "s") (gid %system-id-max)))
+ (list (password-entry (name "alice") (real-name "Alice")
+ (uid %id-min) (gid %id-min)
+ (directory "/a"))
+ (password-entry (name "bob") (real-name "Bob")
+ (uid (+ 1 %id-min)) (gid (+ 1 %id-min))
+ (directory "/b"))
+ (password-entry (name "nobody")
+ (uid 65534) (gid %system-id-max)
+ (directory "/var/empty")))
+ (list (shadow-entry (name "alice") (last-change 100)
+ (password (crypt "initial pass" "$6$")))
+ (shadow-entry (name "bob") (last-change 50)
+ (password (crypt "foo" "$6$")))
+ (shadow-entry (name "nobody") (last-change 100))))
+ (call-with-values
+ (lambda ()
+ (user+group-databases (list (user-account
+ (name "alice")
+ (comment "Alice")
+ (home-directory "/a")
+ (group "a")
+ (supplementary-groups '("b"))
+ (password (crypt "initial pass" "$6$")))
+ (user-account
+ (name "bob")
+ (comment "Bob")
+ (home-directory "/b")
+ (group "b")
+ (supplementary-groups '("a")))
+ (user-account
+ (name "nobody")
+ (group "s")
+ (uid 65534)
+ (home-directory "/var/empty")))
+ (list (user-group (name "a"))
+ (user-group (name "b"))
+ (user-group (name "s") (system? #t)))
+ #:current-passwd '()
+ #:current-shadow
+ (list (shadow-entry (name "bob")
+ (password (crypt "foo" "$6$"))
+ (last-change 50)))
+ #:current-groups '()
+ #:current-time
+ (lambda (type)
+ (make-time type 0 (* 24 3600 100)))))
+ list))
+ (test-end "accounts")
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-(test-equal "user+group-databases"
- ;; The whole shebang.
- (list (list (group-entry (name "a") (gid %id-min)
- (members '("bob")))
- (group-entry (name "b") (gid (+ 1 %id-min))
- (members '("alice")))
- (group-entry (name "s") (gid %system-id-max)))
- (list (password-entry (name "alice") (real-name "Alice")
- (uid %id-min) (gid %id-min)
- (directory "/a"))
- (password-entry (name "bob") (real-name "Bob")
- (uid (+ 1 %id-min)) (gid (+ 1 %id-min))
- (directory "/b"))
- (password-entry (name "nobody")
- (uid 65534) (gid %system-id-max)
- (directory "/var/empty")))
- (list (shadow-entry (name "alice") (last-change 100)
- (password (crypt "initial pass" "$6$")))
- (shadow-entry (name "bob") (last-change 50)
- (password (crypt "foo" "$6$")))
- (shadow-entry (name "nobody") (last-change 100))))
- (call-with-values
- (lambda ()
- (user+group-databases (list (user-account
- (name "alice")
- (comment "Alice")
- (home-directory "/a")
- (group "a")
- (supplementary-groups '("b"))
- (password (crypt "initial pass" "$6$")))
- (user-account
- (name "bob")
- (comment "Bob")
- (home-directory "/b")
- (group "b")
- (supplementary-groups '("a")))
- (user-account
- (name "nobody")
- (group "s")
- (uid 65534)
- (home-directory "/var/empty")))
- (list (user-group (name "a"))
- (user-group (name "b"))
- (user-group (name "s") (system? #t)))
- #:current-passwd '()
- #:current-shadow
- (list (shadow-entry (name "bob")
- (password (crypt "foo" "$6$"))
- (last-change 50)))
- #:current-groups '()
- #:current-time
- (lambda (type)
- (make-time type 0 (* 24 3600 100)))))
- list))
+ (gexp->derivation "accounts-test" test))
-(test-end "accounts")
+(define %test-accounts
+ (unit-test
+ (name "accounts")
+ (description "Run the accounts unit tests.")
+ (value (run-accounts-test))))
diff --git a/unit-tests.scm b/unit-tests.scm
new file mode 100644
index 0000000000..2c4474b19d
--- /dev/null
+++ b/unit-tests.scm
@@ -0,0 +1,69 @@
+(define-module (unit-tests)
+ #:use-module (guix gexp)
+ #:use-module (guix diagnostics)
+ #:use-module (guix records)
+ #:use-module ((guix ui) #:select (warn-about-load-error))
+ #:use-module (guix discovery)
+ #:use-module (srfi srfi-9 gnu)
+ #:use-module (ice-9 match)
+ #:export (unit-test
+ unit-test?
+ unit-test-name
+ unit-test-value
+ unit-test-description
+ unit-test-location
+
+ fold-unit-tests
+ all-unit-tests))
+
+\f
+;;;
+;;; Unit tests.
+;;;
+
+(define-record-type* <unit-test> unit-test make-unit-test
+ unit-test?
+ (name unit-test-name) ;string
+ (value unit-test-value) ;%STORE-MONAD value
+ (description unit-test-description) ;string
+ (location unit-test-location (innate) ;<location>
+ (default (and=> (current-source-location)
+ source-properties->location))))
+
+(define (write-unit-test test port)
+ (match test
+ (($ <unit-test> name _ _ ($ <location> file line))
+ (format port "#<unit-test ~a ~a:~a ~a>"
+ name file line
+ (number->string (object-address test) 16)))
+ (($ <unit-test> name)
+ (format port "#<unit-test ~a ~a>" name
+ (number->string (object-address test) 16)))))
+
+(set-record-type-printer! <unit-test> write-unit-test)
+
+(define-gexp-compiler (compile-unit-test (test <unit-test>)
+ unit target)
+ "Compile TEST to a derivation."
+ ;; XXX: UNIT and TARGET are ignored.
+ (unit-test-value test))
+
+(define (test-modules)
+ "Return the list of modules that define unit tests."
+ (scheme-modules (dirname (search-path %load-path "guix.scm"))
+ "tests"
+ #:warn warn-about-load-error))
+
+(define (fold-unit-tests proc seed)
+ "Invoke PROC on each unit test, passing it the test and the previous
+result."
+ (fold-module-public-variables (lambda (obj result)
+ (if (unit-test? obj)
+ (cons obj result)
+ result))
+ '()
+ (test-modules)))
+
+(define (all-unit-tests)
+ "Return the list of unit tests."
+ (reverse (fold-unit-tests cons '())))
--
2.32.0
^ permalink raw reply related [flat|nested] 7+ messages in thread* [bug#49981] wip: Introduce unit-tests.
2021-08-10 15:04 [bug#49981] wip: Introduce unit-tests Mathieu Othacehe
@ 2021-08-10 18:15 ` Christopher Baines
2021-08-12 14:50 ` Mathieu Othacehe
2021-08-10 18:23 ` Maxime Devos
` (2 subsequent siblings)
3 siblings, 1 reply; 7+ messages in thread
From: Christopher Baines @ 2021-08-10 18:15 UTC (permalink / raw)
To: Mathieu Othacehe; +Cc: 49981
Mathieu Othacehe <othacehe@gnu.org> writes:
> I would like to convert the Guix tests in the "tests/" directory to
> derivations, in the exact same way as for the system tests in the
> "gnu/tests/" directory.
>
> For that, I propose to introduce a new <unit-test> record. This would
> allow us to select all the unit tests using the "all-unit-tests"
> procedure, and add them to the (gnu ci) module.
>
> This way, we could have a Cuirass specification for the unit tests, as
> we already have for the system tests, to spot regressions early on.
>
> Here's a patch that translates the "account.scm" test module to the new
> proposed mechanism. If there are no objections, I plan to convert all
> the remaining tests.
Running the tests in an automated manor would be good, but I am
concerned about the ramifications of converting them to be defined like
the system tests.
I think it's already possible to effectively run the tests for an
arbitrary commit by building (current-guix) or similar. That runs all
the tests, maybe a similar approach could be found that runs individual
tests or runs them in groups.
Converting the tests themselves in to things that have to be put in the
store to be run could make local development harder, and is a step
towards making guix harder to package and distribute. As an example, it
would probably be possible for the Debian package to continue running
the tests, but I'd expect that having to run a guix-daemon just to be
able to setup for the tests will make running them more difficult.
Chris
^ permalink raw reply [flat|nested] 7+ messages in thread* [bug#49981] wip: Introduce unit-tests.
2021-08-10 18:15 ` Christopher Baines
@ 2021-08-12 14:50 ` Mathieu Othacehe
0 siblings, 0 replies; 7+ messages in thread
From: Mathieu Othacehe @ 2021-08-12 14:50 UTC (permalink / raw)
To: Christopher Baines; +Cc: 49981
Hello Chris,
> Converting the tests themselves in to things that have to be put in the
> store to be run could make local development harder, and is a step
> towards making guix harder to package and distribute. As an example, it
> would probably be possible for the Debian package to continue running
> the tests, but I'd expect that having to run a guix-daemon just to be
> able to setup for the tests will make running them more difficult.
That's a valid objection. Regarding the "current-guix" package, it
builds the unit tests as a whole and it would be hard to extract
precisely the result of each individual test.
As almost everything else in Guix is somehow a derivation, it would be
easier for Cuirass to deal with the unit tests under that format. Maybe
we would need to find a way to be able to run them under the actual
form, as well as under a derivation format. This needs more thoughts
though, so I'll put that on hold.
Thanks for the feedback,
Mathieu
^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#49981] wip: Introduce unit-tests.
2021-08-10 15:04 [bug#49981] wip: Introduce unit-tests Mathieu Othacehe
2021-08-10 18:15 ` Christopher Baines
@ 2021-08-10 18:23 ` Maxime Devos
2021-08-30 20:14 ` Maxim Cournoyer
2021-08-31 6:36 ` zimoun
3 siblings, 0 replies; 7+ messages in thread
From: Maxime Devos @ 2021-08-10 18:23 UTC (permalink / raw)
To: Mathieu Othacehe, 49981
[-- Attachment #1: Type: text/plain, Size: 528 bytes --]
Mathieu Othacehe schreef op di 10-08-2021 om 17:04 [+0200]:
> Hello,
>
> I would like to convert the Guix tests in the "tests/" directory to
> derivations, in the exact same way as for the system tests in the
> "gnu/tests/" directory.
>
> For that, I propose to introduce a new <unit-test> record. This would
> allow us to select all the unit tests using the "all-unit-tests"
> procedure, and add them to the (gnu ci) module.
Does "make check" still work, even if no guix daemon is running?
Greetings,
Maxime.
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#49981] wip: Introduce unit-tests.
2021-08-10 15:04 [bug#49981] wip: Introduce unit-tests Mathieu Othacehe
2021-08-10 18:15 ` Christopher Baines
2021-08-10 18:23 ` Maxime Devos
@ 2021-08-30 20:14 ` Maxim Cournoyer
2021-08-31 6:27 ` zimoun
2021-08-31 6:36 ` zimoun
3 siblings, 1 reply; 7+ messages in thread
From: Maxim Cournoyer @ 2021-08-30 20:14 UTC (permalink / raw)
To: Mathieu Othacehe; +Cc: 49981
Hi Mathieu,
Mathieu Othacehe <othacehe@gnu.org> writes:
> Hello,
>
> I would like to convert the Guix tests in the "tests/" directory to
> derivations, in the exact same way as for the system tests in the
> "gnu/tests/" directory.
Perhaps it's because I spent some effort into improving our (srfi
srfi-64) based test runner, but I have some reserves about the proposed
change, that echoes what Chris and others have mentioned.
1. More in the way between the tests and the code, which may complicate
test debugging. Unit tests are supposed to involve as little as
possible, ideally; getting the daemon and the store for even the most
trivial tests seems undesirable.
2. One gripe that I have for the check-system tests is that for flaky
tests, if they pass, the success is cached (it's a derivation) and
there's no easy way to re-run them. I wouldn't want that property to
now apply to unit tests as well.
> For that, I propose to introduce a new <unit-test> record. This would
> allow us to select all the unit tests using the "all-unit-tests"
> procedure, and add them to the (gnu ci) module.
I'm not sure if that's a convenient API for the CI, but our unit test
runner has had the [--select=REGEXP] and [--exclude=REGEXP] command line
switches for a while, that provides the ability to select or exclude
specific tests (at their individual level).
> This way, we could have a Cuirass specification for the unit tests, as
> we already have for the system tests, to spot regressions early on.
Is there something with the current scheme that prevents us from doing
so already?
> Here's a patch that translates the "account.scm" test module to the new
> proposed mechanism. If there are no objections, I plan to convert all
> the remaining tests.
I guess mine is an objection :-). But with more explanations perhaps I
can better understand things.
Thanks,
Maxim
^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#49981] wip: Introduce unit-tests.
2021-08-30 20:14 ` Maxim Cournoyer
@ 2021-08-31 6:27 ` zimoun
0 siblings, 0 replies; 7+ messages in thread
From: zimoun @ 2021-08-31 6:27 UTC (permalink / raw)
To: Maxim Cournoyer, Mathieu Othacehe; +Cc: 49981
Hi,
On Mon, 30 Aug 2021 at 16:14, Maxim Cournoyer <maxim.cournoyer@gmail.com> wrote:
> 2. One gripe that I have for the check-system tests is that for flaky
> tests, if they pass, the success is cached (it's a derivation) and
> there's no easy way to re-run them. I wouldn't want that property to
> now apply to unit tests as well.
Well, maybe all these derivations could be garbage collected at the end
of the tests. But then, local development will hit bug#24937 [1] about
GC performances.
1: <http://issues.guix.gnu.org/issue/24937>
Cheers,
simon
^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#49981] wip: Introduce unit-tests.
2021-08-10 15:04 [bug#49981] wip: Introduce unit-tests Mathieu Othacehe
` (2 preceding siblings ...)
2021-08-30 20:14 ` Maxim Cournoyer
@ 2021-08-31 6:36 ` zimoun
3 siblings, 0 replies; 7+ messages in thread
From: zimoun @ 2021-08-31 6:36 UTC (permalink / raw)
To: Mathieu Othacehe, 49981
Hi Mathieu,
On Tue, 10 Aug 2021 at 17:04, Mathieu Othacehe <othacehe@gnu.org> wrote:
> This way, we could have a Cuirass specification for the unit tests, as
> we already have for the system tests, to spot regressions early on.
Yeah it could be cool! :-)
> Here's a patch that translates the "account.scm" test module to the new
> proposed mechanism. If there are no objections, I plan to convert all
> the remaining tests.
I miss if “make check TESTS="tests/account.scm"” still works and then
where the log is located.
Cheers,
simon
^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2021-08-31 7:04 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2021-08-10 15:04 [bug#49981] wip: Introduce unit-tests Mathieu Othacehe
2021-08-10 18:15 ` Christopher Baines
2021-08-12 14:50 ` Mathieu Othacehe
2021-08-10 18:23 ` Maxime Devos
2021-08-30 20:14 ` Maxim Cournoyer
2021-08-31 6:27 ` zimoun
2021-08-31 6:36 ` zimoun
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).