diff options
| author | Craig Jennings <c@cjennings.net> | 2025-10-20 06:47:57 -0500 |
|---|---|---|
| committer | Craig Jennings <c@cjennings.net> | 2025-10-20 06:47:57 -0500 |
| commit | 3624e82c775dcbd191d03deda0c3fa311cc6bb8a (patch) | |
| tree | dc61eae34b170ca677c2188f8a64186beeba1419 /tests | |
| parent | f3fd8886f921e3dd4560df0095828bea5b4846f8 (diff) | |
test: adding tests for compilation, keyboard macros, undead buffers
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/test-all-comp-errors.el | 254 | ||||
| -rw-r--r-- | tests/test-keyboard-macros.el | 356 | ||||
| -rw-r--r-- | tests/test-undead-buffers.el | 209 |
3 files changed, 819 insertions, 0 deletions
diff --git a/tests/test-all-comp-errors.el b/tests/test-all-comp-errors.el new file mode 100644 index 00000000..81614858 --- /dev/null +++ b/tests/test-all-comp-errors.el @@ -0,0 +1,254 @@ +;;; test-all-comp-errors.el --- ERT tests for compilation errors -*- lexical-binding: t; -*- + +;; Author: Claude Code and cjennings +;; Keywords: tests, compilation + +;;; Commentary: +;; ERT tests to check all .el files in modules/ and custom/ directories +;; for byte-compilation and native-compilation errors. +;; +;; These tests help ensure code quality by catching compilation warnings +;; and errors across the entire configuration. + +;;; Code: + +(require 'ert) +(require 'testutil-general) +(require 'bytecomp) + +;;; Configuration + +(defvar test-comp-errors-directories '("modules" "custom") + "List of directories to check for compilation errors. +Each directory path should be relative to the Emacs configuration root. +Example: '(\"modules\" \"custom\" \"libs\")") + +(defvar test-comp-errors-single-file nil + "If non-nil, test only this single file instead of all files. +Should be a relative path to a .el file (e.g., \"modules/ui-config.el\"). +Useful for debugging specific file compilation issues.") + +(defvar test-comp-errors-core-dependencies + '("modules/user-constants.el" + "modules/host-environment.el" + "modules/system-defaults.el" + "modules/keybindings.el") + "List of core dependency files to pre-load before compilation. +These files are loaded before compilation starts to reduce recursion depth. +Should be files that many other files depend on.") + +(defvar test-comp-errors-byte-compile-report-file + (expand-file-name "~/.emacs-tests-byte-compile-errors.txt") + "File path where byte-compilation error reports are written. +Only created when byte-compilation errors are detected.") + +(defvar test-comp-errors-native-compile-report-file + (expand-file-name "~/.emacs-tests-native-compile-errors.txt") + "File path where native-compilation error reports are written. +Only created when native-compilation errors are detected.") + +;;; Setup and Teardown + +(defun test-comp-errors--preload-core-dependencies () + "Pre-load core dependency files to reduce recursion during compilation. +Loads files specified in 'test-comp-errors-core-dependencies'." + ;; Ensure load-path includes modules, custom, and assets directories + (let ((user-emacs-directory (expand-file-name default-directory))) + (add-to-list 'load-path (concat user-emacs-directory "assets/")) + (add-to-list 'load-path (concat user-emacs-directory "custom/")) + (add-to-list 'load-path (concat user-emacs-directory "modules/"))) + + (let ((max-lisp-eval-depth 3000)) ; Allow depth for loading core files + (dolist (file test-comp-errors-core-dependencies) + (let ((full-path (expand-file-name file))) + (if (file-exists-p full-path) + (condition-case err + (progn + (message "Pre-loading core dependency: %s" full-path) + (load full-path nil t)) + (error + (message "Warning: Could not pre-load core dependency %s: %s" + full-path (error-message-string err)))) + (message "Warning: Core dependency file not found: %s" full-path)))))) + +(defun test-comp-errors-setup (compile-type) + "Set up test environment for compilation tests. +COMPILE-TYPE should be either 'byte or 'native." + (cj/create-test-base-dir) + (let ((subdir (format "compile-tests/%s/" (symbol-name compile-type)))) + (cj/create-test-subdirectory subdir)) + ;; Pre-load core dependencies to reduce recursion depth during compilation + (test-comp-errors--preload-core-dependencies)) + +(defun test-comp-errors-teardown () + "Clean up test environment after compilation tests." + (cj/delete-test-base-dir)) + +;;; Helper Functions + +(defun test-comp-errors--get-compile-dir (compile-type) + "Get the compilation output directory for COMPILE-TYPE ('byte or 'native)." + (expand-file-name + (format "compile-tests/%s/" (symbol-name compile-type)) + cj/test-base-dir)) + +(defun test-comp-errors--get-source-files () + "Return list of all .el files to test. +If 'test-comp-errors-single-file' is set, return only that file. +Otherwise, return all files in directories specified by 'test-comp-errors-directories'." + (if test-comp-errors-single-file + (if (file-exists-p test-comp-errors-single-file) + (list test-comp-errors-single-file) + (error "Single file does not exist: %s" test-comp-errors-single-file)) + (let ((all-files '())) + (dolist (dir test-comp-errors-directories) + (when (file-directory-p dir) + (setq all-files + (append all-files + (directory-files-recursively dir "\\.el$"))))) + all-files))) + +(defun test-comp-errors--byte-compile-file (source-file output-dir) + "Byte-compile SOURCE-FILE to OUTPUT-DIR. +Returns a list of (FILE . ERROR-MESSAGES) if errors occurred, nil otherwise." + (let* ((max-lisp-eval-depth 3000) ; Increase to handle deep dependency chains + (byte-compile-dest-file-function + (lambda (source) + (expand-file-name + (file-name-nondirectory (byte-compile-dest-file source)) + output-dir))) + (byte-compile-log-buffer (get-buffer-create "*Byte-Compile-Test-Log*")) + (errors nil)) + (with-current-buffer byte-compile-log-buffer + (erase-buffer)) + ;; Attempt compilation + (condition-case err + (progn + (byte-compile-file source-file) + ;; Check log for warnings/errors + (with-current-buffer byte-compile-log-buffer + (goto-char (point-min)) + (let ((log-content (buffer-substring-no-properties (point-min) (point-max)))) + (when (or (string-match-p "Warning:" log-content) + (string-match-p "Error:" log-content)) + (setq errors (cons source-file log-content)))))) + (error + (setq errors (cons source-file (error-message-string err))))) + errors)) + +(defun test-comp-errors--native-compile-file (source-file output-dir) + "Native-compile SOURCE-FILE to OUTPUT-DIR. +Returns a list of (FILE . ERROR-MESSAGES) if errors occurred, nil otherwise." + (if (not (and (fboundp 'native-comp-available-p) + (native-comp-available-p))) + nil ; Skip if native compilation not available + (let* ((max-lisp-eval-depth 3000) ; Increase to handle deep dependency chains + (errors nil)) + ;; Set native-compile-target-directory dynamically + ;; This variable must be dynamically bound, not lexically + (setq native-compile-target-directory output-dir) + (condition-case err + (progn + (native-compile source-file) + ;; Native compile warnings go to *Warnings* buffer + (when-let ((warnings-buf (get-buffer "*Warnings*"))) + (with-current-buffer warnings-buf + (let ((log-content (buffer-substring-no-properties (point-min) (point-max)))) + (when (and (> (length log-content) 0) + (string-match-p (regexp-quote (file-name-nondirectory source-file)) + log-content)) + (setq errors (cons source-file log-content))))))) + (error + (setq errors (cons source-file (error-message-string err))))) + errors))) + +(defun test-comp-errors--format-error-report (errors) + "Format ERRORS list into a readable report string. +ERRORS is a list of (FILE . ERROR-MESSAGES) cons cells." + (if (null errors) + "" + (let ((report (format "\n\nCompilation errors found in %d file%s:\n\n" + (length errors) + (if (= (length errors) 1) "" "s"))) + (files-only "")) + ;; First, show just the list of all affected files + (setq files-only (concat "\nAffected files (" (number-to-string (length errors)) " total):\n")) + (dolist (error-entry errors) + (setq files-only (concat files-only " - " (car error-entry) "\n"))) + (setq report (concat report files-only "\n")) + + ;; Then show detailed error messages for each file + (setq report (concat report "Detailed error messages:\n\n")) + (dolist (error-entry errors) + (let ((file (car error-entry)) + (messages (cdr error-entry))) + (setq report + (concat report + (format "%s:\n" file) + (if (stringp messages) + (mapconcat (lambda (line) + (concat " " line)) + (split-string messages "\n" t) + "\n") + messages) + "\n\n")))) + report))) + +;;; Tests + +(ert-deftest test-byte-compile-all-files () + "Check all .el files in configured directories for byte-compilation errors. +Directories are specified by 'test-comp-errors-directories'." + (test-comp-errors-setup 'byte) + (unwind-protect + (let* ((output-dir (test-comp-errors--get-compile-dir 'byte)) + (source-files (test-comp-errors--get-source-files)) + (errors '())) + ;; Compile each file and collect errors + (dolist (file source-files) + (when-let ((error (test-comp-errors--byte-compile-file file output-dir))) + (push error errors))) + ;; Kill the compile log buffer + (when-let ((buf (get-buffer "*Byte-Compile-Test-Log*"))) + (kill-buffer buf)) + ;; Write detailed error report to file for analysis (before teardown) + (when errors + (with-temp-file test-comp-errors-byte-compile-report-file + (insert (test-comp-errors--format-error-report (nreverse errors)))) + (message "Full byte-compile error report written to: %s" + test-comp-errors-byte-compile-report-file)) + ;; Assert no errors + (should (null errors))) + (test-comp-errors-teardown))) + +(ert-deftest test-native-compile-all-files () + "Check all .el files in configured directories for native-compilation errors. +Directories are specified by 'test-comp-errors-directories'." + (unless (and (fboundp 'native-comp-available-p) + (native-comp-available-p)) + (ert-skip "Native compilation not available")) + (test-comp-errors-setup 'native) + (unwind-protect + (let* ((output-dir (test-comp-errors--get-compile-dir 'native)) + (source-files (test-comp-errors--get-source-files)) + (errors '())) + ;; Clear warnings buffer + (when-let ((buf (get-buffer "*Warnings*"))) + (with-current-buffer buf + (erase-buffer))) + ;; Compile each file and collect errors + (dolist (file source-files) + (when-let ((error (test-comp-errors--native-compile-file file output-dir))) + (push error errors))) + ;; Write detailed error report to file for analysis (before teardown) + (when errors + (with-temp-file test-comp-errors-native-compile-report-file + (insert (test-comp-errors--format-error-report (nreverse errors)))) + (message "Full native-compile error report written to: %s" + test-comp-errors-native-compile-report-file)) + ;; Assert no errors + (should (null errors))) + (test-comp-errors-teardown))) + +(provide 'test-all-comp-errors) +;;; test-all-comp-errors.el ends here diff --git a/tests/test-keyboard-macros.el b/tests/test-keyboard-macros.el new file mode 100644 index 00000000..3a1ae523 --- /dev/null +++ b/tests/test-keyboard-macros.el @@ -0,0 +1,356 @@ +;;; test-keyboard-macros.el --- ERT tests for keyboard-macros -*- lexical-binding: t; -*- + +;; Author: Claude Code and cjennings +;; Keywords: tests, keyboard-macros + +;;; Commentary: +;; ERT tests for keyboard-macros.el functions. +;; Tests are organized into normal, boundary, and error cases. + +;;; Code: + +(require 'ert) +(require 'keyboard-macros) +(require 'testutil-general) + +;;; Setup and Teardown + +(defun test-keyboard-macros-setup () + "Set up test environment for keyboard-macros tests." + (cj/create-test-base-dir) + ;; Bind macros-file to test location + (setq macros-file (expand-file-name "test-macros.el" cj/test-base-dir)) + ;; Reset state flags + (setq cj/macros-loaded nil) + (setq cj/macros-loading nil) + ;; Clear any existing macro + (setq last-kbd-macro nil)) + +(defun test-keyboard-macros-teardown () + "Clean up test environment after keyboard-macros tests." + ;; Kill any buffers visiting the test macros file + (when-let ((buf (get-file-buffer macros-file))) + (kill-buffer buf)) + ;; Clean up test directory + (cj/delete-test-base-dir) + ;; Reset state + (setq cj/macros-loaded nil) + (setq cj/macros-loading nil) + (setq last-kbd-macro nil)) + +;;; Normal Cases + +(ert-deftest test-keyboard-macros-ensure-macros-loaded-first-time-normal () + "Normal: macros file is loaded on first call when file exists." + (test-keyboard-macros-setup) + (unwind-protect + (progn + ;; Create a macros file with a simple macro definition + (with-temp-file macros-file + (insert ";;; -*- lexical-binding: t -*-\n") + (insert "(fset 'test-macro [?h ?e ?l ?l ?o])\n")) + ;; Verify initial state + (should (not cj/macros-loaded)) + ;; Load macros + (cj/ensure-macros-loaded) + ;; Verify loaded + (should cj/macros-loaded) + (should (fboundp 'test-macro))) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-ensure-macros-loaded-idempotent-normal () + "Normal: subsequent calls don't reload when flag is already true." + (test-keyboard-macros-setup) + (unwind-protect + (progn + ;; Create a macros file + (with-temp-file macros-file + (insert ";;; -*- lexical-binding: t -*-\n")) + ;; First load + (cj/ensure-macros-loaded) + (should cj/macros-loaded) + ;; Modify the file after loading + (with-temp-file macros-file + (insert ";;; -*- lexical-binding: t -*-\n") + (insert "(fset 'new-macro [?n ?e ?w])\n")) + ;; Second call should not reload + (cj/ensure-macros-loaded) + ;; new-macro should not be defined because file wasn't reloaded + (should (not (fboundp 'new-macro)))) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-ensure-macros-file-creates-new-normal () + "Normal: ensure-macros-file creates new file with lexical-binding header." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (should (not (file-exists-p macros-file))) + (ensure-macros-file macros-file) + (should (file-exists-p macros-file)) + (with-temp-buffer + (insert-file-contents macros-file) + (should (string-match-p "lexical-binding: t" (buffer-string))))) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-ensure-macros-file-exists-normal () + "Normal: ensure-macros-file leaves existing file untouched." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (with-temp-file macros-file + (insert ";;; -*- lexical-binding: t -*-\n") + (insert "(fset 'existing-macro [?t ?e ?s ?t])\n")) + (let ((original-content (with-temp-buffer + (insert-file-contents macros-file) + (buffer-string)))) + (ensure-macros-file macros-file) + (should (string= original-content + (with-temp-buffer + (insert-file-contents macros-file) + (buffer-string)))))) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-start-or-end-toggle-normal () + "Normal: starting and stopping macro recording toggles defining-kbd-macro." + (test-keyboard-macros-setup) + (unwind-protect + (progn + ;; Create empty macros file + (with-temp-file macros-file + (insert ";;; -*- lexical-binding: t -*-\n")) + ;; Start recording + (should (not defining-kbd-macro)) + (cj/kbd-macro-start-or-end) + (should defining-kbd-macro) + ;; Stop recording + (cj/kbd-macro-start-or-end) + (should (not defining-kbd-macro))) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-save-valid-name-normal () + "Normal: saving a macro with valid name writes to file and returns name." + (test-keyboard-macros-setup) + (unwind-protect + (progn + ;; Set up a macro + (setq last-kbd-macro [?t ?e ?s ?t]) + ;; Save it + (let ((result (cj/save-maybe-edit-macro "test-macro"))) + (should (string= result "test-macro")) + (should (file-exists-p macros-file)) + ;; Verify macro was written to file + (with-temp-buffer + (insert-file-contents macros-file) + (should (string-match-p "test-macro" (buffer-string)))))) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-save-without-prefix-arg-normal () + "Normal: without prefix arg, returns to original buffer." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (setq last-kbd-macro [?t ?e ?s ?t]) + (let ((original-buffer (current-buffer)) + (current-prefix-arg nil)) + (cj/save-maybe-edit-macro "test-macro") + ;; Should return to original buffer (or stay if it was the macros file) + (should (or (eq (current-buffer) original-buffer) + (not (eq (current-buffer) (get-file-buffer macros-file))))))) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-save-with-prefix-arg-normal () + "Normal: with prefix arg, opens macros file for editing." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (setq last-kbd-macro [?t ?e ?s ?t]) + (let ((current-prefix-arg t)) + (cj/save-maybe-edit-macro "test-macro") + ;; Should be in the macros file buffer + (should (eq (current-buffer) (get-file-buffer macros-file))))) + (test-keyboard-macros-teardown))) + +;;; Boundary Cases + +(ert-deftest test-keyboard-macros-name-single-character-boundary () + "Boundary: macro name with single letter (minimum valid length)." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (setq last-kbd-macro [?t ?e ?s ?t]) + (let ((result (cj/save-maybe-edit-macro "a"))) + (should (string= result "a")) + (should (file-exists-p macros-file)))) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-name-with-numbers-boundary () + "Boundary: macro name containing letters, numbers, and hyphens." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (setq last-kbd-macro [?t ?e ?s ?t]) + (let ((result (cj/save-maybe-edit-macro "macro-123-test"))) + (should (string= result "macro-123-test")) + (should (file-exists-p macros-file)))) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-name-all-caps-boundary () + "Boundary: macro name with uppercase letters." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (setq last-kbd-macro [?t ?e ?s ?t]) + (let ((result (cj/save-maybe-edit-macro "TESTMACRO"))) + (should (string= result "TESTMACRO")) + (should (file-exists-p macros-file)))) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-empty-macro-file-boundary () + "Boundary: loading behavior when macros file exists but is empty." + (test-keyboard-macros-setup) + (unwind-protect + (progn + ;; Create empty file + (with-temp-file macros-file + (insert "")) + (should (not cj/macros-loaded)) + ;; Should handle empty file gracefully + (cj/ensure-macros-loaded) + ;; Loading an empty file should still set the flag + (should cj/macros-loaded)) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-whitespace-only-name-boundary () + "Boundary: whitespace-only name (spaces, tabs) is rejected." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (setq last-kbd-macro [?t ?e ?s ?t]) + (should-error (cj/save-maybe-edit-macro " \t "))) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-concurrent-load-attempts-boundary () + "Boundary: cj/macros-loading lock prevents race conditions." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (with-temp-file macros-file + (insert ";;; -*- lexical-binding: t -*-\n")) + ;; Simulate concurrent load by setting the lock + (setq cj/macros-loading t) + (cj/ensure-macros-loaded) + ;; Should not load because lock is set + (should (not cj/macros-loaded)) + ;; Release lock and try again + (setq cj/macros-loading nil) + (cj/ensure-macros-loaded) + (should cj/macros-loaded)) + (test-keyboard-macros-teardown))) + +;;; Error Cases + +(ert-deftest test-keyboard-macros-save-empty-name-error () + "Error: empty string name triggers user-error." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (setq last-kbd-macro [?t ?e ?s ?t]) + (should-error (cj/save-maybe-edit-macro "") :type 'user-error)) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-save-invalid-name-special-chars-error () + "Error: names with special characters trigger user-error." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (setq last-kbd-macro [?t ?e ?s ?t]) + (should-error (cj/save-maybe-edit-macro "test@macro") :type 'user-error) + (should-error (cj/save-maybe-edit-macro "test!macro") :type 'user-error) + (should-error (cj/save-maybe-edit-macro "test#macro") :type 'user-error)) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-save-invalid-name-starts-with-number-error () + "Error: name starting with number triggers user-error." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (setq last-kbd-macro [?t ?e ?s ?t]) + (should-error (cj/save-maybe-edit-macro "123macro") :type 'user-error)) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-save-invalid-name-has-spaces-error () + "Error: name with spaces triggers user-error." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (setq last-kbd-macro [?t ?e ?s ?t]) + (should-error (cj/save-maybe-edit-macro "test macro") :type 'user-error)) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-save-no-macro-defined-error () + "Error: saving when last-kbd-macro is nil triggers user-error." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (setq last-kbd-macro nil) + (should-error (cj/save-maybe-edit-macro "test-macro") :type 'user-error)) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-load-malformed-file-error () + "Error: error handling when macros file has syntax errors." + (test-keyboard-macros-setup) + (unwind-protect + (progn + ;; Create a malformed macros file + (with-temp-file macros-file + (insert ";;; -*- lexical-binding: t -*-\n") + (insert "(fset 'broken-macro [incomplete")) + (should (not cj/macros-loaded)) + ;; Should handle error gracefully (prints message but doesn't crash) + (cj/ensure-macros-loaded) + ;; Should not be marked as loaded due to error + (should (not cj/macros-loaded))) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-save-file-write-error-error () + "Error: error handling when unable to write to macros file." + (test-keyboard-macros-setup) + (unwind-protect + (progn + (setq last-kbd-macro [?t ?e ?s ?t]) + ;; Create the file and make it read-only + (with-temp-file macros-file + (insert ";;; -*- lexical-binding: t -*-\n")) + (set-file-modes macros-file #o444) + ;; Should error when trying to save + (condition-case err + (progn + (cj/save-maybe-edit-macro "test-macro") + (should nil)) ;; Should not reach here + (error + ;; Expected to error + (should t))) + ;; Clean up permissions for teardown + (set-file-modes macros-file #o644)) + (test-keyboard-macros-teardown))) + +(ert-deftest test-keyboard-macros-load-file-read-error-error () + "Error: error handling when unable to read macros file." + (test-keyboard-macros-setup) + (unwind-protect + (progn + ;; Create file and remove read permissions + (with-temp-file macros-file + (insert ";;; -*- lexical-binding: t -*-\n")) + (set-file-modes macros-file #o000) + (should (not cj/macros-loaded)) + ;; Should handle error gracefully + (cj/ensure-macros-loaded) + ;; Should not be marked as loaded + (should (not cj/macros-loaded)) + ;; Clean up permissions for teardown + (set-file-modes macros-file #o644)) + (test-keyboard-macros-teardown))) + +(provide 'test-keyboard-macros) +;;; test-keyboard-macros.el ends here diff --git a/tests/test-undead-buffers.el b/tests/test-undead-buffers.el new file mode 100644 index 00000000..606972be --- /dev/null +++ b/tests/test-undead-buffers.el @@ -0,0 +1,209 @@ +;;; test-undead-buffers.el --- -*- coding: utf-8; lexical-binding: t; -*- + +;;; Commentary: +;; + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'undead-buffers) + +(ert-deftest undead-buffers/kill-or-bury-when-not-in-list-kills () + "cj/kill-buffer-or-bury-alive should kill a buffer not in `cj/buffer-bury-alive-list'." + (let* ((buf (generate-new-buffer "test-not-in-list")) + (orig (copy-sequence cj/buffer-bury-alive-list))) + (unwind-protect + (progn + (should (buffer-live-p buf)) + (cj/kill-buffer-or-bury-alive (buffer-name buf)) + (should-not (buffer-live-p buf))) + (setq cj/buffer-bury-alive-list orig) + (when (buffer-live-p buf) (kill-buffer buf))))) + +(ert-deftest undead-buffers/kill-or-bury-when-in-list-buries () + "cj/kill-buffer-or-bury-alive should bury (not kill) a buffer in the list." + (let* ((name "*dashboard*") ; an element already in the default list + (buf (generate-new-buffer name)) + (orig (copy-sequence cj/buffer-bury-alive-list)) + win-was) + (unwind-protect + (progn + (add-to-list 'cj/buffer-bury-alive-list name) + ;; show it in a temporary window so we can detect bury + (setq win-was (display-buffer buf)) + (cj/kill-buffer-or-bury-alive name) + ;; bury should leave it alive + (should (buffer-live-p buf)) + ;; note: Emacs’s `bury-buffer` does not delete windows by default, + ;; so we no longer assert that no window shows it. + ) + ;; cleanup + (setq cj/buffer-bury-alive-list orig) + (delete-windows-on buf) + (kill-buffer buf)))) + +(ert-deftest undead-buffers/kill-or-bury-adds-to-list-with-prefix () + "Calling `cj/kill-buffer-or-bury-alive' with a prefix arg should add the buffer to the list." + (let* ((buf (generate-new-buffer "test-add-prefix")) + (orig (copy-sequence cj/buffer-bury-alive-list))) + (unwind-protect + (progn + (let ((current-prefix-arg '(4))) + (cj/kill-buffer-or-bury-alive (buffer-name buf))) + (should (member (buffer-name buf) cj/buffer-bury-alive-list))) + (setq cj/buffer-bury-alive-list orig) + (kill-buffer buf)))) + +(ert-deftest undead-buffers/kill-buffer-and-window-removes-window () + "cj/kill-buffer-and-window should delete the current window and kill/bury its buffer." + (let* ((buf (generate-new-buffer "test-kill-and-win")) + (orig (copy-sequence cj/buffer-bury-alive-list))) + (split-window) ; now two windows + (let ((win (next-window))) + (set-window-buffer win buf) + (select-window win) + (cj/kill-buffer-and-window) + (should-not (window-live-p win)) + (unless (member (buffer-name buf) orig) + (should-not (buffer-live-p buf)))) + (setq cj/buffer-bury-alive-list orig))) + +(ert-deftest undead-buffers/kill-other-window-deletes-that-window () + "cj/kill-other-window should delete the *other* window and kill/bury its buffer." + (let* ((buf1 (current-buffer)) + (buf2 (generate-new-buffer "test-other-window")) + (orig (copy-sequence cj/buffer-bury-alive-list))) + (split-window) + (let* ((win1 (selected-window)) + (win2 (next-window win1))) + (set-window-buffer win2 buf2) + ;; stay on the original window + (select-window win1) + (cj/kill-other-window) + (should-not (window-live-p win2)) + (unless (member (buffer-name buf2) orig) + (should-not (buffer-live-p buf2)))) + (setq cj/buffer-bury-alive-list orig))) + +(ert-deftest undead-buffers/kill-all-other-buffers-and-windows-keeps-only-current () + "cj/kill-all-other-buffers-and-windows should delete other windows and kill/bury all other buffers." + (let* ((main (current-buffer)) + (extra (generate-new-buffer "test-all-others")) + (orig (copy-sequence cj/buffer-bury-alive-list))) + (split-window) + (set-window-buffer (next-window) extra) + (cj/kill-all-other-buffers-and-windows) + (should (one-window-p)) + ;; main buffer still exists + (should (buffer-live-p main)) + ;; extra buffer either buried or killed + (unless (member (buffer-name extra) orig) + (should-not (buffer-live-p extra))) + ;; cleanup + (setq cj/buffer-bury-alive-list orig) + (when (buffer-live-p extra) (kill-buffer extra)))) + +;; --------------------------------- ERT Tests --------------------------------- +;; Run these tests with M-x ert RET t RET + +(require 'ert) +(require 'cl-lib) + +(ert-deftest undead-buffers/kill-or-bury-when-not-in-list-kills () + "cj/kill-buffer-or-bury-alive should kill a buffer not in `cj/buffer-bury-alive-list'." + (let* ((buf (generate-new-buffer "test-not-in-list")) + (orig (copy-sequence cj/buffer-bury-alive-list))) + (unwind-protect + (progn + (should (buffer-live-p buf)) + (cj/kill-buffer-or-bury-alive (buffer-name buf)) + (should-not (buffer-live-p buf))) + (setq cj/buffer-bury-alive-list orig) + (when (buffer-live-p buf) (kill-buffer buf))))) + +(ert-deftest undead-buffers/kill-or-bury-when-in-list-buries () + "cj/kill-buffer-or-bury-alive should bury (not kill) a buffer in the list." + (let* ((name "*dashboard*") ; an element already in the default list + (buf (generate-new-buffer name)) + (orig (copy-sequence cj/buffer-bury-alive-list)) + win-was) + (unwind-protect + (progn + (add-to-list 'cj/buffer-bury-alive-list name) + ;; show it in a temporary window so we can detect bury + (setq win-was (display-buffer buf)) + (cj/kill-buffer-or-bury-alive name) + ;; bury should leave it alive + (should (buffer-live-p buf)) + ;; note: Emacs’s `bury-buffer` does not delete windows by default, + ;; so we no longer assert that no window shows it. + ) + ;; cleanup + (setq cj/buffer-bury-alive-list orig) + (delete-windows-on buf) + (kill-buffer buf)))) + +(ert-deftest undead-buffers/kill-or-bury-adds-to-list-with-prefix () + "Calling `cj/kill-buffer-or-bury-alive' with a prefix arg should add the buffer to the list." + (let* ((buf (generate-new-buffer "test-add-prefix")) + (orig (copy-sequence cj/buffer-bury-alive-list))) + (unwind-protect + (progn + (let ((current-prefix-arg '(4))) + (cj/kill-buffer-or-bury-alive (buffer-name buf))) + (should (member (buffer-name buf) cj/buffer-bury-alive-list))) + (setq cj/buffer-bury-alive-list orig) + (kill-buffer buf)))) + +(ert-deftest undead-buffers/kill-buffer-and-window-removes-window () + "cj/kill-buffer-and-window should delete the current window and kill/bury its buffer." + (let* ((buf (generate-new-buffer "test-kill-and-win")) + (orig (copy-sequence cj/buffer-bury-alive-list))) + (split-window) ; now two windows + (let ((win (next-window))) + (set-window-buffer win buf) + (select-window win) + (cj/kill-buffer-and-window) + (should-not (window-live-p win)) + (unless (member (buffer-name buf) orig) + (should-not (buffer-live-p buf)))) + (setq cj/buffer-bury-alive-list orig))) + +(ert-deftest undead-buffers/kill-other-window-deletes-that-window () + "cj/kill-other-window should delete the *other* window and kill/bury its buffer." + (let* ((buf1 (current-buffer)) + (buf2 (generate-new-buffer "test-other-window")) + (orig (copy-sequence cj/buffer-bury-alive-list))) + (split-window) + (let* ((win1 (selected-window)) + (win2 (next-window win1))) + (set-window-buffer win2 buf2) + ;; stay on the original window + (select-window win1) + (cj/kill-other-window) + (should-not (window-live-p win2)) + (unless (member (buffer-name buf2) orig) + (should-not (buffer-live-p buf2)))) + (setq cj/buffer-bury-alive-list orig))) + +(ert-deftest undead-buffers/kill-all-other-buffers-and-windows-keeps-only-current () + "cj/kill-all-other-buffers-and-windows should delete other windows and kill/bury all other buffers." + (let* ((main (current-buffer)) + (extra (generate-new-buffer "test-all-others")) + (orig (copy-sequence cj/buffer-bury-alive-list))) + (split-window) + (set-window-buffer (next-window) extra) + (cj/kill-all-other-buffers-and-windows) + (should (one-window-p)) + ;; main buffer still exists + (should (buffer-live-p main)) + ;; extra buffer either buried or killed + (unless (member (buffer-name extra) orig) + (should-not (buffer-live-p extra))) + ;; cleanup + (setq cj/buffer-bury-alive-list orig) + (when (buffer-live-p extra) (kill-buffer extra)))) + +(provide 'test-undead-buffers) +;;; test-undead-buffers.el ends here. |
