diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-10 12:37:21 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-10 12:37:21 -0700 |
commit | 91929df713ce578ffc3f7de14eeca7688430d696 (patch) | |
tree | 69a7bfe83931880345b73caf936e24fccda4535a | |
parent | 2d0153e65f6439ac593ae48fd92de95af09dc5f0 (diff) | |
download | consfigurator-91929df713ce578ffc3f7de14eeca7688430d696.tar.gz |
shallow copy host in a few more places to preserve consfig values
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r-- | src/deployment.lisp | 13 |
1 files changed, 9 insertions, 4 deletions
diff --git a/src/deployment.lisp b/src/deployment.lisp index 7b42d7a..91b46a8 100644 --- a/src/deployment.lisp +++ b/src/deployment.lisp @@ -38,8 +38,7 @@ connections in CONNECTIONS have been both normalised and preprocessed." ;; make a partial own-copy of HOST so that connections can add new pieces ;; of required prerequisite data; specifically, so that they can request ;; the source code of ASDF systems - (let ((*host* (make-instance 'host :props (host-propspec host) - :attrs (copy-list (hostattrs host))))) + (let ((*host* (shallow-copy-host host))) (connect (if (eq :local (caar connections)) connections (cons '(:local) connections)))))) @@ -55,7 +54,8 @@ DEFDEPLOY-THESE, etc., rather than calling this function directly. However, code which programmatically constructs deployments will need to call this." (%consfigure (preprocess-connections connections) (if additional-properties - (%union-propspec-into-host host additional-properties) + (%union-propspec-into-host (shallow-copy-host host) + additional-properties) host))) (defun deploy-these* (connections host &optional properties) @@ -68,7 +68,8 @@ in the same way that later entries in the list of properties specified in DEFHOST forms can override earlier entries (see DEFHOST's docstring)." (%consfigure (preprocess-connections connections) (if properties - (%replace-propspec-into-host host properties) + (%replace-propspec-into-host (shallow-copy-host host) + properties) host))) (defun continue-deploy* (remaining-connections) @@ -164,6 +165,10 @@ PROPERTIES, like DEPLOY-THESE." collect (apply #'preprocess-connection-args (ensure-cons connection)))) +(defun shallow-copy-host (host) + (make-instance 'host :props (host-propspec host) + :attrs (copy-list (hostattrs host)))) + (defun %propagate-hostattrs (host) (dolist (system (propspec-systems (host-propspec host))) (pushnew system (slot-value (host-propspec *host*) 'systems))) |