Package: guix-patches;
Reported by: Mathieu Othacehe <othacehe <at> gnu.org>
Date: Tue, 10 Aug 2021 15:05:02 UTC
Severity: normal
Done: Mathieu Othacehe <mathieu <at> meije.i-did-not-set--mail-host-address--so-tickle-me>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 49981 in the body.
You can then email your comments to 49981 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#49981; Package guix-patches.
(Tue, 10 Aug 2021 15:05:02 GMT) Full text and rfc822 format available.Mathieu Othacehe <othacehe <at> gnu.org>:guix-patches <at> gnu.org.
(Tue, 10 Aug 2021 15:05:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <othacehe <at> gnu.org> To: guix-patches <at> gnu.org Subject: wip: Introduce unit-tests. Date: Tue, 10 Aug 2021 17:04:20 +0200
[Message part 1 (text/plain, inline)]
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
[0001-wip-Introduce-unit-tests.patch (text/x-patch, inline)]
From eecedc74d8a3fa1a4dc1b99879def3571c9667cf Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe <at> 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 <at> 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"))
-(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))))
-
-(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))
+
+
+;;;
+;;; 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
guix-patches <at> gnu.org:bug#49981; Package guix-patches.
(Tue, 10 Aug 2021 18:16:02 GMT) Full text and rfc822 format available.Message #8 received at 49981 <at> debbugs.gnu.org (full text, mbox):
From: Christopher Baines <mail <at> cbaines.net> To: Mathieu Othacehe <othacehe <at> gnu.org> Cc: 49981 <at> debbugs.gnu.org Subject: Re: [bug#49981] wip: Introduce unit-tests. Date: Tue, 10 Aug 2021 19:15:38 +0100
Mathieu Othacehe <othacehe <at> 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
guix-patches <at> gnu.org:bug#49981; Package guix-patches.
(Tue, 10 Aug 2021 18:24:02 GMT) Full text and rfc822 format available.Message #11 received at 49981 <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: Mathieu Othacehe <othacehe <at> gnu.org>, 49981 <at> debbugs.gnu.org Subject: Re: [bug#49981] wip: Introduce unit-tests. Date: Tue, 10 Aug 2021 20:23:29 +0200
[Message part 1 (text/plain, inline)]
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.
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#49981; Package guix-patches.
(Thu, 12 Aug 2021 14:52:02 GMT) Full text and rfc822 format available.Message #14 received at 49981 <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <othacehe <at> gnu.org> To: Christopher Baines <mail <at> cbaines.net> Cc: 49981 <at> debbugs.gnu.org Subject: Re: [bug#49981] wip: Introduce unit-tests. Date: Thu, 12 Aug 2021 16:50:56 +0200
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
guix-patches <at> gnu.org:bug#49981; Package guix-patches.
(Mon, 30 Aug 2021 20:15:02 GMT) Full text and rfc822 format available.Message #17 received at 49981 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: Mathieu Othacehe <othacehe <at> gnu.org> Cc: 49981 <at> debbugs.gnu.org Subject: Re: bug#49981: wip: Introduce unit-tests. Date: Mon, 30 Aug 2021 16:14:07 -0400
Hi Mathieu, Mathieu Othacehe <othacehe <at> 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
guix-patches <at> gnu.org:bug#49981; Package guix-patches.
(Tue, 31 Aug 2021 06:34:01 GMT) Full text and rfc822 format available.Message #20 received at 49981 <at> debbugs.gnu.org (full text, mbox):
From: zimoun <zimon.toutoune <at> gmail.com> To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org> Cc: 49981 <at> debbugs.gnu.org Subject: Re: [bug#49981] wip: Introduce unit-tests. Date: Tue, 31 Aug 2021 08:27:54 +0200
Hi, On Mon, 30 Aug 2021 at 16:14, Maxim Cournoyer <maxim.cournoyer <at> 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
guix-patches <at> gnu.org:bug#49981; Package guix-patches.
(Tue, 31 Aug 2021 07:04:01 GMT) Full text and rfc822 format available.Message #23 received at 49981 <at> debbugs.gnu.org (full text, mbox):
From: zimoun <zimon.toutoune <at> gmail.com> To: Mathieu Othacehe <othacehe <at> gnu.org>, 49981 <at> debbugs.gnu.org Subject: Re: [bug#49981] wip: Introduce unit-tests. Date: Tue, 31 Aug 2021 08:36:25 +0200
Hi Mathieu, On Tue, 10 Aug 2021 at 17:04, Mathieu Othacehe <othacehe <at> 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
Mathieu Othacehe <mathieu <at> meije.i-did-not-set--mail-host-address--so-tickle-me>
to control <at> debbugs.gnu.org.
(Tue, 05 Oct 2021 08:28:01 GMT) Full text and rfc822 format available.Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Tue, 02 Nov 2021 11:24:08 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.