86 lines
4.5 KiB
Common Lisp
86 lines
4.5 KiB
Common Lisp
(in-package #:lime.test)
|
|
(in-suite lime-suite)
|
|
|
|
(defun make-presentation-navigation-fixture ()
|
|
(let ((w (make-world)))
|
|
(dolist (id '("left" "right" "third")) (create-head w id))
|
|
(dolist (id '("work" "chat" "other")) (create-activity w id id))
|
|
(dolist (row '(("browser" "work") ("terminal" "work") ("discord" "chat")
|
|
("hidden" "chat") ("shared" "chat")))
|
|
(create-client w (first row) (second row)))
|
|
(set-client-shared w "shared" t)
|
|
(create-view w "work/code" "work" "Code" (placements "browser"))
|
|
(create-view w "chat/chat" "chat" "Chat" (placements "discord" "shared"))
|
|
(activate-view-strictly w "left" "work/code")
|
|
(activate-view-strictly w "right" "chat/chat")
|
|
w))
|
|
|
|
(test portable-arrangement-swaps-preserve-state-and-lease-identity
|
|
(let* ((w (make-presentation-navigation-fixture))
|
|
(work (current-presentation w "left")) (chat (current-presentation w "right"))
|
|
(leases (mapcar (lambda (id) (lease-for-client w id)) '("browser" "discord" "shared")))
|
|
(view-before (lime.core::%copy-placements (view-placements (find-view w "chat/chat")))))
|
|
(set-presentation-layout-mode w (presentation-id chat) :monocle)
|
|
(let ((report (preflight-presentation-bring w "left" (presentation-id chat)))
|
|
(before (world-revision w)))
|
|
(is (activation-report-ready-p report))
|
|
(is (= before (world-revision w))))
|
|
(bring-presentation-to-head w (presentation-id chat) "left")
|
|
(is (eq chat (current-presentation w "left")))
|
|
(is (eq work (current-presentation w "right")))
|
|
(is (equal "left" (presentation-head-id chat)))
|
|
(is (equal "right" (presentation-head-id work)))
|
|
(is (eq :monocle (presentation-layout-mode chat)))
|
|
(is (presentation-dirty-p chat))
|
|
(is (equalp view-before (view-placements (find-view w "chat/chat"))))
|
|
(is (null (lease-for-client w "hidden")))
|
|
(loop for id in '("browser" "discord" "shared") for old in leases
|
|
do (is (eq old (lease-for-client w id))))
|
|
(dotimes (i 20)
|
|
(bring-presentation-to-head w (presentation-id chat) (if (evenp i) "right" "left"))
|
|
(is (validate-world w)))
|
|
(let ((revision (world-revision w)))
|
|
(bring-presentation-to-head w (presentation-id chat) "left")
|
|
(is (= revision (world-revision w))))))
|
|
|
|
(test swaps-transpose-cached-extended-portions-without-erasing-them
|
|
(let* ((w (make-presentation-navigation-fixture)) (chat (current-presentation w "right"))
|
|
(work-left (current-presentation w "left")))
|
|
(create-view w "work/logs" "work" "Logs" (placements "terminal"))
|
|
(let ((work-right (activate-view-strictly w "right" "work/logs")))
|
|
(resume-presentation-strictly w "right" (presentation-id chat))
|
|
(bring-presentation-to-head w (presentation-id chat) "left")
|
|
(is (eq work-left (current-presentation w "right")))
|
|
(is (eq work-right (activity-draft-for-head w "work" "left")))
|
|
(is (equal '("terminal") (presentation-client-ids work-right)))
|
|
(is (equal "work/logs" (presentation-source-view-id work-right)))
|
|
(is (null (lease-for-client w "terminal")))
|
|
(is (validate-world w))
|
|
(open-activity-draft w "left" "work")
|
|
(is (eq work-right (current-presentation w "left")))
|
|
(is (validate-world w)))))
|
|
|
|
(test inactive-portable-return-does-not-change-other-displays-or-recall-missing-slots
|
|
(let* ((w (make-presentation-navigation-fixture)) (chat (current-presentation w "right")))
|
|
(open-activity-draft w "right" "other")
|
|
(let ((other (current-presentation w "right")))
|
|
(bring-presentation-to-head w (presentation-id chat) "left")
|
|
(is (eq other (current-presentation w "right")))
|
|
(is (eq chat (current-presentation w "left")))
|
|
(is (null (lease-for-client w "browser")))
|
|
(is (null (lease-for-client w "hidden")))
|
|
(is (validate-world w)))
|
|
(let ((before (world-revision w)))
|
|
(signals stale-transition-plan
|
|
(bring-presentation-to-head w (presentation-id chat) "third" :expected-revision (1- before)))
|
|
(signals unknown-entity (bring-presentation-to-head w (presentation-id chat) "missing"))
|
|
(is (= before (world-revision w))))
|
|
;; A topology-suspended arrangement is still portable.
|
|
(commit-head-topology-reconciliation-plan w
|
|
(build-head-topology-reconciliation-plan
|
|
(preflight-head-topology-reconciliation w '("right" "third"))))
|
|
(is (null (presentation-head-id chat)))
|
|
(bring-presentation-to-head w (presentation-id chat) "third")
|
|
(is (eq chat (current-presentation w "third")))
|
|
(is (validate-world w))))
|