diff options
| -rw-r--r-- | consfigurator.asd | 3 | ||||
| -rw-r--r-- | debian/tests/compile-and-tests.lisp | 2 | ||||
| -rw-r--r-- | src/package.lisp | 1 | ||||
| -rw-r--r-- | src/util.lisp | 5 | ||||
| -rw-r--r-- | tests/package.lisp | 3 | ||||
| -rw-r--r-- | tests/runner.lisp | 72 |
6 files changed, 83 insertions, 3 deletions
diff --git a/consfigurator.asd b/consfigurator.asd index 8048c90..039f247 100644 --- a/consfigurator.asd +++ b/consfigurator.asd @@ -109,7 +109,8 @@ (:feature :sbcl (:require #:sb-rt)) (:feature (:not :sbcl) #:rt)) :components ((:file "tests/package") + (:file "tests/runner") (:file "tests/data/util") (:file "tests/util") (:file "tests/property/file")) - :perform (test-op (o c) (symbol-call :consfigurator/tests '#:do-tests))) + :perform (test-op (o c) (symbol-call :consfigurator/tests '#:runner))) diff --git a/debian/tests/compile-and-tests.lisp b/debian/tests/compile-and-tests.lisp index 57fe51d..b2167b1 100644 --- a/debian/tests/compile-and-tests.lisp +++ b/debian/tests/compile-and-tests.lisp @@ -11,7 +11,7 @@ ;; whether any tests failed. We have to switch the package back and forth as ;; CL-USER has no *CONSFIG*. (let ((*package* (find-package :consfigurator/tests))) - (unless (consfigurator/tests::do-tests) + (unless (consfigurator/tests::runner) (uiop:quit 2))) (fresh-line) diff --git a/src/package.lisp b/src/package.lisp index 0ea8241..3819017 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -105,6 +105,7 @@ #:unlines #:words #:unwords + #:strip-prefix #:memstr= #:define-simple-error #:plist-to-long-options diff --git a/src/util.lisp b/src/util.lisp index d123e8c..e20b113 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -72,6 +72,11 @@ (defun unwords (words) (format nil "~{~A~^ ~}" words)) +(defun strip-prefix (prefix string) + "If STRING is prefixed by PREFIX, return the rest of STRING, +otherwise return NIL." + (nth-value 1 (starts-with-subseq prefix string :return-suffix t))) + (defun memstr= (string list) (member string list :test #'string=)) diff --git a/tests/package.lisp b/tests/package.lisp index 0a303f0..fcb912c 100644 --- a/tests/package.lisp +++ b/tests/package.lisp @@ -1,5 +1,6 @@ (in-package :cl-user) (defpackage :consfigurator/tests - (:use #:cl #:consfigurator #:consfigurator.data.util #+sbcl :sb-rt #-sbcl :rtest) + (:use #:cl #:consfigurator #:consfigurator.data.util #:alexandria #:anaphora + #+sbcl :sb-rt #-sbcl :rtest) (:local-nicknames (#:file #:consfigurator.property.file))) diff --git a/tests/runner.lisp b/tests/runner.lisp new file mode 100644 index 0000000..1b7af62 --- /dev/null +++ b/tests/runner.lisp @@ -0,0 +1,72 @@ +;;; Consfigurator -- Lisp declarative configuration management system + +;;; Copyright (C) 2022 David Bremner <david@tethera.net> + +;;; This file 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, or (at your option) +;;; any later version. + +;;; This file 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 this program. If not, see <http://www.gnu.org/licenses/>. + +(in-package :consfigurator/tests) +(named-readtables:in-readtable :consfigurator) + +(defparameter *test-gnupg-fingerprint* nil + "Fingerprint of trusted gpg key usable for encryption and signing.") + +(defun first-gpg-fingerprint () + "Return the fingerprint of the first (primary) key listed by gpg. + +This is mainly useful when there is a single primary key." + (some + (lambda (line) (aand (strip-prefix "fpr:::::::::" line) + (string-trim ":" it))) + (lines (gpg '("--with-colons" "--list-keys"))))) + +(defun make-test-gnupghome () + "Create and populate *DATA-SOURCE-GNUPGHOME* for tests." + (unless (nth-value 1 (ensure-directories-exist + *data-source-gnupghome* :mode #o700)) + (error "~s already exists" *data-source-gnupghome*)) + (gpg '("--batch" "--pinentry-mode" "loopback" "--passphrase" "" "--yes" + "--quick-generate-key" "consfig@example.org (insecure!)")) + (with-open-file (stream #?"${*data-source-gnupghome*}/gpg.conf" + :direction :output) + (format stream "default-key ~a~%default-recipient-self~%" + *test-gnupg-fingerprint*))) + +(defmacro with-test-gnupg-home (base-dir &rest body) + "Set up gnupg homedir for test suite under BASE-DIR and run BODY with +*DATA-SOURCE-GNUPGHOME* and *TEST-GNUPG-FINGERPRINT* set appropriately." + `(let ((*data-source-gnupghome* (merge-pathnames #P"gnupg/" ,base-dir))) + (unwind-protect + (progn + (make-test-gnupghome) + (let ((*test-gnupg-fingerprint* (first-gpg-fingerprint))) + ,@body)) + (run-program "gpgconf" "--homedir" *data-source-gnupghome* + "--kill" "all")))) + +(defun runner () + "Run tests via (sb-)rt, with setup and teardown." + (with-local-temporary-directory (test-home) + (with-test-gnupg-home test-home + (do-tests)))) + +;;;; tests for test runner machinery +(deftest runner.0 (not *data-source-gnupghome*) nil) + +(deftest runner.1 + (count-if + (lambda (line) (string-prefix-p "pub" line)) + (lines (gpg '("--with-colons" "--list-keys")))) + 1) + +(deftest runner.2 (not *test-gnupg-fingerprint*) nil) |