44 lines
2.7 KiB
Common Lisp
44 lines
2.7 KiB
Common Lisp
;;;; Read a backup, migrate ONLY an isolated model, and exercise all Head/Activity pairs.
|
|
(require :asdf)
|
|
(asdf:initialize-output-translations
|
|
'(:output-translations ("/home/adan/code/common-lisp/lime/" "/tmp/lime-working-arrangements/fasl/") :inherit-configuration))
|
|
(asdf:load-asd (truename (merge-pathnames "../lime.asd" *load-truename*)))
|
|
(asdf:load-system "lime/x11")
|
|
(let* ((*read-eval* nil)
|
|
(path (first (uiop:command-line-arguments)))
|
|
(data (with-open-file (stream path) (read stream)))
|
|
(before (getf data :world))
|
|
(world (lime.x11::%validate-session-envelope data))
|
|
(after (lime.persistence:snapshot-world world))
|
|
(pairs 0))
|
|
(dolist (key '(:clients :activities :views :viewsets :heads))
|
|
(assert (equalp (getf before key) (getf after key)) () "Migration changed ~S." key))
|
|
(dolist (h (getf before :heads))
|
|
(let ((id (getf h :active)))
|
|
(assert (equalp (find id (getf before :presentations) :key (lambda (p) (getf p :id)) :test #'equal)
|
|
(find id (getf after :presentations) :key (lambda (p) (getf p :id)) :test #'equal))
|
|
() "Migration changed an active arrangement.")))
|
|
(lime.core:normalize-activity-arrangements world)
|
|
(assert (equalp after (lime.persistence:snapshot-world world)))
|
|
(dolist (h (getf after :heads))
|
|
(dolist (a (getf after :activities))
|
|
(let* ((copy (lime.persistence:restore-world after))
|
|
(head (getf h :id))
|
|
(others (loop for p being the hash-values of (lime.core::world-presentations copy)
|
|
when (and (lime.core:presentation-active-p copy p)
|
|
(not (equal head (lime.core:presentation-head-id p))))
|
|
collect (list (lime.core:presentation-id p)
|
|
(lime.core:presentation-leased-client-ids copy p)))))
|
|
(assert (lime.core:activation-report-ready-p
|
|
(lime.core:preflight-activity-draft copy head (getf a :id))))
|
|
(lime.core:open-activity-draft copy head (getf a :id))
|
|
(dolist (row others)
|
|
(let ((p (lime.core:find-presentation copy (first row))))
|
|
(assert (lime.core:presentation-active-p copy p))
|
|
(assert (equal (second row) (lime.core:presentation-leased-client-ids copy p)))))
|
|
(lime.core:validate-world copy)
|
|
(incf pairs))))
|
|
(format t "~&Migration copy verified: ~D clients, ~D saved views, ~D -> ~D live arrangements; ~D independent switches checked. Active arrangements unchanged.~%"
|
|
(length (getf after :clients)) (length (getf after :views))
|
|
(length (getf before :presentations)) (length (getf after :presentations)) pairs))
|