[nongnu] elpa/sesman 77ca42e33c 037/100: Add tests

[ELPA Syncer]

branch: elpa/sesman
commit 77ca42e33c99997c034f70060c20fe331cbe00f8
Author: Vitalie Spinu <spinuvit@gmail.com>
Commit: Vitalie Spinu <spinuvit@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)