branch: elpa/sesman
commit 77ca42e33c99997c034f70060c20fe331cbe00f8
Author: Vitalie Spinu <spinu...@gmail.com>
Commit: Vitalie Spinu <spinu...@gmail.com>
Add tests
---
Makefile | 2 +-
sesman-test.el | 211 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 212 insertions(+), 1 deletion(-)
diff --git a/Makefile b/Makefile
index 211c27f03d..1d156de0f1 100644
--- a/Makefile
+++ b/Makefile
@@ -16,7 +16,7 @@ checkdoc: version
$(EMACS) --batch --load targets/checkdoc.el
test: version
- $(EMACS) --batch --load sesman-test.el --funcall
ert-run-tests-batch-and-exit
+ $(EMACS) --batch --directory . --load sesman-test.el --funcall
ert-run-tests-batch-and-exit
version:
@echo SESMAN: $(VERSION)
diff --git a/sesman-test.el b/sesman-test.el
index a622b77d65..d9481de795 100644
--- a/sesman-test.el
+++ b/sesman-test.el
@@ -32,6 +32,217 @@
;;; Code:
(require 'ert)
+(require 'sesman)
+(require 'cl)
+
+
+;;; UTILS
+
+(defmacro with-empty-sesman-vars (&rest body)
+ (declare (debug (body)))
+ `(let ((sesman-links-alist)
+ (sesman-sessions-hashmap (make-hash-table :test #'equal)))
+ ,@body))
+
+
+;;; SYSTEMS
+
+;; A
+(cl-defmethod sesman-start-session ((system (eql A)))
+ (let ((name (gensym "A-")))
+ (sesman-register 'A (list name "A-stuff-1" (gensym "A-stuff-")))))
+
+(cl-defmethod sesman-quit-session ((system (eql A)) session)
+ (setcdr session '("[A killed]")))
+
+(cl-defmethod sesman-project ((system (eql A)))
+ (file-name-directory (directory-file-name default-directory)))
+
+;; B
+(cl-defmethod sesman-start-session ((system (eql B)))
+ (let ((name (gensym "B-")))
+ (sesman-register 'B
+ (list name
+ (get-buffer-create (symbol-name (gensym "B-buf-")))
+ (get-buffer-create (symbol-name (gensym
"B-buf-")))))))
+
+(cl-defmethod sesman-quit-session ((system (eql B)) session)
+ (mapc #'kill-buffer (cdr session)))
+
+(cl-defmethod sesman-more-relevant-p ((_system (eql B)) session1 session2)
+ (sesman-more-recent-p (cdr session1) (cdr session2)))
+
+(cl-defmethod sesman-project ((system (eql B)))
+ nil)
+
+
+;;; LIFE CYCLE
+
+(ert-deftest sesman-start-test ()
+ (with-empty-sesman-vars
+ (let ((sesman-system 'A))
+ (sesman-start)
+ (let ((sess (sesman-sessions 'A)))
+ (should (= (length sess) 1))
+ (should (string= (cadr (car sess)) "A-stuff-1"))
+ (sesman-start)
+ (let ((sess (sesman-sessions 'A)))
+ (should (= (length sess) 2))
+ (should (string= (cadr (cadr sess)) "A-stuff-1")))
+ (let ((sesman-system 'B))
+ (sesman-start)
+ (let ((sess (sesman-sessions 'A)))
+ (should (= (length sess) 2))
+ (should (string= (cadr (cadr sess)) "A-stuff-1")))
+ (let ((sess (sesman-sessions 'B)))
+ (should (= (length sess) 1))
+ (should (bufferp (cadr (car sess))))))))))
+
+(ert-deftest sesman-quit-test ()
+ (with-empty-sesman-vars
+ ;; alphabetic relevance
+ (let ((sesman-system 'A))
+ (sesman-start)
+ (let ((ses (car (sesman-sessions 'A))))
+ (sesman-start)
+ (sesman-quit)
+ (should (= (length (sesman-sessions 'A)) 1))
+ (should-not (string=
+ (car ses)
+ (car (sesman-current-session 'A))))))
+ ;; recency relevance
+ (let ((sesman-system 'B))
+ (sesman-start)
+ (let ((ses (car (sesman-sessions 'B))))
+ (switch-to-buffer (cadr (sesman-start)))
+ (sesman-quit)
+ (should (= (length (sesman-sessions 'B)) 1))
+ (should (eq
+ (car ses)
+ (car (sesman-current-session 'B))))))))
+
+(ert-deftest sesman-restart-test ()
+ (with-empty-sesman-vars
+ (let ((sesman-system 'A))
+ (sesman-start)
+ (sesman-start)
+ (let ((ses-name (car (sesman-current-session 'A))))
+ (sesman-restart)
+ (should (eq (car (sesman-current-session 'A))
+ ses-name))))))
+
+
+;;; LINKING
+(ert-deftest sesman-link-with-project-test ()
+ (with-empty-sesman-vars
+ (let ((sesman-system 'A))
+ (let ((default-directory "/path/to/project/A")
+ (other-dir "/path/to/other/project/B"))
+ (sesman-start)
+
+ (sesman-link-with-project nil (sesman-current-session 'A))
+ (should (= (length (sesman-links 'A)) 1))
+ (let ((lnk (car (sesman-links 'A))))
+ (should (string= (sesman--lnk-value lnk) (file-name-directory
default-directory)))
+ (should (eq (sesman--lnk-context-type lnk) 'project))
+ (should (eq (sesman--lnk-system-name lnk) 'A)))
+
+ (sesman-link-with-project other-dir (sesman-current-session 'A))
+ (should (= (length (sesman-links 'A)) 2))
+ (let ((lnk (car (sesman-links 'A))))
+ (should (string= (sesman--lnk-value lnk) other-dir))
+ (should (eq (sesman--lnk-context-type lnk) 'project))
+ (should (eq (sesman--lnk-system-name lnk) 'A)))))
+
+ (let ((sesman-system 'B))
+ (let ((default-directory "/path/to/project/A")
+ (other-dir "/path/to/other/project/B"))
+ (sesman-start)
+ (should-error (sesman-link-with-project nil (sesman-current-session
'B)))))))
+
+(ert-deftest sesman-link-with-directory-test ()
+ (with-empty-sesman-vars
+ (let ((sesman-system 'A))
+ (let ((default-directory "/path/to/project/A")
+ (other-dir "/path/to/other/project/B"))
+ (sesman-start)
+
+ (sesman-link-with-directory nil (sesman-current-session 'A))
+ (should (= (length (sesman-links 'A)) 2))
+ (should (= (length (sesman-links 'A nil 'directory)) 1))
+ (let ((lnk (car (sesman-links 'A))))
+ (should (string= (sesman--lnk-value lnk) default-directory))
+ (should (eq (sesman--lnk-context-type lnk) 'directory))
+ (should (eq (sesman--lnk-system-name lnk) 'A)))
+
+ (sesman-link-with-directory other-dir (sesman-current-session 'A))
+ (should (= (length (sesman-links 'A)) 3))
+ (should (= (length (sesman-links 'A nil 'directory)) 2))
+ (let ((lnk (car (sesman-links 'A))))
+ (should (string= (sesman--lnk-value lnk) other-dir))
+ (should (eq (sesman--lnk-context-type lnk) 'directory))
+ (should (eq (sesman--lnk-system-name lnk) 'A)))))
+
+ (let ((sesman-system 'B))
+ (let ((default-directory "/path/to/project/B1")
+ (other-dir "/path/to/other/project/B2"))
+ (sesman-start)
+
+ (sesman-link-with-directory nil (sesman-current-session 'B))
+ (should (= (length (sesman-links 'B)) 1))
+ (let ((lnk (car (sesman-links 'B))))
+ (should (string= (sesman--lnk-value lnk) default-directory))
+ (should (eq (sesman--lnk-context-type lnk) 'directory))
+ (should (eq (sesman--lnk-system-name lnk) 'B)))))
+
+ (should (= (length sesman-links-alist) 4))))
+
+(ert-deftest sesman-link-with-buffer-test ()
+ (with-empty-sesman-vars
+ (let ((buf-1 (get-buffer-create "tmp-buf-1"))
+ (buf-2 (get-buffer-create "tmp-buf-2"))
+ (sesman-system 'A))
+ (with-current-buffer buf-1
+ (let ((default-directory "/path/to/project/A")
+ (other-dir "/path/to/other/project/B"))
+ (sesman-start)
+ (sesman-link-with-buffer nil (sesman-current-session 'A))
+ (should (= (length (sesman-links 'A)) 2))
+ (should (= (length (sesman-links 'A nil 'project)) 1))
+ (should (= (length (sesman-links 'A nil 'directory)) 0))
+ (should (= (length (sesman-links 'A nil 'buffer)) 1))
+ (let ((lnk (car (sesman-links 'A nil 'buffer))))
+ (should (eq (sesman--lnk-value lnk) buf-1))
+ (should (eq (sesman--lnk-context-type lnk) 'buffer))
+ (should (eq (sesman--lnk-system-name lnk) 'A)))
+
+ (sesman-link-with-buffer buf-2 (sesman-current-session 'A))
+ (should (= (length (sesman-links 'A)) 3))
+ (should (= (length (sesman-links 'A nil 'buffer)) 2))
+ (let ((lnk (car (sesman-links 'A nil 'buffer))))
+ (should (eq (sesman--lnk-value lnk) buf-2))
+ (should (eq (sesman--lnk-context-type lnk) 'buffer))
+ (should (eq (sesman--lnk-system-name lnk) 'A))))
+
+ (let ((sesman-system 'B))
+ (let ((default-directory "/path/to/project/B1")
+ (other-dir "/path/to/other/project/B2"))
+ (sesman-start)
+ (should (= (length (sesman-links 'B nil 'buffer)) 0))
+ (sesman-link-with-buffer nil (sesman-current-session 'B))
+ (should (= (length (sesman-links 'B)) 2))
+ (should (= (length (sesman-links 'B nil 'project)) 0))
+ (should (= (length (sesman-links 'B nil 'directory)) 1))
+ (should (= (length (sesman-links 'B nil 'buffer)) 1))
+ (sesman-link-with-buffer buf-2 (sesman-current-session 'B))
+ (should (= (length (sesman-links 'B nil 'buffer)) 2))
+ (let ((lnk (car (sesman-links 'B nil 'buffer))))
+ (should (eq (sesman--lnk-value lnk) buf-2))
+ (should (eq (sesman--lnk-context-type lnk) 'buffer))
+ (should (eq (sesman--lnk-system-name lnk) 'B)))))))
+
+ (should (= (length sesman-links-alist) 6))))
+
(provide 'sesman-test)
