[PATCH consfigurator v3] DATA.ASDF:SYSTEM-VERSION-FILES support systems with version files
Russell Sim
rsl at simopolis.xyz
Mon Sep 26 21:48:13 BST 2022
Systems that use external variable files via READ-FILE-FORM or READ-FILE-LINE
in their definitions, cannot be loaded in remote lisp processes.
The defsystem expression in question look like this.
(defsystem usocket
:version (:read-file-form "version.sexp")
Loading fails because when they are executed on the remote system, it won't
have the full list of files needed to evaluate defsystem. Because the version
file will not be there. The version file is not part of the components, it's
instead stored in the ADDITIONAL-INPUT-FILES slot and declared under the
DEFINE-OP section.
Signed-off-by: Russell Sim <rsl at simopolis.xyz>
---
Now with tests!
consfigurator.asd | 1 +
src/data/asdf.lisp | 5 ++-
tests/data/asdf.lisp | 39 +++++++++++++++++++
tests/data/asdf/1-a.lisp | 0
tests/data/asdf/1-b.lisp | 0
tests/data/asdf/2-a.lisp | 0
tests/data/asdf/2-b.lisp | 0
tests/data/asdf/2-version.sexp | 1 +
.../asdf/consfigurator.fixtures.system-1.asd | 8 ++++
.../asdf/consfigurator.fixtures.system-2.asd | 10 +++++
tests/package.lisp | 3 +-
tests/runner.lisp | 19 ++++++---
12 files changed, 78 insertions(+), 8 deletions(-)
create mode 100644 tests/data/asdf.lisp
create mode 100644 tests/data/asdf/1-a.lisp
create mode 100644 tests/data/asdf/1-b.lisp
create mode 100644 tests/data/asdf/2-a.lisp
create mode 100644 tests/data/asdf/2-b.lisp
create mode 100644 tests/data/asdf/2-version.sexp
create mode 100644 tests/data/asdf/consfigurator.fixtures.system-1.asd
create mode 100644 tests/data/asdf/consfigurator.fixtures.system-2.asd
diff --git a/consfigurator.asd b/consfigurator.asd
index 21c6660..d8bfd90 100644
--- a/consfigurator.asd
+++ b/consfigurator.asd
@@ -111,6 +111,7 @@
(:feature (:not :sbcl) #:rt))
:components ((:file "tests/package")
(:file "tests/runner")
+ (:file "tests/data/asdf")
(:file "tests/data/pass")
(:file "tests/data/pgp")
(:file "tests/data/util")
diff --git a/src/data/asdf.lisp b/src/data/asdf.lisp
index ee1385c..4944cdf 100644
--- a/src/data/asdf.lisp
+++ b/src/data/asdf.lisp
@@ -54,6 +54,7 @@
(let* ((system (asdf:find-system system))
(name (asdf:component-name system))
(file (asdf:system-source-file system))
+ (define-op-files (asdf:additional-input-files 'asdf:define-op system))
(written (file-write-date file)))
(unless (string= (pathname-name file) name)
(error "Cannot upload secondary systems directly."))
@@ -80,4 +81,6 @@
when (and (not (eql system other*))
(string= name (asdf:primary-system-name other*)))
nconc (recurse other*)))))
- (values written (cons file files))))))
+ (values written (append (list file)
+ define-op-files
+ files))))))
diff --git a/tests/data/asdf.lisp b/tests/data/asdf.lisp
new file mode 100644
index 0000000..0321d80
--- /dev/null
+++ b/tests/data/asdf.lisp
@@ -0,0 +1,39 @@
+(in-package :consfigurator/tests)
+(named-readtables:in-readtable :consfigurator)
+(in-consfig "consfigurator/tests")
+
+(defun read-asdf-file-date (system)
+ (file-write-date (asdf:system-source-file (asdf:find-system system))))
+
+(defun populate-asdf-fixtures ()
+ "Invoked by test runner before data source is registered."
+ (let ((asdf:*central-registry*
+ (cons (merge-pathnames "tests/data/asdf/"
+ (pathname-directory-pathname
+ (asdf:system-source-file
+ (asdf:find-system 'consfigurator))))
+ asdf:*central-registry*)))
+ (asdf:operate 'asdf:load-op "consfigurator.fixtures.system-1")
+ (asdf:operate 'asdf:load-op "consfigurator.fixtures.system-2")))
+
+(deftest data.asdf.1
+ (multiple-value-bind (timestamp files)
+ (data.asdf::system-version-files 'consfigurator.fixtures.system-1)
+ (assert (equal timestamp
+ (read-asdf-file-date 'consfigurator.fixtures.system-1)))
+ (assert (equal '("consfigurator.fixtures.system-1.asd"
+ "1-a.lisp" "1-b.lisp")
+ (mapcar #'pathname-file files)))
+ t)
+ t)
+
+(deftest data.asdf.2
+ (multiple-value-bind (timestamp files)
+ (data.asdf::system-version-files 'consfigurator.fixtures.system-2)
+ (assert (equal timestamp
+ (read-asdf-file-date 'consfigurator.fixtures.system-2)))
+ (assert (equal '("consfigurator.fixtures.system-2.asd"
+ "2-version.sexp" "2-a.lisp" "2-b.lisp")
+ (mapcar #'pathname-file files)))
+ t)
+ t)
diff --git a/tests/data/asdf/1-a.lisp b/tests/data/asdf/1-a.lisp
new file mode 100644
index 0000000..e69de29
diff --git a/tests/data/asdf/1-b.lisp b/tests/data/asdf/1-b.lisp
new file mode 100644
index 0000000..e69de29
diff --git a/tests/data/asdf/2-a.lisp b/tests/data/asdf/2-a.lisp
new file mode 100644
index 0000000..e69de29
diff --git a/tests/data/asdf/2-b.lisp b/tests/data/asdf/2-b.lisp
new file mode 100644
index 0000000..e69de29
diff --git a/tests/data/asdf/2-version.sexp b/tests/data/asdf/2-version.sexp
new file mode 100644
index 0000000..6e0c2f3
--- /dev/null
+++ b/tests/data/asdf/2-version.sexp
@@ -0,0 +1 @@
+"0.0.1"
diff --git a/tests/data/asdf/consfigurator.fixtures.system-1.asd b/tests/data/asdf/consfigurator.fixtures.system-1.asd
new file mode 100644
index 0000000..f146442
--- /dev/null
+++ b/tests/data/asdf/consfigurator.fixtures.system-1.asd
@@ -0,0 +1,8 @@
+(defsystem "consfigurator.fixtures.system-1"
+ :description
+ "Test fixtures used by consfigurator during testing"
+ :licence "GPL-3+"
+ :serial t
+ :depends-on (#:consfigurator)
+ :components ((:file "1-a")
+ (:file "1-b")))
diff --git a/tests/data/asdf/consfigurator.fixtures.system-2.asd b/tests/data/asdf/consfigurator.fixtures.system-2.asd
new file mode 100644
index 0000000..f92e9c8
--- /dev/null
+++ b/tests/data/asdf/consfigurator.fixtures.system-2.asd
@@ -0,0 +1,10 @@
+(defsystem "consfigurator.fixtures.system-2"
+ :description
+ "Test fixtures used by consfigurator during testing, this system loads it's
+version from a file."
+ :licence "GPL-3+"
+ :serial t
+ :version (:read-file-form "2-version.sexp")
+ :depends-on (#:consfigurator)
+ :components ((:file "2-a")
+ (:file "2-b")))
diff --git a/tests/package.lisp b/tests/package.lisp
index 47f41e4..2eea1de 100644
--- a/tests/package.lisp
+++ b/tests/package.lisp
@@ -4,4 +4,5 @@
(:use #:cl #:consfigurator #:consfigurator.data.util #:alexandria #:anaphora
#+sbcl :sb-rt #-sbcl :rtest)
(:local-nicknames (#:file #:consfigurator.property.file)
- (#:data.pgp #:consfigurator.data.pgp)))
+ (#:data.pgp #:consfigurator.data.pgp)
+ (#:data.asdf #:consfigurator.data.asdf)))
diff --git a/tests/runner.lisp b/tests/runner.lisp
index aafeafa..3675c3b 100644
--- a/tests/runner.lisp
+++ b/tests/runner.lisp
@@ -18,6 +18,12 @@
(in-package :consfigurator/tests)
(named-readtables:in-readtable :consfigurator)
+(defmacro with-asdf-fixtures (&rest body)
+ "Load ASDF fixtures. There is no reversal of the changes to the lisp image."
+ `(progn
+ (populate-asdf-fixtures)
+ , at body))
+
(defparameter *test-gnupg-fingerprint* nil
"Fingerprint of trusted gpg key usable for encryption and signing.")
@@ -90,12 +96,13 @@ registered and populated."
(defun runner ()
"Run tests via (sb-)rt, with setup and teardown."
- (with-local-temporary-directory (test-home)
- (with-test-gnupg-home test-home
- (with-reset-data-sources
- (with-test-pgp-source test-home
- (with-test-pass-source test-home
- (do-tests)))))))
+ (with-asdf-fixtures
+ (with-local-temporary-directory (test-home)
+ (with-test-gnupg-home test-home
+ (with-reset-data-sources
+ (with-test-pgp-source test-home
+ (with-test-pass-source test-home
+ (do-tests))))))))
;;;; tests for test runner machinery
--
2.37.2
More information about the sgo-software-discuss
mailing list