sesman-test.el (9438B)
1 ;;; sesman-test.el --- Tests for sesman -*- lexical-binding: t -*- 2 ;; 3 ;; Copyright (C) 2018, Vitalie Spinu 4 ;; Author: Vitalie Spinu 5 ;; URL: https://github.com/vspinu/sesman 6 ;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8 ;; 9 ;; This file is *NOT* part of GNU Emacs. 10 ;; 11 ;; This program is free software; you can redistribute it and/or 12 ;; modify it under the terms of the GNU General Public License as 13 ;; published by the Free Software Foundation; either version 3, or 14 ;; (at your option) any later version. 15 ;; 16 ;; This program is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19 ;; General Public License for more details. 20 ;; 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with this program; see the file COPYING. If not, write to 23 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth 24 ;; Floor, Boston, MA 02110-1301, USA. 25 ;; 26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;; 28 ;;; Commentary: 29 ;; 30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 31 ;; 32 ;;; Code: 33 34 (require 'ert) 35 (require 'sesman) 36 (require 'cl) 37 38 39 ;;; UTILS 40 41 (defmacro with-empty-sesman-vars (&rest body) 42 (declare (debug (body))) 43 `(let ((sesman-links-alist) 44 (sesman-sessions-hashmap (make-hash-table :test #'equal))) 45 ,@body)) 46 47 48 ;;; SYSTEMS 49 50 ;; A 51 (cl-defmethod sesman-start-session ((system (eql A))) 52 (let ((name (gensym "A-"))) 53 (sesman-register 'A (list name "A-stuff-1" (gensym "A-stuff-"))))) 54 55 (cl-defmethod sesman-quit-session ((system (eql A)) session) 56 (setcdr session '("[A killed]"))) 57 58 (cl-defmethod sesman-project ((system (eql A))) 59 (file-name-directory (directory-file-name default-directory))) 60 61 ;; B 62 (cl-defmethod sesman-start-session ((system (eql B))) 63 (let ((name (gensym "B-"))) 64 (sesman-register 'B 65 (list name 66 (get-buffer-create (symbol-name (gensym "B-buf-"))) 67 (get-buffer-create (symbol-name (gensym "B-buf-"))))))) 68 69 (cl-defmethod sesman-quit-session ((system (eql B)) session) 70 (mapc #'kill-buffer (cdr session))) 71 72 (cl-defmethod sesman-more-relevant-p ((_system (eql B)) session1 session2) 73 (sesman-more-recent-p (cdr session1) (cdr session2))) 74 75 (cl-defmethod sesman-project ((system (eql B))) 76 nil) 77 78 79 ;;; LIFE CYCLE 80 81 (ert-deftest sesman-start-test () 82 (with-empty-sesman-vars 83 (let ((sesman-system 'A)) 84 (sesman-start) 85 (let ((sess (sesman-sessions 'A))) 86 (should (= (length sess) 1)) 87 (should (string= (cadr (car sess)) "A-stuff-1")) 88 (sesman-start) 89 (let ((sess (sesman-sessions 'A))) 90 (should (= (length sess) 2)) 91 (should (string= (cadr (cadr sess)) "A-stuff-1"))) 92 (let ((sesman-system 'B)) 93 (sesman-start) 94 (let ((sess (sesman-sessions 'A))) 95 (should (= (length sess) 2)) 96 (should (string= (cadr (cadr sess)) "A-stuff-1"))) 97 (let ((sess (sesman-sessions 'B))) 98 (should (= (length sess) 1)) 99 (should (bufferp (cadr (car sess)))))))))) 100 101 (ert-deftest sesman-quit-test () 102 (with-empty-sesman-vars 103 104 ;; alphabetic relevance 105 (let ((sesman-system 'A)) 106 (sesman-start) 107 (let ((ses (car (sesman-sessions 'A)))) 108 (sesman-start) 109 (sesman-quit) 110 (should (= (length (sesman-sessions 'A)) 1)) 111 (should-not (string= 112 (car ses) 113 (car (sesman-current-session 'A)))))) 114 115 ;; recency relevance 116 (let ((sesman-system 'B)) 117 (sesman-start) 118 (let ((ses (car (sesman-sessions 'B)))) 119 (switch-to-buffer (cadr (sesman-start))) 120 (sesman-quit) 121 (should (= (length (sesman-sessions 'B)) 1)) 122 (should (eq 123 (car ses) 124 (car (sesman-current-session 'B)))))))) 125 126 (ert-deftest sesman-restart-test () 127 (with-empty-sesman-vars 128 (let ((sesman-system 'A)) 129 (sesman-start) 130 (sesman-start) 131 (let ((ses-name (car (sesman-current-session 'A)))) 132 (sesman-restart) 133 (should (eq (car (sesman-current-session 'A)) 134 ses-name)))))) 135 136 137 ;;; LINKING 138 (ert-deftest sesman-link-with-project-test () 139 (with-empty-sesman-vars 140 (let ((sesman-system 'A)) 141 (let ((default-directory "/path/to/project/A") 142 (other-dir "/path/to/other/project/B")) 143 (sesman-start) 144 145 (sesman-link-with-project nil (sesman-current-session 'A)) 146 (should (= (length (sesman-links 'A)) 1)) 147 (let ((lnk (car (sesman-links 'A)))) 148 (should (string= (sesman--lnk-value lnk) (file-name-directory default-directory))) 149 (should (eq (sesman--lnk-context-type lnk) 'project)) 150 (should (eq (sesman--lnk-system-name lnk) 'A))) 151 152 (sesman-link-with-project other-dir (sesman-current-session 'A)) 153 (should (= (length (sesman-links 'A)) 2)) 154 (let ((lnk (car (sesman-links 'A)))) 155 (should (string= (sesman--lnk-value lnk) other-dir)) 156 (should (eq (sesman--lnk-context-type lnk) 'project)) 157 (should (eq (sesman--lnk-system-name lnk) 'A))))) 158 159 (let ((sesman-system 'B)) 160 (let ((default-directory "/path/to/project/A") 161 (other-dir "/path/to/other/project/B")) 162 (sesman-start) 163 (should-error (sesman-link-with-project nil (sesman-current-session 'B))))))) 164 165 (ert-deftest sesman-link-with-directory-test () 166 (with-empty-sesman-vars 167 (let ((sesman-system 'A)) 168 (let ((default-directory "/path/to/project/A") 169 (other-dir "/path/to/other/project/B")) 170 (sesman-start) 171 172 (sesman-link-with-directory nil (sesman-current-session 'A)) 173 (should (= (length (sesman-links 'A)) 2)) 174 (should (= (length (sesman-links 'A nil 'directory)) 1)) 175 (let ((lnk (car (sesman-links 'A)))) 176 (should (string= (sesman--lnk-value lnk) default-directory)) 177 (should (eq (sesman--lnk-context-type lnk) 'directory)) 178 (should (eq (sesman--lnk-system-name lnk) 'A))) 179 180 (sesman-link-with-directory other-dir (sesman-current-session 'A)) 181 (should (= (length (sesman-links 'A)) 3)) 182 (should (= (length (sesman-links 'A nil 'directory)) 2)) 183 (let ((lnk (car (sesman-links 'A)))) 184 (should (string= (sesman--lnk-value lnk) other-dir)) 185 (should (eq (sesman--lnk-context-type lnk) 'directory)) 186 (should (eq (sesman--lnk-system-name lnk) 'A))))) 187 188 (let ((sesman-system 'B)) 189 (let ((default-directory "/path/to/project/B1") 190 (other-dir "/path/to/other/project/B2")) 191 (sesman-start) 192 193 (sesman-link-with-directory nil (sesman-current-session 'B)) 194 (should (= (length (sesman-links 'B)) 1)) 195 (let ((lnk (car (sesman-links 'B)))) 196 (should (string= (sesman--lnk-value lnk) default-directory)) 197 (should (eq (sesman--lnk-context-type lnk) 'directory)) 198 (should (eq (sesman--lnk-system-name lnk) 'B))))) 199 200 (should (= (length sesman-links-alist) 4)))) 201 202 (ert-deftest sesman-link-with-buffer-test () 203 (with-empty-sesman-vars 204 (let ((buf-1 (get-buffer-create "tmp-buf-1")) 205 (buf-2 (get-buffer-create "tmp-buf-2")) 206 (sesman-system 'A)) 207 (with-current-buffer buf-1 208 (let ((default-directory "/path/to/project/A") 209 (other-dir "/path/to/other/project/B")) 210 (sesman-start) 211 (sesman-link-with-buffer nil (sesman-current-session 'A)) 212 (should (= (length (sesman-links 'A)) 2)) 213 (should (= (length (sesman-links 'A nil 'project)) 1)) 214 (should (= (length (sesman-links 'A nil 'directory)) 0)) 215 (should (= (length (sesman-links 'A nil 'buffer)) 1)) 216 (let ((lnk (car (sesman-links 'A nil 'buffer)))) 217 (should (eq (sesman--lnk-value lnk) buf-1)) 218 (should (eq (sesman--lnk-context-type lnk) 'buffer)) 219 (should (eq (sesman--lnk-system-name lnk) 'A))) 220 221 (sesman-link-with-buffer buf-2 (sesman-current-session 'A)) 222 (should (= (length (sesman-links 'A)) 3)) 223 (should (= (length (sesman-links 'A nil 'buffer)) 2)) 224 (let ((lnk (car (sesman-links 'A nil 'buffer)))) 225 (should (eq (sesman--lnk-value lnk) buf-2)) 226 (should (eq (sesman--lnk-context-type lnk) 'buffer)) 227 (should (eq (sesman--lnk-system-name lnk) 'A)))) 228 229 (let ((sesman-system 'B)) 230 (let ((default-directory "/path/to/project/B1") 231 (other-dir "/path/to/other/project/B2")) 232 (sesman-start) 233 (should (= (length (sesman-links 'B nil 'buffer)) 0)) 234 (sesman-link-with-buffer nil (sesman-current-session 'B)) 235 (should (= (length (sesman-links 'B)) 2)) 236 (should (= (length (sesman-links 'B nil 'project)) 0)) 237 (should (= (length (sesman-links 'B nil 'directory)) 1)) 238 (should (= (length (sesman-links 'B nil 'buffer)) 1)) 239 (sesman-link-with-buffer buf-2 (sesman-current-session 'B)) 240 (should (= (length (sesman-links 'B nil 'buffer)) 2)) 241 (let ((lnk (car (sesman-links 'B nil 'buffer)))) 242 (should (eq (sesman--lnk-value lnk) buf-2)) 243 (should (eq (sesman--lnk-context-type lnk) 'buffer)) 244 (should (eq (sesman--lnk-system-name lnk) 'B))))))) 245 246 (should (= (length sesman-links-alist) 6)))) 247 248 249 (provide 'sesman-test) 250 251 ;;; sesman-test.el ends here