diff options
Diffstat (limited to 'tests')
124 files changed, 24863 insertions, 0 deletions
diff --git a/tests/fixtures/grammar-correct.txt b/tests/fixtures/grammar-correct.txt new file mode 100644 index 00000000..bea335e8 --- /dev/null +++ b/tests/fixtures/grammar-correct.txt @@ -0,0 +1,5 @@ +This is a well-written sentence with no grammar errors. + +The quick brown fox jumps over the lazy dog. + +Everything here follows standard English grammar rules. diff --git a/tests/fixtures/grammar-errors-basic.txt b/tests/fixtures/grammar-errors-basic.txt new file mode 100644 index 00000000..c2f72c12 --- /dev/null +++ b/tests/fixtures/grammar-errors-basic.txt @@ -0,0 +1,7 @@ +This are a test of basic grammar errors. + +I could of done better with this sentence. + +Their going to the store to buy there groceries. + +The dog wagged it's tail happily. diff --git a/tests/fixtures/grammar-errors-punctuation.txt b/tests/fixtures/grammar-errors-punctuation.txt new file mode 100644 index 00000000..37de646a --- /dev/null +++ b/tests/fixtures/grammar-errors-punctuation.txt @@ -0,0 +1,5 @@ +This sentence is missing punctuation at the end + +Multiple spaces between words should be detected. + +A sentence with,incorrect comma,placement and usage. diff --git a/tests/fixtures/pactl-output-empty.txt b/tests/fixtures/pactl-output-empty.txt new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/tests/fixtures/pactl-output-empty.txt diff --git a/tests/fixtures/pactl-output-inputs-only.txt b/tests/fixtures/pactl-output-inputs-only.txt new file mode 100644 index 00000000..1840b37c --- /dev/null +++ b/tests/fixtures/pactl-output-inputs-only.txt @@ -0,0 +1,3 @@ +50 alsa_input.pci-0000_00_1f.3.analog-stereo PipeWire s32le 2ch 48000Hz SUSPENDED +79 bluez_input.00:1B:66:C0:91:6D PipeWire float32le 1ch 48000Hz SUSPENDED +100 alsa_input.usb-0b0e_Jabra_SPEAK_510_USB_1C48F9C067D5020A00-00.mono-fallback PipeWire s16le 1ch 16000Hz SUSPENDED diff --git a/tests/fixtures/pactl-output-malformed.txt b/tests/fixtures/pactl-output-malformed.txt new file mode 100644 index 00000000..a37b8dd6 --- /dev/null +++ b/tests/fixtures/pactl-output-malformed.txt @@ -0,0 +1,4 @@ +This is not valid pactl output +Some random text +50 incomplete-line-missing-fields +Another bad line with only two tabs diff --git a/tests/fixtures/pactl-output-monitors-only.txt b/tests/fixtures/pactl-output-monitors-only.txt new file mode 100644 index 00000000..be29ebe8 --- /dev/null +++ b/tests/fixtures/pactl-output-monitors-only.txt @@ -0,0 +1,3 @@ +49 alsa_output.pci-0000_00_1f.3.analog-stereo.monitor PipeWire s32le 2ch 48000Hz SUSPENDED +81 bluez_output.00_1B_66_C0_91_6D.1.monitor PipeWire s24le 2ch 48000Hz RUNNING +99 alsa_output.usb-0b0e_Jabra_SPEAK_510_USB_1C48F9C067D5020A00-00.analog-stereo.monitor PipeWire s16le 2ch 48000Hz SUSPENDED diff --git a/tests/fixtures/pactl-output-normal.txt b/tests/fixtures/pactl-output-normal.txt new file mode 100644 index 00000000..6d8d955b --- /dev/null +++ b/tests/fixtures/pactl-output-normal.txt @@ -0,0 +1,6 @@ +49 alsa_output.pci-0000_00_1f.3.analog-stereo.monitor PipeWire s32le 2ch 48000Hz SUSPENDED +50 alsa_input.pci-0000_00_1f.3.analog-stereo PipeWire s32le 2ch 48000Hz SUSPENDED +79 bluez_input.00:1B:66:C0:91:6D PipeWire float32le 1ch 48000Hz SUSPENDED +81 bluez_output.00_1B_66_C0_91_6D.1.monitor PipeWire s24le 2ch 48000Hz SUSPENDED +99 alsa_output.usb-0b0e_Jabra_SPEAK_510_USB_1C48F9C067D5020A00-00.analog-stereo.monitor PipeWire s16le 2ch 48000Hz SUSPENDED +100 alsa_input.usb-0b0e_Jabra_SPEAK_510_USB_1C48F9C067D5020A00-00.mono-fallback PipeWire s16le 1ch 16000Hz SUSPENDED diff --git a/tests/fixtures/pactl-output-single.txt b/tests/fixtures/pactl-output-single.txt new file mode 100644 index 00000000..d1d1c254 --- /dev/null +++ b/tests/fixtures/pactl-output-single.txt @@ -0,0 +1 @@ +50 alsa_input.pci-0000_00_1f.3.analog-stereo PipeWire s32le 2ch 48000Hz SUSPENDED 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-browser-config.el b/tests/test-browser-config.el new file mode 100644 index 00000000..6ab756dd --- /dev/null +++ b/tests/test-browser-config.el @@ -0,0 +1,277 @@ +;;; test-browser-config.el --- Tests for browser-config.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for browser-config.el - browser selection and configuration. +;; +;; Testing approach: +;; - Tests focus on internal `cj/--do-*` functions (pure business logic) +;; - File I/O tests use temp files +;; - executable-find is stubbed to control available browsers +;; - Each test is isolated with setup/teardown +;; - Tests verify return values, not user messages + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Load the module with temp file to avoid polluting real config +(defvar test-browser--temp-choice-file nil + "Temporary file for browser choice during tests.") + +(defun test-browser-setup () + "Setup test environment before each test." + (setq test-browser--temp-choice-file (make-temp-file "browser-choice-test" nil ".el")) + (setq cj/browser-choice-file test-browser--temp-choice-file)) + +(defun test-browser-teardown () + "Clean up test environment after each test." + (when (and test-browser--temp-choice-file + (file-exists-p test-browser--temp-choice-file)) + (delete-file test-browser--temp-choice-file)) + (setq test-browser--temp-choice-file nil)) + +;; Now require the module +(require 'browser-config) + +;;; Helper Functions + +(defun test-browser-make-plist (name &optional executable path) + "Create a test browser plist with NAME, EXECUTABLE, and PATH." + (list :function 'eww-browse-url + :name name + :executable executable + :path path + :program-var nil)) + +;;; Normal Cases - Discover Browsers + +(ert-deftest test-browser-discover-finds-eww () + "Should always find built-in EWW browser." + (test-browser-setup) + (let ((browsers (cj/discover-browsers))) + (should (cl-find-if (lambda (b) (string= (plist-get b :name) "EWW (Emacs Browser)")) + browsers))) + (test-browser-teardown)) + +(ert-deftest test-browser-discover-deduplicates-names () + "Should not return duplicate browser names." + (test-browser-setup) + (let ((browsers (cj/discover-browsers)) + (names (mapcar (lambda (b) (plist-get b :name)) (cj/discover-browsers)))) + (should (= (length names) (length (cl-remove-duplicates names :test 'string=))))) + (test-browser-teardown)) + +;;; Normal Cases - Apply Browser Choice + +(ert-deftest test-browser-apply-valid-browser () + "Should successfully apply a valid browser configuration." + (test-browser-setup) + (let ((browser (test-browser-make-plist "Test Browser"))) + (let ((result (cj/--do-apply-browser-choice browser))) + (should (eq result 'success)) + (should (eq browse-url-browser-function 'eww-browse-url)))) + (test-browser-teardown)) + +(ert-deftest test-browser-apply-sets-program-var () + "Should set browser program variable if specified." + (test-browser-setup) + (let ((browser (list :function 'browse-url-chrome + :name "Chrome" + :executable "chrome" + :path "/usr/bin/chrome" + :program-var 'browse-url-chrome-program))) + (cj/--do-apply-browser-choice browser) + (should (string= browse-url-chrome-program "/usr/bin/chrome"))) + (test-browser-teardown)) + +;;; Normal Cases - Save and Load + +(ert-deftest test-browser-save-and-load-choice () + "Should save and load browser choice correctly." + (test-browser-setup) + (let ((browser (test-browser-make-plist "Saved Browser" "firefox" "/usr/bin/firefox"))) + (cj/save-browser-choice browser) + (let ((loaded (cj/load-browser-choice))) + (should loaded) + (should (string= (plist-get loaded :name) "Saved Browser")) + (should (string= (plist-get loaded :executable) "firefox")))) + (test-browser-teardown)) + +;;; Normal Cases - Choose Browser + +(ert-deftest test-browser-choose-saves-and-applies () + "Should save and apply browser choice." + (test-browser-setup) + (let ((browser (test-browser-make-plist "Test"))) + (let ((result (cj/--do-choose-browser browser))) + (should (eq result 'success)) + ;; Verify it was saved + (let ((loaded (cj/load-browser-choice))) + (should (string= (plist-get loaded :name) "Test"))))) + (test-browser-teardown)) + +;;; Normal Cases - Initialize Browser + +(ert-deftest test-browser-initialize-with-saved-choice () + "Should load and use saved browser choice." + (test-browser-setup) + (let ((browser (test-browser-make-plist "Saved"))) + (cj/save-browser-choice browser) + (let ((result (cj/--do-initialize-browser))) + (should (eq (car result) 'loaded)) + (should (plist-get (cdr result) :name)) + (should (string= (plist-get (cdr result) :name) "Saved")))) + (test-browser-teardown)) + +(ert-deftest test-browser-initialize-without-saved-choice () + "Should use first available browser when no saved choice." + (test-browser-setup) + ;; Delete any saved choice + (when (file-exists-p cj/browser-choice-file) + (delete-file cj/browser-choice-file)) + (let ((result (cj/--do-initialize-browser))) + (should (eq (car result) 'first-available)) + (should (plist-get (cdr result) :name))) + (test-browser-teardown)) + +;;; Boundary Cases - Apply Browser + +(ert-deftest test-browser-apply-nil-plist () + "Should return 'invalid-plist for nil browser." + (test-browser-setup) + (let ((result (cj/--do-apply-browser-choice nil))) + (should (eq result 'invalid-plist))) + (test-browser-teardown)) + +(ert-deftest test-browser-apply-missing-function () + "Should return 'invalid-plist when :function is missing." + (test-browser-setup) + (let ((browser (list :name "Bad Browser" :function nil))) + (let ((result (cj/--do-apply-browser-choice browser))) + (should (eq result 'invalid-plist)))) + (test-browser-teardown)) + +(ert-deftest test-browser-apply-with-nil-path () + "Should handle nil path for built-in browser." + (test-browser-setup) + (let ((browser (test-browser-make-plist "EWW" nil nil))) + (let ((result (cj/--do-apply-browser-choice browser))) + (should (eq result 'success)))) + (test-browser-teardown)) + +;;; Boundary Cases - Save and Load + +(ert-deftest test-browser-load-nonexistent-file () + "Should return nil when loading from nonexistent file." + (test-browser-setup) + (when (file-exists-p cj/browser-choice-file) + (delete-file cj/browser-choice-file)) + (let ((result (cj/load-browser-choice))) + (should (null result))) + (test-browser-teardown)) + +(ert-deftest test-browser-load-corrupt-file () + "Should return nil when loading corrupt file." + (test-browser-setup) + (with-temp-file cj/browser-choice-file + (insert "this is not valid elisp {{{")) + (let ((result (cj/load-browser-choice))) + (should (null result))) + (test-browser-teardown)) + +(ert-deftest test-browser-load-file-without-variable () + "Should return nil when file doesn't define expected variable." + (test-browser-setup) + (with-temp-file cj/browser-choice-file + (insert "(setq some-other-variable 'foo)")) + ;; Unset any previously loaded variable + (makunbound 'cj/saved-browser-choice) + (let ((result (cj/load-browser-choice))) + (should (null result))) + (test-browser-teardown)) + +;;; Boundary Cases - Choose Browser + +(ert-deftest test-browser-choose-empty-plist () + "Should handle empty plist gracefully." + (test-browser-setup) + (let ((result (cj/--do-choose-browser nil))) + (should (eq result 'invalid-plist))) + (test-browser-teardown)) + +;;; Error Cases - File Operations + +(ert-deftest test-browser-save-to-readonly-location () + "Should return 'save-failed when cannot write file." + (test-browser-setup) + ;; Make file read-only + (with-temp-file cj/browser-choice-file + (insert ";; test")) + (set-file-modes cj/browser-choice-file #o444) + (let ((browser (test-browser-make-plist "Test")) + (result nil)) + (setq result (cj/--do-choose-browser browser)) + ;; Restore permissions before teardown + (set-file-modes cj/browser-choice-file #o644) + (should (eq result 'save-failed))) + (test-browser-teardown)) + +;;; Browser Discovery Tests + +(ert-deftest test-browser-discover-returns-plists () + "Should return properly formatted browser plists." + (test-browser-setup) + (let ((browsers (cj/discover-browsers))) + (should (> (length browsers) 0)) + (dolist (browser browsers) + (should (plist-member browser :function)) + (should (plist-member browser :name)) + (should (plist-member browser :executable)) + (should (plist-member browser :path)))) + (test-browser-teardown)) + +(ert-deftest test-browser-format-location-keys () + "Should have all required keys in browser plist." + (test-browser-setup) + (let ((browsers (cj/discover-browsers))) + (when browsers + (let ((browser (car browsers))) + (should (plist-get browser :function)) + (should (plist-get browser :name))))) + (test-browser-teardown)) + +;;; Integration Tests + +(ert-deftest test-browser-full-cycle () + "Should handle full save-load-apply cycle." + (test-browser-setup) + (let ((browser (test-browser-make-plist "Cycle Test" "test-browser" "/usr/bin/test"))) + ;; Choose (save and apply) + (should (eq (cj/--do-choose-browser browser) 'success)) + ;; Verify it was saved + (let ((loaded (cj/load-browser-choice))) + (should loaded) + (should (string= (plist-get loaded :name) "Cycle Test"))) + ;; Initialize should load the saved choice + (let ((result (cj/--do-initialize-browser))) + (should (eq (car result) 'loaded)) + (should (string= (plist-get (cdr result) :name) "Cycle Test")))) + (test-browser-teardown)) + +(ert-deftest test-browser-overwrite-choice () + "Should overwrite previous browser choice." + (test-browser-setup) + (let ((browser1 (test-browser-make-plist "First")) + (browser2 (test-browser-make-plist "Second"))) + (cj/--do-choose-browser browser1) + (cj/--do-choose-browser browser2) + (let ((loaded (cj/load-browser-choice))) + (should (string= (plist-get loaded :name) "Second")))) + (test-browser-teardown)) + +(provide 'test-browser-config) +;;; test-browser-config.el ends here diff --git a/tests/test-custom-buffer-file-clear-to-bottom-of-buffer.el b/tests/test-custom-buffer-file-clear-to-bottom-of-buffer.el new file mode 100644 index 00000000..bd309880 --- /dev/null +++ b/tests/test-custom-buffer-file-clear-to-bottom-of-buffer.el @@ -0,0 +1,163 @@ +;;; test-custom-buffer-file-clear-to-bottom-of-buffer.el --- Tests for cj/clear-to-bottom-of-buffer -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/clear-to-bottom-of-buffer function from custom-buffer-file.el +;; +;; This function deletes all text from point to the end of the current buffer. +;; It does not save the deleted text in the kill ring. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub ps-print package +(provide 'ps-print) + +;; Now load the actual production module +(require 'custom-buffer-file) + +;;; Setup and Teardown + +(defun test-clear-to-bottom-setup () + "Set up test environment." + (setq kill-ring nil)) + +(defun test-clear-to-bottom-teardown () + "Clean up test environment." + (setq kill-ring nil)) + +;;; Normal Cases + +(ert-deftest test-clear-to-bottom-point-in-middle () + "Should delete from point to end when point in middle." + (test-clear-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-min)) + (forward-line 1) ; Point at start of "Line 2" + (cj/clear-to-bottom-of-buffer) + (should (equal (buffer-string) "Line 1\n"))) + (test-clear-to-bottom-teardown))) + +(ert-deftest test-clear-to-bottom-empty-buffer () + "Should do nothing in empty buffer." + (test-clear-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (cj/clear-to-bottom-of-buffer) + (should (equal (buffer-string) ""))) + (test-clear-to-bottom-teardown))) + +;;; Boundary Cases + +(ert-deftest test-clear-to-bottom-point-at-beginning () + "Should delete entire buffer when point at beginning." + (test-clear-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-min)) + (cj/clear-to-bottom-of-buffer) + (should (equal (buffer-string) ""))) + (test-clear-to-bottom-teardown))) + +(ert-deftest test-clear-to-bottom-point-at-end () + "Should delete nothing when point at end." + (test-clear-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-max)) + (cj/clear-to-bottom-of-buffer) + (should (equal (buffer-string) "Line 1\nLine 2\nLine 3"))) + (test-clear-to-bottom-teardown))) + +(ert-deftest test-clear-to-bottom-point-second-to-last-char () + "Should delete last character when point at second-to-last." + (test-clear-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello") + (goto-char (1- (point-max))) ; Before 'o' + (cj/clear-to-bottom-of-buffer) + (should (equal (buffer-string) "Hell"))) + (test-clear-to-bottom-teardown))) + +(ert-deftest test-clear-to-bottom-unicode-content () + "Should handle unicode content." + (test-clear-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello 👋\nمرحبا\nWorld") + (goto-char (point-min)) + (forward-line 1) + (cj/clear-to-bottom-of-buffer) + (should (equal (buffer-string) "Hello 👋\n"))) + (test-clear-to-bottom-teardown))) + +(ert-deftest test-clear-to-bottom-narrowed-buffer () + "Should respect narrowing." + (test-clear-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3\nLine 4") + (goto-char (point-min)) + (forward-line 1) + (let ((start (point))) + (forward-line 2) + (narrow-to-region start (point)) + (goto-char (point-min)) + (forward-line 1) ; Point at "Line 3" + (cj/clear-to-bottom-of-buffer) + (should (equal (buffer-string) "Line 2\n")))) + (test-clear-to-bottom-teardown))) + +(ert-deftest test-clear-to-bottom-multiple-windows () + "Should update all windows showing buffer." + (test-clear-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-min)) + (forward-line 1) + (cj/clear-to-bottom-of-buffer) + ;; Just verify content changed + (should (equal (buffer-string) "Line 1\n"))) + (test-clear-to-bottom-teardown))) + +(ert-deftest test-clear-to-bottom-does-not-affect-kill-ring () + "Should not add deleted text to kill ring." + (test-clear-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-min)) + (setq kill-ring nil) + (cj/clear-to-bottom-of-buffer) + (should (null kill-ring))) + (test-clear-to-bottom-teardown))) + +;;; Error Cases + +(ert-deftest test-clear-to-bottom-read-only-buffer () + "Should signal error in read-only buffer." + (test-clear-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Read-only content") + (read-only-mode 1) + (goto-char (point-min)) + (should-error (cj/clear-to-bottom-of-buffer))) + (test-clear-to-bottom-teardown))) + +(provide 'test-custom-buffer-file-clear-to-bottom-of-buffer) +;;; test-custom-buffer-file-clear-to-bottom-of-buffer.el ends here diff --git a/tests/test-custom-buffer-file-clear-to-top-of-buffer.el b/tests/test-custom-buffer-file-clear-to-top-of-buffer.el new file mode 100644 index 00000000..2bf79b27 --- /dev/null +++ b/tests/test-custom-buffer-file-clear-to-top-of-buffer.el @@ -0,0 +1,162 @@ +;;; test-custom-buffer-file-clear-to-top-of-buffer.el --- Tests for cj/clear-to-top-of-buffer -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/clear-to-top-of-buffer function from custom-buffer-file.el +;; +;; This function deletes all text from point to the beginning of the current buffer. +;; It does not save the deleted text in the kill ring. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub ps-print package +(provide 'ps-print) + +;; Now load the actual production module +(require 'custom-buffer-file) + +;;; Setup and Teardown + +(defun test-clear-to-top-setup () + "Set up test environment." + (setq kill-ring nil)) + +(defun test-clear-to-top-teardown () + "Clean up test environment." + (setq kill-ring nil)) + +;;; Normal Cases + +(ert-deftest test-clear-to-top-point-in-middle () + "Should delete from beginning to point when point in middle." + (test-clear-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-min)) + (forward-line 2) ; Point at start of "Line 3" + (cj/clear-to-top-of-buffer) + (should (equal (buffer-string) "Line 3"))) + (test-clear-to-top-teardown))) + +(ert-deftest test-clear-to-top-empty-buffer () + "Should do nothing in empty buffer." + (test-clear-to-top-setup) + (unwind-protect + (with-temp-buffer + (cj/clear-to-top-of-buffer) + (should (equal (buffer-string) ""))) + (test-clear-to-top-teardown))) + +;;; Boundary Cases + +(ert-deftest test-clear-to-top-point-at-beginning () + "Should delete nothing when point at beginning." + (test-clear-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-min)) + (cj/clear-to-top-of-buffer) + (should (equal (buffer-string) "Line 1\nLine 2\nLine 3"))) + (test-clear-to-top-teardown))) + +(ert-deftest test-clear-to-top-point-at-end () + "Should delete entire buffer when point at end." + (test-clear-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-max)) + (cj/clear-to-top-of-buffer) + (should (equal (buffer-string) ""))) + (test-clear-to-top-teardown))) + +(ert-deftest test-clear-to-top-point-at-second-char () + "Should delete first character when point at second." + (test-clear-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello") + (goto-char (1+ (point-min))) ; After 'H' + (cj/clear-to-top-of-buffer) + (should (equal (buffer-string) "ello"))) + (test-clear-to-top-teardown))) + +(ert-deftest test-clear-to-top-unicode-content () + "Should handle unicode content." + (test-clear-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello 👋\nمرحبا\nWorld") + (goto-char (point-min)) + (forward-line 2) + (cj/clear-to-top-of-buffer) + (should (equal (buffer-string) "World"))) + (test-clear-to-top-teardown))) + +(ert-deftest test-clear-to-top-narrowed-buffer () + "Should respect narrowing." + (test-clear-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3\nLine 4") + (goto-char (point-min)) + (forward-line 1) + (let ((start (point))) + (forward-line 2) + (narrow-to-region start (point)) + (goto-char (point-min)) + (forward-line 1) ; Point at "Line 3" + (cj/clear-to-top-of-buffer) + (should (equal (buffer-string) "Line 3\n")))) + (test-clear-to-top-teardown))) + +(ert-deftest test-clear-to-top-multiple-windows () + "Should update all windows showing buffer." + (test-clear-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-max)) + (cj/clear-to-top-of-buffer) + ;; Just verify content changed + (should (equal (buffer-string) ""))) + (test-clear-to-top-teardown))) + +(ert-deftest test-clear-to-top-does-not-affect-kill-ring () + "Should not add deleted text to kill ring." + (test-clear-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-max)) + (setq kill-ring nil) + (cj/clear-to-top-of-buffer) + (should (null kill-ring))) + (test-clear-to-top-teardown))) + +;;; Error Cases + +(ert-deftest test-clear-to-top-read-only-buffer () + "Should signal error in read-only buffer." + (test-clear-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Read-only content") + (read-only-mode 1) + (goto-char (point-max)) + (should-error (cj/clear-to-top-of-buffer))) + (test-clear-to-top-teardown))) + +(provide 'test-custom-buffer-file-clear-to-top-of-buffer) +;;; test-custom-buffer-file-clear-to-top-of-buffer.el ends here diff --git a/tests/test-custom-buffer-file-copy-link-to-buffer-file.el b/tests/test-custom-buffer-file-copy-link-to-buffer-file.el new file mode 100644 index 00000000..262968d6 --- /dev/null +++ b/tests/test-custom-buffer-file-copy-link-to-buffer-file.el @@ -0,0 +1,209 @@ +;;; test-custom-buffer-file-copy-link-to-buffer-file.el --- Tests for cj/copy-link-to-buffer-file -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/copy-link-to-buffer-file function from custom-buffer-file.el +;; +;; This function copies the full file:// path of the current buffer's file to +;; the kill ring. For non-file buffers, it does nothing (no error). + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub ps-print package +(provide 'ps-print) + +;; Now load the actual production module +(require 'custom-buffer-file) + +;;; Setup and Teardown + +(defun test-copy-link-setup () + "Set up test environment." + (setq kill-ring nil)) + +(defun test-copy-link-teardown () + "Clean up test environment." + ;; Kill all buffers visiting files in the test directory + (dolist (buf (buffer-list)) + (when (buffer-file-name buf) + (when (string-prefix-p cj/test-base-dir (buffer-file-name buf)) + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))))) + (cj/delete-test-base-dir) + (setq kill-ring nil)) + +;;; Normal Cases + +(ert-deftest test-copy-link-simple-file () + "Should copy file:// link for simple file buffer." + (test-copy-link-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-link-to-buffer-file) + (should (equal (car kill-ring) (concat "file://" test-file))))) + (test-copy-link-teardown))) + +(ert-deftest test-copy-link-non-file-buffer () + "Should do nothing for non-file buffer without error." + (test-copy-link-setup) + (unwind-protect + (with-temp-buffer + (setq kill-ring nil) + (cj/copy-link-to-buffer-file) + (should (null kill-ring))) + (test-copy-link-teardown))) + +;;; Boundary Cases + +(ert-deftest test-copy-link-unicode-filename () + "Should handle unicode in filename." + (test-copy-link-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "café.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-link-to-buffer-file) + (should (equal (car kill-ring) (concat "file://" test-file))))) + (test-copy-link-teardown))) + +(ert-deftest test-copy-link-spaces-in-filename () + "Should handle spaces in filename." + (test-copy-link-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "my file.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-link-to-buffer-file) + (should (equal (car kill-ring) (concat "file://" test-file))))) + (test-copy-link-teardown))) + +(ert-deftest test-copy-link-special-chars-filename () + "Should handle special characters in filename." + (test-copy-link-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "[test]-(1).txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-link-to-buffer-file) + (should (equal (car kill-ring) (concat "file://" test-file))))) + (test-copy-link-teardown))) + +(ert-deftest test-copy-link-very-long-path () + "Should handle very long path." + (test-copy-link-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (long-name (make-string 200 ?x)) + (test-file (expand-file-name (concat long-name ".txt") test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-link-to-buffer-file) + (should (equal (car kill-ring) (concat "file://" test-file))))) + (test-copy-link-teardown))) + +(ert-deftest test-copy-link-hidden-file () + "Should handle hidden file." + (test-copy-link-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name ".hidden" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-link-to-buffer-file) + (should (equal (car kill-ring) (concat "file://" test-file))))) + (test-copy-link-teardown))) + +(ert-deftest test-copy-link-no-extension () + "Should handle file with no extension." + (test-copy-link-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "README" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-link-to-buffer-file) + (should (equal (car kill-ring) (concat "file://" test-file))))) + (test-copy-link-teardown))) + +(ert-deftest test-copy-link-symlink-file () + "Should use buffer's filename for symlink." + (test-copy-link-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (target-file (expand-file-name "target.txt" test-dir)) + (link-file (expand-file-name "link.txt" test-dir))) + (with-temp-file target-file + (insert "content")) + (make-symbolic-link target-file link-file) + (with-current-buffer (find-file link-file) + (cj/copy-link-to-buffer-file) + ;; Should use the link name (what buffer-file-name returns) + (should (equal (car kill-ring) (concat "file://" (buffer-file-name)))))) + (test-copy-link-teardown))) + +(ert-deftest test-copy-link-kill-ring-has-content () + "Should add to kill ring when it already has content." + (test-copy-link-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (kill-new "existing content") + (with-current-buffer (find-file test-file) + (cj/copy-link-to-buffer-file) + (should (equal (car kill-ring) (concat "file://" test-file))) + (should (equal (cadr kill-ring) "existing content")))) + (test-copy-link-teardown))) + +(ert-deftest test-copy-link-empty-kill-ring () + "Should populate empty kill ring." + (test-copy-link-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (setq kill-ring nil) + (with-current-buffer (find-file test-file) + (cj/copy-link-to-buffer-file) + (should (equal (car kill-ring) (concat "file://" test-file))) + (should (= (length kill-ring) 1)))) + (test-copy-link-teardown))) + +(ert-deftest test-copy-link-scratch-buffer () + "Should do nothing for *scratch* buffer." + (test-copy-link-setup) + (unwind-protect + (progn + (setq kill-ring nil) + (with-current-buffer "*scratch*" + (cj/copy-link-to-buffer-file) + (should (null kill-ring)))) + (test-copy-link-teardown))) + +(provide 'test-custom-buffer-file-copy-link-to-buffer-file) +;;; test-custom-buffer-file-copy-link-to-buffer-file.el ends here diff --git a/tests/test-custom-buffer-file-copy-path-to-buffer-file-as-kill.el b/tests/test-custom-buffer-file-copy-path-to-buffer-file-as-kill.el new file mode 100644 index 00000000..08959a85 --- /dev/null +++ b/tests/test-custom-buffer-file-copy-path-to-buffer-file-as-kill.el @@ -0,0 +1,205 @@ +;;; test-custom-buffer-file-copy-path-to-buffer-file-as-kill.el --- Tests for cj/copy-path-to-buffer-file-as-kill -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/copy-path-to-buffer-file-as-kill function from custom-buffer-file.el +;; +;; This function copies the full path of the current buffer's file to the kill ring +;; and returns the path. It signals an error if the buffer is not visiting a file. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub ps-print package +(provide 'ps-print) + +;; Now load the actual production module +(require 'custom-buffer-file) + +;;; Setup and Teardown + +(defun test-copy-path-setup () + "Set up test environment." + (setq kill-ring nil)) + +(defun test-copy-path-teardown () + "Clean up test environment." + ;; Kill all buffers visiting files in the test directory + (dolist (buf (buffer-list)) + (when (buffer-file-name buf) + (when (string-prefix-p cj/test-base-dir (buffer-file-name buf)) + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))))) + (cj/delete-test-base-dir) + (setq kill-ring nil)) + +;;; Normal Cases + +(ert-deftest test-copy-path-simple-file () + "Should copy absolute path for simple file buffer." + (test-copy-path-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (let ((result (cj/copy-path-to-buffer-file-as-kill))) + (should (equal result test-file)) + (should (equal (car kill-ring) test-file))))) + (test-copy-path-teardown))) + +(ert-deftest test-copy-path-returns-path () + "Should return the path value." + (test-copy-path-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (let ((result (cj/copy-path-to-buffer-file-as-kill))) + (should (stringp result)) + (should (equal result test-file))))) + (test-copy-path-teardown))) + +;;; Boundary Cases + +(ert-deftest test-copy-path-unicode-filename () + "Should handle unicode in filename." + (test-copy-path-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "café.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-path-to-buffer-file-as-kill) + (should (equal (car kill-ring) test-file)))) + (test-copy-path-teardown))) + +(ert-deftest test-copy-path-spaces-in-filename () + "Should handle spaces in filename." + (test-copy-path-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "my file.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-path-to-buffer-file-as-kill) + (should (equal (car kill-ring) test-file)))) + (test-copy-path-teardown))) + +(ert-deftest test-copy-path-special-chars-filename () + "Should handle special characters in filename." + (test-copy-path-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "[test]-(1).txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-path-to-buffer-file-as-kill) + (should (equal (car kill-ring) test-file)))) + (test-copy-path-teardown))) + +(ert-deftest test-copy-path-very-long-path () + "Should handle very long path." + (test-copy-path-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (long-name (make-string 200 ?x)) + (test-file (expand-file-name (concat long-name ".txt") test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-path-to-buffer-file-as-kill) + (should (equal (car kill-ring) test-file)))) + (test-copy-path-teardown))) + +(ert-deftest test-copy-path-hidden-file () + "Should handle hidden file." + (test-copy-path-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name ".hidden" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-path-to-buffer-file-as-kill) + (should (equal (car kill-ring) test-file)))) + (test-copy-path-teardown))) + +(ert-deftest test-copy-path-no-extension () + "Should handle file with no extension." + (test-copy-path-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "README" test-dir))) + (with-temp-file test-file + (insert "content")) + (with-current-buffer (find-file test-file) + (cj/copy-path-to-buffer-file-as-kill) + (should (equal (car kill-ring) test-file)))) + (test-copy-path-teardown))) + +(ert-deftest test-copy-path-symlink-file () + "Should use buffer's filename for symlink." + (test-copy-path-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (target-file (expand-file-name "target.txt" test-dir)) + (link-file (expand-file-name "link.txt" test-dir))) + (with-temp-file target-file + (insert "content")) + (make-symbolic-link target-file link-file) + (with-current-buffer (find-file link-file) + (cj/copy-path-to-buffer-file-as-kill) + (should (equal (car kill-ring) (buffer-file-name))))) + (test-copy-path-teardown))) + +(ert-deftest test-copy-path-kill-ring-has-content () + "Should add to kill ring when it already has content." + (test-copy-path-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (kill-new "existing content") + (with-current-buffer (find-file test-file) + (cj/copy-path-to-buffer-file-as-kill) + (should (equal (car kill-ring) test-file)) + (should (equal (cadr kill-ring) "existing content")))) + (test-copy-path-teardown))) + +;;; Error Cases + +(ert-deftest test-copy-path-non-file-buffer () + "Should signal user-error for non-file buffer." + (test-copy-path-setup) + (unwind-protect + (with-temp-buffer + (should-error (cj/copy-path-to-buffer-file-as-kill) :type 'user-error)) + (test-copy-path-teardown))) + +(ert-deftest test-copy-path-scratch-buffer () + "Should signal user-error for *scratch* buffer." + (test-copy-path-setup) + (unwind-protect + (with-current-buffer "*scratch*" + (should-error (cj/copy-path-to-buffer-file-as-kill) :type 'user-error)) + (test-copy-path-teardown))) + +(provide 'test-custom-buffer-file-copy-path-to-buffer-file-as-kill) +;;; test-custom-buffer-file-copy-path-to-buffer-file-as-kill.el ends here diff --git a/tests/test-custom-buffer-file-copy-to-bottom-of-buffer.el b/tests/test-custom-buffer-file-copy-to-bottom-of-buffer.el new file mode 100644 index 00000000..0c41761e --- /dev/null +++ b/tests/test-custom-buffer-file-copy-to-bottom-of-buffer.el @@ -0,0 +1,187 @@ +;;; test-custom-buffer-file-copy-to-bottom-of-buffer.el --- Tests for cj/copy-to-bottom-of-buffer -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/copy-to-bottom-of-buffer function from custom-buffer-file.el +;; +;; This function copies all text from point to the end of the current buffer +;; to the kill ring without modifying the buffer. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub ps-print package +(provide 'ps-print) + +;; Now load the actual production module +(require 'custom-buffer-file) + +;;; Setup and Teardown + +(defun test-copy-to-bottom-setup () + "Set up test environment." + (setq kill-ring nil)) + +(defun test-copy-to-bottom-teardown () + "Clean up test environment." + (setq kill-ring nil)) + +;;; Normal Cases + +(ert-deftest test-custom-buffer-file-copy-to-bottom-of-buffer-normal-point-in-middle-copies-to-end () + "Should copy from point to end when point in middle." + (test-copy-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-min)) + (forward-line 1) ; Point at start of "Line 2" + (let ((original-content (buffer-string))) + (cj/copy-to-bottom-of-buffer) + ;; Buffer should be unchanged + (should (equal (buffer-string) original-content)) + ;; Kill ring should contain from point to end + (should (equal (car kill-ring) "Line 2\nLine 3")))) + (test-copy-to-bottom-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-bottom-of-buffer-normal-single-line-copies-partial () + "Should copy partial line content from middle of line." + (test-copy-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello World") + (goto-char (point-min)) + (forward-char 6) ; Point after "Hello " + (cj/copy-to-bottom-of-buffer) + (should (equal (buffer-string) "Hello World")) + (should (equal (car kill-ring) "World"))) + (test-copy-to-bottom-teardown))) + +;;; Boundary Cases + +(ert-deftest test-custom-buffer-file-copy-to-bottom-of-buffer-boundary-point-at-beginning-copies-all () + "Should copy entire buffer when point at beginning." + (test-copy-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-min)) + (cj/copy-to-bottom-of-buffer) + (should (equal (buffer-string) "Line 1\nLine 2\nLine 3")) + (should (equal (car kill-ring) "Line 1\nLine 2\nLine 3"))) + (test-copy-to-bottom-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-bottom-of-buffer-boundary-point-at-end-copies-empty () + "Should copy empty string when point at end." + (test-copy-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-max)) + (cj/copy-to-bottom-of-buffer) + (should (equal (buffer-string) "Line 1\nLine 2\nLine 3")) + (should (equal (car kill-ring) ""))) + (test-copy-to-bottom-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-bottom-of-buffer-boundary-empty-buffer-copies-empty () + "Should copy empty string in empty buffer." + (test-copy-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (cj/copy-to-bottom-of-buffer) + (should (equal (buffer-string) "")) + (should (equal (car kill-ring) ""))) + (test-copy-to-bottom-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-bottom-of-buffer-boundary-point-second-to-last-char-copies-one () + "Should copy last character when point at second-to-last." + (test-copy-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello") + (goto-char (1- (point-max))) ; Before 'o' + (cj/copy-to-bottom-of-buffer) + (should (equal (buffer-string) "Hello")) + (should (equal (car kill-ring) "o"))) + (test-copy-to-bottom-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-bottom-of-buffer-boundary-unicode-content-copies-correctly () + "Should handle unicode content correctly." + (test-copy-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello 👋\nمرحبا\nWorld") + (goto-char (point-min)) + (forward-line 1) + (cj/copy-to-bottom-of-buffer) + (should (equal (buffer-string) "Hello 👋\nمرحبا\nWorld")) + (should (equal (car kill-ring) "مرحبا\nWorld"))) + (test-copy-to-bottom-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-bottom-of-buffer-boundary-narrowed-buffer-respects-narrowing () + "Should respect narrowing and only copy within narrowed region." + (test-copy-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3\nLine 4") + (goto-char (point-min)) + (forward-line 1) + (let ((start (point))) + (forward-line 2) + (narrow-to-region start (point)) + (goto-char (point-min)) + (forward-line 1) ; Point at "Line 3" + (cj/copy-to-bottom-of-buffer) + (should (equal (buffer-string) "Line 2\nLine 3\n")) + (should (equal (car kill-ring) "Line 3\n")))) + (test-copy-to-bottom-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-bottom-of-buffer-boundary-whitespace-only-copies-whitespace () + "Should copy whitespace-only content." + (test-copy-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert " \n\t\t\n ") + (goto-char (point-min)) + (forward-char 4) ; After first newline + (cj/copy-to-bottom-of-buffer) + (should (equal (buffer-string) " \n\t\t\n ")) + (should (equal (car kill-ring) "\t\t\n "))) + (test-copy-to-bottom-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-bottom-of-buffer-boundary-single-character-copies-char () + "Should copy single character buffer." + (test-copy-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "x") + (goto-char (point-min)) + (cj/copy-to-bottom-of-buffer) + (should (equal (buffer-string) "x")) + (should (equal (car kill-ring) "x"))) + (test-copy-to-bottom-teardown))) + +;;; Error Cases + +(ert-deftest test-custom-buffer-file-copy-to-bottom-of-buffer-error-read-only-buffer-succeeds () + "Should work in read-only buffer since it doesn't modify content." + (test-copy-to-bottom-setup) + (unwind-protect + (with-temp-buffer + (insert "Read-only content") + (read-only-mode 1) + (goto-char (point-min)) + (cj/copy-to-bottom-of-buffer) + (should (equal (car kill-ring) "Read-only content"))) + (test-copy-to-bottom-teardown))) + +(provide 'test-custom-buffer-file-copy-to-bottom-of-buffer) +;;; test-custom-buffer-file-copy-to-bottom-of-buffer.el ends here diff --git a/tests/test-custom-buffer-file-copy-to-top-of-buffer.el b/tests/test-custom-buffer-file-copy-to-top-of-buffer.el new file mode 100644 index 00000000..0f09f26d --- /dev/null +++ b/tests/test-custom-buffer-file-copy-to-top-of-buffer.el @@ -0,0 +1,186 @@ +;;; test-custom-buffer-file-copy-to-top-of-buffer.el --- Tests for cj/copy-to-top-of-buffer -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/copy-to-top-of-buffer function from custom-buffer-file.el +;; +;; This function copies all text from the beginning of the buffer to point +;; to the kill ring without modifying the buffer. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub ps-print package +(provide 'ps-print) + +;; Now load the actual production module +(require 'custom-buffer-file) + +;;; Setup and Teardown + +(defun test-copy-to-top-setup () + "Set up test environment." + (setq kill-ring nil)) + +(defun test-copy-to-top-teardown () + "Clean up test environment." + (setq kill-ring nil)) + +;;; Normal Cases + +(ert-deftest test-custom-buffer-file-copy-to-top-of-buffer-normal-point-in-middle-copies-from-beginning () + "Should copy from beginning to point when point in middle." + (test-copy-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-min)) + (forward-line 2) ; Point at start of "Line 3" + (let ((original-content (buffer-string))) + (cj/copy-to-top-of-buffer) + ;; Buffer should be unchanged + (should (equal (buffer-string) original-content)) + ;; Kill ring should contain from beginning to point + (should (equal (car kill-ring) "Line 1\nLine 2\n")))) + (test-copy-to-top-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-top-of-buffer-normal-single-line-copies-partial () + "Should copy partial line content from beginning to middle of line." + (test-copy-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello World") + (goto-char (point-min)) + (forward-char 5) ; Point after "Hello" + (cj/copy-to-top-of-buffer) + (should (equal (buffer-string) "Hello World")) + (should (equal (car kill-ring) "Hello"))) + (test-copy-to-top-teardown))) + +;;; Boundary Cases + +(ert-deftest test-custom-buffer-file-copy-to-top-of-buffer-boundary-point-at-end-copies-all () + "Should copy entire buffer when point at end." + (test-copy-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-max)) + (cj/copy-to-top-of-buffer) + (should (equal (buffer-string) "Line 1\nLine 2\nLine 3")) + (should (equal (car kill-ring) "Line 1\nLine 2\nLine 3"))) + (test-copy-to-top-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-top-of-buffer-boundary-point-at-beginning-copies-empty () + "Should copy empty string when point at beginning." + (test-copy-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (goto-char (point-min)) + (cj/copy-to-top-of-buffer) + (should (equal (buffer-string) "Line 1\nLine 2\nLine 3")) + (should (equal (car kill-ring) ""))) + (test-copy-to-top-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-top-of-buffer-boundary-empty-buffer-copies-empty () + "Should copy empty string in empty buffer." + (test-copy-to-top-setup) + (unwind-protect + (with-temp-buffer + (cj/copy-to-top-of-buffer) + (should (equal (buffer-string) "")) + (should (equal (car kill-ring) ""))) + (test-copy-to-top-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-top-of-buffer-boundary-point-at-second-char-copies-one () + "Should copy first character when point at second character." + (test-copy-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello") + (goto-char (1+ (point-min))) ; After 'H' + (cj/copy-to-top-of-buffer) + (should (equal (buffer-string) "Hello")) + (should (equal (car kill-ring) "H"))) + (test-copy-to-top-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-top-of-buffer-boundary-unicode-content-copies-correctly () + "Should handle unicode content correctly." + (test-copy-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello 👋\nمرحبا\nWorld") + (goto-char (point-min)) + (forward-line 2) ; Point at start of "World" + (cj/copy-to-top-of-buffer) + (should (equal (buffer-string) "Hello 👋\nمرحبا\nWorld")) + (should (equal (car kill-ring) "Hello 👋\nمرحبا\n"))) + (test-copy-to-top-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-top-of-buffer-boundary-narrowed-buffer-respects-narrowing () + "Should respect narrowing and only copy within narrowed region." + (test-copy-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3\nLine 4") + (goto-char (point-min)) + (forward-line 1) + (let ((start (point))) + (forward-line 2) + (narrow-to-region start (point)) + (goto-char (point-max)) ; Point at end of narrowed region + (cj/copy-to-top-of-buffer) + (should (equal (buffer-string) "Line 2\nLine 3\n")) + (should (equal (car kill-ring) "Line 2\nLine 3\n")))) + (test-copy-to-top-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-top-of-buffer-boundary-whitespace-only-copies-whitespace () + "Should copy whitespace-only content." + (test-copy-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert " \n\t\t\n ") + (goto-char (point-min)) + (forward-char 7) ; After second newline + (cj/copy-to-top-of-buffer) + (should (equal (buffer-string) " \n\t\t\n ")) + (should (equal (car kill-ring) " \n\t\t\n"))) + (test-copy-to-top-teardown))) + +(ert-deftest test-custom-buffer-file-copy-to-top-of-buffer-boundary-single-character-copies-char () + "Should copy single character buffer." + (test-copy-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "x") + (goto-char (point-max)) + (cj/copy-to-top-of-buffer) + (should (equal (buffer-string) "x")) + (should (equal (car kill-ring) "x"))) + (test-copy-to-top-teardown))) + +;;; Error Cases + +(ert-deftest test-custom-buffer-file-copy-to-top-of-buffer-error-read-only-buffer-succeeds () + "Should work in read-only buffer since it doesn't modify content." + (test-copy-to-top-setup) + (unwind-protect + (with-temp-buffer + (insert "Read-only content") + (goto-char (point-max)) + (read-only-mode 1) + (cj/copy-to-top-of-buffer) + (should (equal (car kill-ring) "Read-only content"))) + (test-copy-to-top-teardown))) + +(provide 'test-custom-buffer-file-copy-to-top-of-buffer) +;;; test-custom-buffer-file-copy-to-top-of-buffer.el ends here diff --git a/tests/test-custom-buffer-file-copy-whole-buffer.el b/tests/test-custom-buffer-file-copy-whole-buffer.el new file mode 100644 index 00000000..181c491a --- /dev/null +++ b/tests/test-custom-buffer-file-copy-whole-buffer.el @@ -0,0 +1,194 @@ +;;; test-custom-buffer-file-copy-whole-buffer.el --- Tests for cj/copy-whole-buffer -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/copy-whole-buffer function from custom-buffer-file.el +;; +;; This function copies the entire contents of the current buffer to the kill ring. +;; Point and mark are left exactly where they were. No transient region is created. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub ps-print package +(provide 'ps-print) + +;; Now load the actual production module +(require 'custom-buffer-file) + +;;; Setup and Teardown + +(defun test-copy-whole-buffer-setup () + "Set up test environment." + (setq kill-ring nil)) + +(defun test-copy-whole-buffer-teardown () + "Clean up test environment." + (setq kill-ring nil)) + +;;; Normal Cases + +(ert-deftest test-copy-whole-buffer-simple-text () + "Should copy simple text content to kill ring." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello, world!") + (cj/copy-whole-buffer) + (should (equal (car kill-ring) "Hello, world!"))) + (test-copy-whole-buffer-teardown))) + +(ert-deftest test-copy-whole-buffer-preserves-point () + "Should preserve point position." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello, world!") + (goto-char 7) ; Position in middle + (cj/copy-whole-buffer) + (should (= (point) 7))) + (test-copy-whole-buffer-teardown))) + +(ert-deftest test-copy-whole-buffer-preserves-mark () + "Should preserve mark position." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello, world!") + (push-mark 5) + (goto-char 10) + (cj/copy-whole-buffer) + (should (= (mark) 5)) + (should (= (point) 10))) + (test-copy-whole-buffer-teardown))) + +;;; Boundary Cases + +(ert-deftest test-copy-whole-buffer-empty () + "Should handle empty buffer." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (cj/copy-whole-buffer) + (should (equal (car kill-ring) ""))) + (test-copy-whole-buffer-teardown))) + +(ert-deftest test-copy-whole-buffer-large () + "Should handle very large buffer." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (let ((large-content (make-string 100000 ?x))) + (insert large-content) + (cj/copy-whole-buffer) + (should (equal (car kill-ring) large-content)))) + (test-copy-whole-buffer-teardown))) + +(ert-deftest test-copy-whole-buffer-unicode () + "Should handle unicode content (emoji, RTL text)." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello 👋 مرحبا") + (cj/copy-whole-buffer) + (should (equal (car kill-ring) "Hello 👋 مرحبا"))) + (test-copy-whole-buffer-teardown))) + +(ert-deftest test-copy-whole-buffer-binary () + "Should handle binary content." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (insert (string 0 1 2 255)) + (cj/copy-whole-buffer) + (should (equal (car kill-ring) (string 0 1 2 255)))) + (test-copy-whole-buffer-teardown))) + +(ert-deftest test-copy-whole-buffer-only-whitespace () + "Should handle buffer with only whitespace." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (insert " \t\n ") + (cj/copy-whole-buffer) + (should (equal (car kill-ring) " \t\n "))) + (test-copy-whole-buffer-teardown))) + +(ert-deftest test-copy-whole-buffer-newlines-at-boundaries () + "Should handle newlines at start/end." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (insert "\n\nHello\n\n") + (cj/copy-whole-buffer) + (should (equal (car kill-ring) "\n\nHello\n\n"))) + (test-copy-whole-buffer-teardown))) + +(ert-deftest test-copy-whole-buffer-narrowed () + "Should copy only visible region in narrowed buffer." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3\n") + (goto-char (point-min)) + (forward-line 1) + (narrow-to-region (point) (progn (forward-line 1) (point))) + (cj/copy-whole-buffer) + ;; Should copy only the narrowed region + (should (equal (car kill-ring) "Line 2\n"))) + (test-copy-whole-buffer-teardown))) + +(ert-deftest test-copy-whole-buffer-read-only () + "Should work in read-only buffer." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (insert "Read-only content") + (read-only-mode 1) + (cj/copy-whole-buffer) + (should (equal (car kill-ring) "Read-only content"))) + (test-copy-whole-buffer-teardown))) + +(ert-deftest test-copy-whole-buffer-kill-ring-has-content () + "Should add to kill ring when it already has content." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (insert "New content") + (kill-new "existing content") + (cj/copy-whole-buffer) + (should (equal (car kill-ring) "New content")) + (should (equal (cadr kill-ring) "existing content"))) + (test-copy-whole-buffer-teardown))) + +(ert-deftest test-copy-whole-buffer-multiline () + "Should preserve multiline content." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (cj/copy-whole-buffer) + (should (equal (car kill-ring) "Line 1\nLine 2\nLine 3"))) + (test-copy-whole-buffer-teardown))) + +(ert-deftest test-copy-whole-buffer-no-properties () + "Should strip text properties." + (test-copy-whole-buffer-setup) + (unwind-protect + (with-temp-buffer + (insert (propertize "Hello" 'face 'bold)) + (cj/copy-whole-buffer) + (should (equal (car kill-ring) "Hello")) + (should (null (text-properties-at 0 (car kill-ring))))) + (test-copy-whole-buffer-teardown))) + +(provide 'test-custom-buffer-file-copy-whole-buffer) +;;; test-custom-buffer-file-copy-whole-buffer.el ends here diff --git a/tests/test-custom-buffer-file-delete-buffer-and-file.el b/tests/test-custom-buffer-file-delete-buffer-and-file.el new file mode 100644 index 00000000..4af8d2a7 --- /dev/null +++ b/tests/test-custom-buffer-file-delete-buffer-and-file.el @@ -0,0 +1,671 @@ +;;; test-custom-buffer-file-delete-buffer-and-file.el --- Tests for cj/delete-buffer-and-file -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/delete-buffer-and-file function from custom-buffer-file.el +;; +;; This function deletes both the current buffer and the file it visits. +;; It uses vc-delete-file for version-controlled files and delete-file +;; for non-version-controlled files. +;; +;; Testing Strategy: +;; - We test OUR code's behavior, not the underlying delete-file/vc-delete-file +;; implementations +;; - We verify our code correctly: +;; 1. Detects VC vs non-VC files (via vc-backend) +;; 2. Calls the appropriate deletion function (vc-delete-file or delete-file) +;; 3. Passes the trash flag (t) to delete-file +;; 4. Propagates errors from the deletion functions +;; +;; Why We Mock delete-file Errors: +;; - Tests like "already deleted file" and "no delete permission" are testing +;; system/environment behavior, not our code +;; - The trash system handles these cases in environment-specific ways: +;; - Missing files may not error (trash handles gracefully) +;; - File permissions may not matter (directory permissions for moving to trash) +;; - To make tests deterministic and portable, we mock delete-file to throw +;; specific errors, then verify our code propagates them correctly +;; - This tests our contract: "when delete-file fails, we let the error through" + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub ps-print package +(provide 'ps-print) + +;; Now load the actual production module +(require 'custom-buffer-file) + +;;; Setup and Teardown + +(defun test-delete-buffer-and-file-setup () + "Setup for delete-buffer-and-file tests." + (cj/create-test-base-dir)) + +(defun test-delete-buffer-and-file-teardown () + "Teardown for delete-buffer-and-file tests." + ;; Kill all buffers visiting files in test directory + (dolist (buf (buffer-list)) + (when (buffer-file-name buf) + (when (string-prefix-p cj/test-base-dir (buffer-file-name buf)) + (with-current-buffer buf + (set-buffer-modified-p nil)) + (kill-buffer buf)))) + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-delete-buffer-and-file-simple-delete () + "Should delete file and kill buffer." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (let ((buf (current-buffer))) + ;; Mock vc-backend to return nil (non-VC file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)) + (should-not (buffer-live-p buf))))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-removes-file-from-disk () + "Should remove file from disk." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-kills-buffer () + "Should kill the buffer." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (let ((buf (current-buffer))) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (buffer-live-p buf))))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-calls-delete-file-with-trash-flag () + "Should call delete-file with trash flag set to t." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir)) + (delete-file-args nil)) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil)) + ((symbol-function 'delete-file) + (lambda (file trash) + (setq delete-file-args (list file trash))))) + (cj/delete-buffer-and-file) + (should (equal delete-file-args (list test-file t))))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-shows-message () + "Should display message for non-VC deletes." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir)) + (message-output nil)) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil)) + ((symbol-function 'message) + (lambda (fmt &rest args) + (setq message-output (apply #'format fmt args))))) + (cj/delete-buffer-and-file) + (should (string-match-p "Deleted file.*test.txt" message-output)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-vc-file-uses-vc-delete () + "Should call vc-delete-file for VC files." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir)) + (vc-delete-called nil)) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) 'Git)) + ((symbol-function 'vc-delete-file) + (lambda (file) + (setq vc-delete-called file) + ;; Simulate vc-delete-file killing the buffer + (when (get-file-buffer file) + (kill-buffer (get-file-buffer file))) + ;; Actually delete the file for test cleanup + (delete-file file t)))) + (cj/delete-buffer-and-file) + (should (string= vc-delete-called test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-non-vc-file-uses-delete-file () + "Should call delete-file for non-VC files." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir)) + (delete-file-called nil)) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil)) + ((symbol-function 'delete-file) + (lambda (file trash) + (setq delete-file-called file)))) + (cj/delete-buffer-and-file) + (should (string= delete-file-called test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-returns-implicitly () + "Should return result of last expression." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (let ((result (cj/delete-buffer-and-file))) + ;; kill-buffer returns t, so result should be t + (should (eq result t))))) + (test-delete-buffer-and-file-teardown))) + +;;; Boundary Cases - File Content + +(ert-deftest test-delete-buffer-and-file-empty-file () + "Should delete empty file." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "empty.txt" test-dir))) + (with-temp-file test-file) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-large-file () + "Should delete large file." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "large.txt" test-dir)) + (large-content (make-string 100000 ?x))) + (with-temp-file test-file + (insert large-content)) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-binary-file () + "Should delete binary file." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "binary.dat" test-dir)) + (binary-content (string 0 1 2 3 255 254 253))) + (with-temp-file test-file + (set-buffer-multibyte nil) + (insert binary-content)) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-with-unicode-content () + "Should delete file with Unicode content." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "unicode.txt" test-dir)) + (content "Hello 世界 مرحبا Привет")) + (with-temp-file test-file + (insert content)) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)))) + (test-delete-buffer-and-file-teardown))) + +;;; Boundary Cases - File Naming + +(ert-deftest test-delete-buffer-and-file-unicode-filename () + "Should delete file with Unicode filename." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "café.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-spaces-in-filename () + "Should delete file with spaces in name." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "my file.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-special-chars-filename () + "Should delete file with special characters." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "[test]-(1).txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-hidden-file () + "Should delete hidden file." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name ".hidden" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-no-extension () + "Should delete file without extension." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "README" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-very-long-filename () + "Should delete file with very long name." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (long-name (concat (make-string 200 ?x) ".txt")) + (test-file (expand-file-name long-name test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)))) + (test-delete-buffer-and-file-teardown))) + +;;; Boundary Cases - Buffer State + +(ert-deftest test-delete-buffer-and-file-with-unsaved-changes () + "Should handle buffer with unsaved changes." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "original")) + (find-file test-file) + (insert " modified") + (should (buffer-modified-p)) + (let ((buf (current-buffer))) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)) + (should-not (buffer-live-p buf))))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-read-only-buffer () + "Should handle read-only buffer." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (read-only-mode 1) + (let ((buf (current-buffer))) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)) + (should-not (buffer-live-p buf))))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-multiple-windows () + "Should work when buffer displayed in multiple windows." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (delete-other-windows) + (split-window) + (other-window 1) + (switch-to-buffer (get-file-buffer test-file)) + (let ((buf (current-buffer))) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)) + (should-not (buffer-live-p buf)))) + (delete-other-windows)) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-buffer-not-current () + "Should only operate on current buffer." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (file1 (expand-file-name "file1.txt" test-dir)) + (file2 (expand-file-name "file2.txt" test-dir))) + (with-temp-file file1 + (insert "content1")) + (with-temp-file file2 + (insert "content2")) + (find-file file1) + (find-file file2) + ;; Current buffer is file2 + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + ;; file2 should be deleted, file1 should still exist + (should-not (file-exists-p file2)) + (should (file-exists-p file1))) + (kill-buffer (get-file-buffer file1))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-narrowed-buffer () + "Should work with narrowed buffer." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "Line 1\nLine 2\nLine 3")) + (find-file test-file) + (goto-char (point-min)) + (forward-line 1) + (narrow-to-region (point) (line-end-position)) + (let ((buf (current-buffer))) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)) + (should-not (buffer-live-p buf))))) + (test-delete-buffer-and-file-teardown))) + +;;; Error Cases - Buffer Issues + +(ert-deftest test-delete-buffer-and-file-non-file-buffer-does-nothing () + "Should do nothing if buffer not visiting file." + (test-delete-buffer-and-file-setup) + (unwind-protect + (with-temp-buffer + (rename-buffer "non-file-buffer" t) + (let ((buf (current-buffer))) + (cj/delete-buffer-and-file) + ;; Buffer should still be alive + (should (buffer-live-p buf)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-scratch-buffer-does-nothing () + "Should do nothing for scratch buffer." + (test-delete-buffer-and-file-setup) + (unwind-protect + (with-current-buffer "*scratch*" + (cj/delete-buffer-and-file) + ;; Scratch buffer should still exist + (should (get-buffer "*scratch*"))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-already-killed-buffer () + "Should error when operating on killed buffer." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir)) + (buf nil)) + (with-temp-file test-file + (insert "content")) + (setq buf (find-file test-file)) + (kill-buffer buf) + (should-error + (with-current-buffer buf + (cj/delete-buffer-and-file)))) + (test-delete-buffer-and-file-teardown))) + +;;; Error Cases - File Issues + +(ert-deftest test-delete-buffer-and-file-already-deleted-file () + "Should propagate error when delete-file fails on missing file." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil)) + ((symbol-function 'delete-file) + (lambda (file &optional _trash) + (signal 'file-missing (list "Removing old name" "No such file or directory" file))))) + ;; Should propagate error from delete-file + (should-error (cj/delete-buffer-and-file) :type 'file-missing))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-no-delete-permission () + "Should propagate error when delete-file fails due to permissions." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil)) + ((symbol-function 'delete-file) + (lambda (file &optional _trash) + (signal 'file-error (list "Removing old name" "Permission denied" file))))) + ;; Should propagate error from delete-file + (should-error (cj/delete-buffer-and-file) :type 'file-error))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-no-write-permission-directory () + "Should error if directory not writable." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (set-file-modes test-dir #o555) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (should-error (cj/delete-buffer-and-file)) + (set-file-modes test-dir #o755))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-open-in-other-buffer () + "Should handle file open in another buffer." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (let ((buf1 (current-buffer))) + (find-file test-file) + (let ((buf2 (current-buffer))) + ;; Both buffers visiting same file + (should (eq buf1 buf2)) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)) + (should-not (buffer-live-p buf1)))))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-symlink-file () + "Should handle symlink files." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (real-file (expand-file-name "real.txt" test-dir)) + (symlink (expand-file-name "link.txt" test-dir))) + (with-temp-file real-file + (insert "content")) + (make-symbolic-link real-file symlink) + (find-file symlink) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + ;; Symlink should be deleted, real file should remain + (should-not (file-exists-p symlink)) + (should (file-exists-p real-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-symlink-directory () + "Should handle files in symlinked directories." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((real-dir (cj/create-test-subdirectory "real")) + (link-dir (expand-file-name "link" cj/test-base-dir)) + (test-file (expand-file-name "test.txt" real-dir))) + (with-temp-file test-file + (insert "content")) + (make-symbolic-link real-dir link-dir) + (let ((file-via-link (expand-file-name "test.txt" link-dir))) + (find-file file-via-link) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + ;; File should be deleted + (should-not (file-exists-p test-file))))) + (test-delete-buffer-and-file-teardown))) + +;;; Edge Cases - Version Control + +(ert-deftest test-delete-buffer-and-file-git-tracked-file () + "Should use vc-delete-file for git files." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir)) + (vc-delete-called nil)) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) 'Git)) + ((symbol-function 'vc-delete-file) + (lambda (file) + (setq vc-delete-called t) + (when (get-file-buffer file) + (kill-buffer (get-file-buffer file))) + (delete-file file t)))) + (cj/delete-buffer-and-file) + (should vc-delete-called))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-untracked-in-vc-repo () + "Should use delete-file for untracked files in VC repo." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "untracked.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + ;; vc-backend returns nil for untracked files + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) nil))) + (cj/delete-buffer-and-file) + (should-not (file-exists-p test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-vc-backend-detection () + "Should correctly detect VC backend." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir)) + (backend-checked nil)) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) + (lambda (file) + (setq backend-checked file) + nil))) + (cj/delete-buffer-and-file) + (should (string= backend-checked test-file)))) + (test-delete-buffer-and-file-teardown))) + +(ert-deftest test-delete-buffer-and-file-vc-delete-fails () + "Should propagate vc-delete-file errors." + (test-delete-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (test-file (expand-file-name "test.txt" test-dir))) + (with-temp-file test-file + (insert "content")) + (find-file test-file) + (cl-letf (((symbol-function 'vc-backend) (lambda (&rest _) 'Git)) + ((symbol-function 'vc-delete-file) + (lambda (file) + (error "VC operation failed")))) + (should-error (cj/delete-buffer-and-file)))) + (test-delete-buffer-and-file-teardown))) + +(provide 'test-custom-buffer-file-delete-buffer-and-file) +;;; test-custom-buffer-file-delete-buffer-and-file.el ends here diff --git a/tests/test-custom-buffer-file-move-buffer-and-file.el b/tests/test-custom-buffer-file-move-buffer-and-file.el new file mode 100644 index 00000000..e8f4563d --- /dev/null +++ b/tests/test-custom-buffer-file-move-buffer-and-file.el @@ -0,0 +1,936 @@ +;;; test-custom-buffer-file-move-buffer-and-file.el --- Tests for cj/move-buffer-and-file -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--move-buffer-and-file function from custom-buffer-file.el +;; +;; This is the internal (non-interactive) implementation that moves both the +;; current buffer and its visited file to a new directory. It handles trailing +;; slashes, preserves file content, updates the visited-file-name, and clears +;; the modified flag. The interactive wrapper cj/move-buffer-and-file handles +;; user prompting and delegates to this implementation. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub ps-print package +(provide 'ps-print) + +;; Now load the actual production module +(require 'custom-buffer-file) + +;;; Setup and Teardown + +(defun test-move-buffer-and-file-setup () + "Setup for move-buffer-and-file tests." + (cj/create-test-base-dir)) + +(defun test-move-buffer-and-file-teardown () + "Teardown for move-buffer-and-file tests." + ;; Kill all buffers visiting files in test directory + (dolist (buf (buffer-list)) + (when (buffer-file-name buf) + (when (string-prefix-p cj/test-base-dir (buffer-file-name buf)) + (with-current-buffer buf + (set-buffer-modified-p nil)) + (kill-buffer buf)))) + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-move-buffer-and-file-simple-move-should-succeed () + "Should move file and buffer to new directory successfully." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir)) + (content "Test content")) + (with-temp-file source-file + (insert content)) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-updates-buffer-file-name () + "Should update buffer-file-name to new location." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (string= (buffer-file-name) target-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-preserves-content () + "Should preserve file content after move." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (content "Original content\nWith multiple lines\n")) + (with-temp-file source-file + (insert content)) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (string= (buffer-string) content)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-preserves-buffer-name () + "Should preserve buffer name after move." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "myfile.txt" source-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (should (string= (buffer-name) "myfile.txt")) + (cj/--move-buffer-and-file target-dir) + (should (string= (buffer-name) "myfile.txt")) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-clears-modified-flag () + "Should clear buffer modified flag after move." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (insert "modification") + (should (buffer-modified-p)) + (cj/--move-buffer-and-file target-dir) + (should-not (buffer-modified-p)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-returns-t-on-success () + "Should return t on successful move." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (should (eq t (cj/--move-buffer-and-file target-dir))) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-deletes-source-file () + "Should delete source file after move." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-creates-target-file () + "Should create file in target directory." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +;;; Boundary Cases - Path Handling + +(ert-deftest test-move-buffer-and-file-trailing-slash-should-strip () + "Should handle directory with trailing slash." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file (concat target-dir "/")) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-trailing-backslash-should-strip () + "Should handle directory with trailing backslash." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file (concat target-dir "\\")) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-no-trailing-slash-should-work () + "Should work with directory without trailing slash." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-deeply-nested-target () + "Should move to deeply nested target directory." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "a/b/c/d/target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-relative-path-should-work () + "Should resolve relative paths relative to file's directory." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + ;; Use "../target" to go up from source/ to target/ + (cj/--move-buffer-and-file "../target") + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +;;; Boundary Cases - Character Encoding + +(ert-deftest test-move-buffer-and-file-unicode-filename () + "Should handle Unicode characters in filename." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test-café.txt" source-dir)) + (target-file (expand-file-name "test-café.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-unicode-directory () + "Should handle Unicode characters in directory name." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target-ñoño")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-emoji-in-filename () + "Should handle emoji in filename." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test-🎉-file.txt" source-dir)) + (target-file (expand-file-name "test-🎉-file.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-rtl-characters () + "Should handle RTL text in filename." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test-مرحبا.txt" source-dir)) + (target-file (expand-file-name "test-مرحبا.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-spaces-in-filename () + "Should handle spaces in filename." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test file with spaces.txt" source-dir)) + (target-file (expand-file-name "test file with spaces.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-special-chars-in-filename () + "Should handle special characters in filename." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test[file]-(1).txt" source-dir)) + (target-file (expand-file-name "test[file]-(1).txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +;;; Boundary Cases - File Naming + +(ert-deftest test-move-buffer-and-file-hidden-file () + "Should handle hidden files (starting with dot)." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name ".hidden" source-dir)) + (target-file (expand-file-name ".hidden" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-no-extension () + "Should handle files without extensions." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "README" source-dir)) + (target-file (expand-file-name "README" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-multiple-dots-in-name () + "Should handle multiple dots in filename." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "my.file.name.test.txt" source-dir)) + (target-file (expand-file-name "my.file.name.test.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-single-char-filename () + "Should handle single character filenames." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "x" source-dir)) + (target-file (expand-file-name "x" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-very-long-filename () + "Should handle very long filenames." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (long-name (concat (make-string 200 ?x) ".txt")) + (source-file (expand-file-name long-name source-dir)) + (target-file (expand-file-name long-name target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-very-long-path () + "Should handle very long paths." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((long-dir (make-string 100 ?x)) + (source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory long-dir)) + (long-filename (concat (make-string 100 ?y) ".txt")) + (source-file (expand-file-name long-filename source-dir)) + (target-file (expand-file-name long-filename target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +;;; Boundary Cases - File Content + +(ert-deftest test-move-buffer-and-file-empty-file () + "Should move empty file successfully." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "empty.txt" source-dir)) + (target-file (expand-file-name "empty.txt" target-dir))) + (with-temp-file source-file) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (should (= 0 (buffer-size))) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-large-file () + "Should move large file successfully." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "large.txt" source-dir)) + (large-content (make-string 100000 ?x))) + (with-temp-file source-file + (insert large-content)) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (string= (buffer-string) large-content)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-binary-file () + "Should move binary-like content successfully." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "binary.dat" source-dir)) + (target-file (expand-file-name "binary.dat" target-dir)) + (binary-content (string 0 1 2 3 255 254 253))) + (with-temp-file source-file + (set-buffer-multibyte nil) + (insert binary-content)) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-preserves-newlines () + "Should preserve different newline types." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "newlines.txt" source-dir)) + (content "Line 1\nLine 2\n\nLine 4\n")) + (with-temp-file source-file + (insert content)) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (string= (buffer-string) content)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-preserves-encoding () + "Should preserve UTF-8 encoded content." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "utf8.txt" source-dir)) + (content "Hello 世界 مرحبا Привет")) + (with-temp-file source-file + (insert content)) + (find-file source-file) + (cj/--move-buffer-and-file target-dir) + (should (string= (buffer-string) content)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +;;; Boundary Cases - Buffer State + +(ert-deftest test-move-buffer-and-file-with-unsaved-changes () + "Should handle buffer with unsaved changes." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir)) + (original "original")) + (with-temp-file source-file + (insert original)) + (find-file source-file) + (insert " modified") + (should (buffer-modified-p)) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (buffer-modified-p)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-with-multiple-windows () + "Should work when buffer is displayed in multiple windows." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (delete-other-windows) + (split-window) + (other-window 1) + (switch-to-buffer (get-file-buffer source-file)) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (kill-buffer (current-buffer)) + (delete-other-windows)) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-preserves-point-position () + "Should preserve point position in buffer." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (content "Line 1\nLine 2\nLine 3\n")) + (with-temp-file source-file + (insert content)) + (find-file source-file) + (goto-char (point-min)) + (forward-line 1) + (let ((original-point (point))) + (cj/--move-buffer-and-file target-dir) + (should (= (point) original-point))) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-preserves-mark () + "Should preserve mark in buffer." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (content "Line 1\nLine 2\nLine 3\n")) + (with-temp-file source-file + (insert content)) + (find-file source-file) + (goto-char (point-min)) + (set-mark (point)) + (forward-line 2) + (let ((original-mark (mark))) + (cj/--move-buffer-and-file target-dir) + (should (= (mark) original-mark))) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +;;; Error Cases - Buffer Issues + +(ert-deftest test-move-buffer-and-file-non-file-buffer-returns-nil () + "Should return nil when buffer not visiting a file." + (test-move-buffer-and-file-setup) + (unwind-protect + (let ((target-dir (cj/create-test-subdirectory "target"))) + (with-temp-buffer + (rename-buffer "non-file-buffer" t) + (let ((result (cj/--move-buffer-and-file target-dir))) + (should-not result)))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-scratch-buffer-returns-nil () + "Should return nil for scratch buffer." + (test-move-buffer-and-file-setup) + (unwind-protect + (let ((target-dir (cj/create-test-subdirectory "target"))) + (with-current-buffer "*scratch*" + (let ((result (cj/--move-buffer-and-file target-dir))) + (should-not result)))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-killed-buffer-should-error () + "Should error when operating on killed buffer." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (buf nil)) + (with-temp-file source-file + (insert "content")) + (setq buf (find-file source-file)) + (kill-buffer buf) + (should-error + (with-current-buffer buf + (cj/--move-buffer-and-file target-dir)))) + (test-move-buffer-and-file-teardown))) + +;;; Error Cases - Directory Issues + +(ert-deftest test-move-buffer-and-file-nonexistent-target-should-error () + "Should error when target directory doesn't exist." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (source-file (expand-file-name "test.txt" source-dir)) + (nonexistent-dir (expand-file-name "nonexistent" cj/test-base-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (should-error (cj/--move-buffer-and-file nonexistent-dir)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-target-is-file-not-dir-should-error () + "Should error when target is a file, not directory." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "notadir.txt" cj/test-base-dir))) + (with-temp-file target-file + (insert "I'm a file")) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (should-error (cj/--move-buffer-and-file target-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-nil-directory-should-error () + "Should error when directory is nil." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (source-file (expand-file-name "test.txt" source-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (should-error (cj/--move-buffer-and-file nil)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-empty-string-directory-should-error () + "Should error when directory is empty string." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (source-file (expand-file-name "test.txt" source-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (should-error (cj/--move-buffer-and-file "")) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +;;; Error Cases - Permission Issues + +(ert-deftest test-move-buffer-and-file-no-read-permission-source-should-error () + "Should error when source file is not readable." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (set-file-modes source-file #o000) + (should-error (cj/--move-buffer-and-file target-dir)) + (set-file-modes source-file #o644) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-no-write-permission-target-should-error () + "Should error when target directory is not writable." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir))) + (with-temp-file source-file + (insert "content")) + (set-file-modes target-dir #o555) + (find-file source-file) + (should-error (cj/--move-buffer-and-file target-dir)) + (set-file-modes target-dir #o755) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-no-delete-permission-source-should-error () + "Should error when source directory doesn't allow deletion." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (set-file-modes source-dir #o555) + (should-error (cj/--move-buffer-and-file target-dir)) + (set-file-modes source-dir #o755) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +;;; Error Cases - File Conflicts + +(ert-deftest test-move-buffer-and-file-target-exists-should-overwrite () + "Should overwrite existing file when ok-if-exists is t." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir)) + (new-content "New content") + (old-content "Old content")) + (with-temp-file target-file + (insert old-content)) + (with-temp-file source-file + (insert new-content)) + (find-file source-file) + (cj/--move-buffer-and-file target-dir t) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (revert-buffer t t) + (should (string= (buffer-string) new-content)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-target-exists-should-error-if-not-ok () + "Should error when target exists and ok-if-exists is nil." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir))) + (with-temp-file target-file + (insert "existing")) + (with-temp-file source-file + (insert "new")) + (find-file source-file) + (should-error (cj/--move-buffer-and-file target-dir nil)) + ;; Source should still exist since move failed + (should (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-interactive-prompts-if-target-exists () + "Should prompt user when called interactively and target exists." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir)) + (prompted nil)) + (with-temp-file target-file + (insert "existing")) + (with-temp-file source-file + (insert "new")) + (find-file source-file) + ;; Mock yes-or-no-p to capture that it was called + (cl-letf (((symbol-function 'yes-or-no-p) + (lambda (prompt) + (setq prompted t) + t)) + ((symbol-function 'read-directory-name) + (lambda (&rest _) target-dir))) + (call-interactively #'cj/move-buffer-and-file) + (should prompted)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-interactive-no-prompt-if-target-missing () + "Should not prompt when called interactively if target doesn't exist." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (prompted nil)) + (with-temp-file source-file + (insert "new")) + (find-file source-file) + ;; Mock yes-or-no-p to capture if it was called + (cl-letf (((symbol-function 'yes-or-no-p) + (lambda (prompt) + (setq prompted t) + t)) + ((symbol-function 'read-directory-name) + (lambda (&rest _) target-dir))) + (call-interactively #'cj/move-buffer-and-file) + (should-not prompted)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-source-deleted-during-operation-should-error () + "Should error if source file is deleted during operation." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (delete-file source-file) + (should-error (cj/--move-buffer-and-file target-dir)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +;;; Error Cases - Edge Cases + +(ert-deftest test-move-buffer-and-file-symlink-source-should-handle () + "Should handle symbolic link as source." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (real-file (expand-file-name "real.txt" source-dir)) + (symlink (expand-file-name "link.txt" source-dir)) + (target-file (expand-file-name "link.txt" target-dir))) + (with-temp-file real-file + (insert "content")) + (make-symbolic-link real-file symlink) + (find-file symlink) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(ert-deftest test-move-buffer-and-file-read-only-buffer-should-still-work () + "Should work even if buffer is read-only." + (test-move-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (source-file (expand-file-name "test.txt" source-dir)) + (target-file (expand-file-name "test.txt" target-dir))) + (with-temp-file source-file + (insert "content")) + (find-file source-file) + (read-only-mode 1) + (cj/--move-buffer-and-file target-dir) + (should (file-exists-p target-file)) + (should-not (file-exists-p source-file)) + (kill-buffer (current-buffer))) + (test-move-buffer-and-file-teardown))) + +(provide 'test-custom-buffer-file-move-buffer-and-file) +;;; test-custom-buffer-file-move-buffer-and-file.el ends here diff --git a/tests/test-custom-buffer-file-rename-buffer-and-file.el b/tests/test-custom-buffer-file-rename-buffer-and-file.el new file mode 100644 index 00000000..1eb61f1b --- /dev/null +++ b/tests/test-custom-buffer-file-rename-buffer-and-file.el @@ -0,0 +1,939 @@ +;;; test-custom-buffer-file-rename-buffer-and-file.el --- Tests for cj/--rename-buffer-and-file -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--rename-buffer-and-file function from custom-buffer-file.el +;; +;; This is the internal (non-interactive) implementation that renames both the +;; current buffer and its visited file. The interactive wrapper +;; cj/rename-buffer-and-file handles user prompting and delegates to this +;; implementation. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub ps-print package +(provide 'ps-print) + +;; Now load the actual production module +(require 'custom-buffer-file) + +;;; Setup and Teardown + +(defun test-rename-buffer-and-file-setup () + "Setup for rename-buffer-and-file tests." + (cj/create-test-base-dir)) + +(defun test-rename-buffer-and-file-teardown () + "Teardown for rename-buffer-and-file tests." + ;; Kill all buffers visiting files in test directory + (dolist (buf (buffer-list)) + (when (buffer-file-name buf) + (when (string-prefix-p cj/test-base-dir (buffer-file-name buf)) + (with-current-buffer buf + (set-buffer-modified-p nil)) + (kill-buffer buf)))) + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-rename-buffer-and-file-simple-rename () + "Should rename file in same directory." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "new.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "new.txt") + (should (file-exists-p new-file)) + (should-not (file-exists-p old-file)) + (should (string= (buffer-name) "new.txt")) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-different-directory () + "Should rename to absolute path in different directory." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (old-file (expand-file-name "file.txt" source-dir)) + (new-file (expand-file-name "renamed.txt" target-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file new-file) + (should (file-exists-p new-file)) + (should-not (file-exists-p old-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-different-extension () + "Should change file extension." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "file.txt" test-dir)) + (new-file (expand-file-name "file.md" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "file.md") + (should (file-exists-p new-file)) + (should-not (file-exists-p old-file)) + (should (string= (buffer-name) "file.md")) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-preserves-content () + "Should preserve file content after rename." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (content "Important content\nWith multiple lines")) + (with-temp-file old-file + (insert content)) + (find-file old-file) + (cj/--rename-buffer-and-file "new.txt") + (should (string= (buffer-string) content)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-updates-buffer-name () + "Should update buffer name to match new filename." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (should (string= (buffer-name) "old.txt")) + (cj/--rename-buffer-and-file "new.txt") + (should (string= (buffer-name) "new.txt")) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-updates-buffer-file-name () + "Should update buffer-file-name correctly." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "new.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "new.txt") + (should (string= (buffer-file-name) new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-clears-modified-flag () + "Should clear modified flag after rename." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (insert "modification") + (should (buffer-modified-p)) + (cj/--rename-buffer-and-file "new.txt") + (should-not (buffer-modified-p)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-returns-t-on-success () + "Should return t when successful." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (should (eq t (cj/--rename-buffer-and-file "new.txt"))) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +;;; Boundary Cases - Naming + +(ert-deftest test-rename-buffer-and-file-unicode-in-name () + "Should handle Unicode characters in name." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "café.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "café.txt") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-emoji-in-name () + "Should handle emoji characters in name." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "test-🎉.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "test-🎉.txt") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-rtl-text-in-name () + "Should handle RTL text in name." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "مرحبا.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "مرحبا.txt") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-spaces-in-name () + "Should handle spaces in name." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "my new file.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "my new file.txt") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-special-chars-in-name () + "Should handle special characters in name." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "[test]-(1).txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "[test]-(1).txt") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-very-long-name () + "Should handle very long filename." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (long-name (concat (make-string 200 ?x) ".txt")) + (new-file (expand-file-name long-name test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file long-name) + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-single-char-name () + "Should handle single character name." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "x" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "x") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-multiple-dots () + "Should handle multiple dots in name." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "my.file.name.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "my.file.name.txt") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-no-extension () + "Should handle files without extension." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "README" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "README") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-hidden-file () + "Should handle hidden files (starting with dot)." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name ".hidden" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file ".hidden") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-trailing-whitespace () + "Should handle trailing/leading spaces in name." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name " spaced " test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file " spaced ") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-only-changes-case () + "Should handle case-only rename on case-sensitive filesystems." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "test.txt" test-dir)) + (new-file (expand-file-name "TEST.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + ;; On case-insensitive systems, need ok-if-exists + (cj/--rename-buffer-and-file "TEST.txt" t) + (should (string= (buffer-name) "TEST.txt")) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-adds-extension () + "Should handle adding extension to file." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "file" test-dir)) + (new-file (expand-file-name "file.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "file.txt") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-removes-extension () + "Should handle removing extension from file." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "file.txt" test-dir)) + (new-file (expand-file-name "file" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "file") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-just-extension () + "Should handle name that is just extension." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name ".gitignore" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file ".gitignore") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +;;; Boundary Cases - Path Handling + +(ert-deftest test-rename-buffer-and-file-relative-path () + "Should handle relative path." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (old-file (expand-file-name "file.txt" source-dir)) + (new-file (expand-file-name "renamed.txt" target-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "../target/renamed.txt") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-absolute-path () + "Should handle absolute path." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (old-file (expand-file-name "file.txt" source-dir)) + (new-file (expand-file-name "renamed.txt" target-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file new-file) + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-parent-directory () + "Should handle parent directory reference." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((parent-dir (cj/create-test-subdirectory "parent")) + (source-dir (cj/create-test-subdirectory "parent/source")) + (old-file (expand-file-name "file.txt" source-dir)) + (new-file (expand-file-name "renamed.txt" parent-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "../renamed.txt") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-deeply-nested-target () + "Should handle deeply nested target directory." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "a/b/c/d/target")) + (old-file (expand-file-name "file.txt" source-dir)) + (new-file (expand-file-name "renamed.txt" target-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file new-file) + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-same-directory-basename-only () + "Should rename in same directory using just basename." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "new.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file "new.txt") + (should (file-exists-p new-file)) + (should-not (file-exists-p old-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-expand-tilde () + "Should expand tilde in path." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + ;; Use a path relative to home that we can create + (home-test-dir (expand-file-name "temp-test-rename" "~")) + (new-file (expand-file-name "renamed.txt" home-test-dir))) + (make-directory home-test-dir t) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (cj/--rename-buffer-and-file (concat "~/temp-test-rename/renamed.txt")) + (should (file-exists-p new-file)) + (kill-buffer (current-buffer)) + (delete-directory home-test-dir t)) + (test-rename-buffer-and-file-teardown))) + +;;; Boundary Cases - File Content + +(ert-deftest test-rename-buffer-and-file-empty-file () + "Should handle empty file." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "new.txt" test-dir))) + (with-temp-file old-file) + (find-file old-file) + (cj/--rename-buffer-and-file "new.txt") + (should (file-exists-p new-file)) + (should (= 0 (buffer-size))) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-large-file () + "Should handle large file." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (large-content (make-string 100000 ?x))) + (with-temp-file old-file + (insert large-content)) + (find-file old-file) + (cj/--rename-buffer-and-file "new.txt") + (should (string= (buffer-string) large-content)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-binary-content () + "Should handle binary content." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.dat" test-dir)) + (new-file (expand-file-name "new.dat" test-dir)) + (binary-content (string 0 1 2 3 255 254 253))) + (with-temp-file old-file + (set-buffer-multibyte nil) + (insert binary-content)) + (find-file old-file) + (cj/--rename-buffer-and-file "new.dat") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-preserves-newlines () + "Should preserve different newline types." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (content "Line 1\nLine 2\n\nLine 4\n")) + (with-temp-file old-file + (insert content)) + (find-file old-file) + (cj/--rename-buffer-and-file "new.txt") + (should (string= (buffer-string) content)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-preserves-encoding () + "Should preserve UTF-8 encoded content." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (content "Hello 世界 مرحبا Привет")) + (with-temp-file old-file + (insert content)) + (find-file old-file) + (cj/--rename-buffer-and-file "new.txt") + (should (string= (buffer-string) content)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +;;; Boundary Cases - Buffer State + +(ert-deftest test-rename-buffer-and-file-with-unsaved-changes () + "Should handle buffer with unsaved changes." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir))) + (with-temp-file old-file + (insert "original")) + (find-file old-file) + (insert " modified") + (should (buffer-modified-p)) + (cj/--rename-buffer-and-file "new.txt") + (should-not (buffer-modified-p)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-multiple-windows () + "Should work when buffer displayed in multiple windows." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (delete-other-windows) + (split-window) + (other-window 1) + (switch-to-buffer (get-file-buffer old-file)) + (cj/--rename-buffer-and-file "new.txt") + (should (string= (buffer-name) "new.txt")) + (kill-buffer (current-buffer)) + (delete-other-windows)) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-preserves-point () + "Should preserve point position." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (content "Line 1\nLine 2\nLine 3\n")) + (with-temp-file old-file + (insert content)) + (find-file old-file) + (goto-char (point-min)) + (forward-line 1) + (let ((original-point (point))) + (cj/--rename-buffer-and-file "new.txt") + (should (= (point) original-point))) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-preserves-mark () + "Should preserve mark." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (content "Line 1\nLine 2\nLine 3\n")) + (with-temp-file old-file + (insert content)) + (find-file old-file) + (goto-char (point-min)) + (set-mark (point)) + (forward-line 2) + (let ((original-mark (mark))) + (cj/--rename-buffer-and-file "new.txt") + (should (= (mark) original-mark))) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-read-only-buffer () + "Should work even with read-only buffer." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "new.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (read-only-mode 1) + (cj/--rename-buffer-and-file "new.txt") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +;;; Error Cases - Buffer Issues + +(ert-deftest test-rename-buffer-and-file-non-file-buffer-returns-nil () + "Should return nil when buffer not visiting file." + (test-rename-buffer-and-file-setup) + (unwind-protect + (with-temp-buffer + (rename-buffer "non-file-buffer" t) + (let ((result (cj/--rename-buffer-and-file "new.txt"))) + (should-not result))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-scratch-buffer-returns-nil () + "Should return nil for scratch buffer." + (test-rename-buffer-and-file-setup) + (unwind-protect + (with-current-buffer "*scratch*" + (let ((result (cj/--rename-buffer-and-file "new.txt"))) + (should-not result))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-buffer-name-exists-should-error () + "Should error when buffer with new name exists." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (file1 (expand-file-name "file1.txt" test-dir)) + (file2 (expand-file-name "file2.txt" test-dir))) + (with-temp-file file1 + (insert "content1")) + (with-temp-file file2 + (insert "content2")) + (find-file file1) + (let ((buf1 (current-buffer))) + (find-file file2) + ;; Try to rename file2 to file1.txt (buffer exists) + (should-error (cj/--rename-buffer-and-file "file1.txt")) + (kill-buffer (current-buffer)) + (kill-buffer buf1))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-killed-buffer-should-error () + "Should error when operating on killed buffer." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (buf nil)) + (with-temp-file old-file + (insert "content")) + (setq buf (find-file old-file)) + (kill-buffer buf) + (should-error + (with-current-buffer buf + (cj/--rename-buffer-and-file "new.txt")))) + (test-rename-buffer-and-file-teardown))) + +;;; Error Cases - File Conflicts + +(ert-deftest test-rename-buffer-and-file-target-exists-should-error-if-not-ok () + "Should error when target exists and ok-if-exists is nil." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "new.txt" test-dir))) + (with-temp-file old-file + (insert "old content")) + (with-temp-file new-file + (insert "existing content")) + (find-file old-file) + (should-error (cj/--rename-buffer-and-file "new.txt" nil)) + ;; Old file should still exist since rename failed + (should (file-exists-p old-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-target-exists-should-overwrite-if-ok () + "Should overwrite when target exists and ok-if-exists is t." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "new.txt" test-dir)) + (old-content "old content") + (new-content "existing content")) + (with-temp-file old-file + (insert old-content)) + (with-temp-file new-file + (insert new-content)) + (find-file old-file) + (cj/--rename-buffer-and-file "new.txt" t) + (should (file-exists-p new-file)) + (should-not (file-exists-p old-file)) + ;; Content should be from old file + (revert-buffer t t) + (should (string= (buffer-string) old-content)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-source-deleted-should-error () + "Should error if source file deleted during operation." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (delete-file old-file) + (should-error (cj/--rename-buffer-and-file "new.txt")) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-same-name-is-noop () + "Should handle rename to same name as no-op." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "file.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + ;; Rename to same name with ok-if-exists + (cj/--rename-buffer-and-file "file.txt" t) + (should (file-exists-p old-file)) + (should (string= (buffer-name) "file.txt")) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +;;; Error Cases - Path Issues + +(ert-deftest test-rename-buffer-and-file-nil-name-should-error () + "Should error when new-name is nil." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (should-error (cj/--rename-buffer-and-file nil)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-empty-name-should-error () + "Should error when new-name is empty string." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (should-error (cj/--rename-buffer-and-file "")) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-nonexistent-target-dir-should-error () + "Should error when target directory doesn't exist." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (nonexistent-path (expand-file-name "nonexistent/new.txt" cj/test-base-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (should-error (cj/--rename-buffer-and-file nonexistent-path)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-target-is-directory-should-error () + "Should error when new-name is existing directory." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (target-dir (cj/create-test-subdirectory "target")) + (old-file (expand-file-name "old.txt" test-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (should-error (cj/--rename-buffer-and-file target-dir)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +;;; Error Cases - Permissions + +(ert-deftest test-rename-buffer-and-file-no-write-permission-target () + "Should error when target directory not writable." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (old-file (expand-file-name "old.txt" source-dir)) + (new-file (expand-file-name "new.txt" target-dir))) + (with-temp-file old-file + (insert "content")) + (set-file-modes target-dir #o555) + (find-file old-file) + (should-error (cj/--rename-buffer-and-file new-file)) + (set-file-modes target-dir #o755) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-no-delete-permission-source-dir () + "Should error when source directory doesn't allow deletion." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((source-dir (cj/create-test-subdirectory "source")) + (target-dir (cj/create-test-subdirectory "target")) + (old-file (expand-file-name "old.txt" source-dir)) + (new-file (expand-file-name "new.txt" target-dir))) + (with-temp-file old-file + (insert "content")) + (find-file old-file) + (set-file-modes source-dir #o555) + (should-error (cj/--rename-buffer-and-file new-file)) + (set-file-modes source-dir #o755) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +;;; Error Cases - Edge Cases + +(ert-deftest test-rename-buffer-and-file-symlink-source () + "Should handle symbolic link as source." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (real-file (expand-file-name "real.txt" test-dir)) + (symlink (expand-file-name "link.txt" test-dir)) + (new-file (expand-file-name "renamed.txt" test-dir))) + (with-temp-file real-file + (insert "content")) + (make-symbolic-link real-file symlink) + (find-file symlink) + (cj/--rename-buffer-and-file "renamed.txt") + (should (file-exists-p new-file)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(ert-deftest test-rename-buffer-and-file-interactive-prompts-on-conflict () + "Should prompt user when called interactively and file exists." + (test-rename-buffer-and-file-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "test")) + (old-file (expand-file-name "old.txt" test-dir)) + (new-file (expand-file-name "new.txt" test-dir)) + (prompted nil)) + (with-temp-file old-file + (insert "old")) + (with-temp-file new-file + (insert "existing")) + (find-file old-file) + ;; Mock yes-or-no-p to capture that it was called + (cl-letf (((symbol-function 'yes-or-no-p) + (lambda (prompt) + (setq prompted t) + t)) + ((symbol-function 'read-string) + (lambda (&rest _) "new.txt"))) + (call-interactively #'cj/rename-buffer-and-file) + (should prompted)) + (kill-buffer (current-buffer))) + (test-rename-buffer-and-file-teardown))) + +(provide 'test-custom-buffer-file-rename-buffer-and-file) +;;; test-custom-buffer-file-rename-buffer-and-file.el ends here diff --git a/tests/test-custom-comments-comment-block-banner.el b/tests/test-custom-comments-comment-block-banner.el new file mode 100644 index 00000000..6561ebfa --- /dev/null +++ b/tests/test-custom-comments-comment-block-banner.el @@ -0,0 +1,228 @@ +;;; test-custom-comments-comment-block-banner.el --- Tests for cj/comment-block-banner -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/comment-block-banner function from custom-comments.el +;; +;; This function generates a 3-line block banner comment (JSDoc/Doxygen style): +;; - Top line: comment-start (e.g., /*) + decoration chars +;; - Text line: space + decoration char + space + text +;; - Bottom line: space + decoration chars + comment-end (e.g., */) +;; +;; This style is common in C, JavaScript, Java, and other languages that use +;; block comments. +;; +;; We test the NON-INTERACTIVE implementation (cj/--comment-block-banner) +;; to avoid mocking user prompts. This follows our testing best practice +;; of separating business logic from UI interaction. +;; +;; Cross-Language Testing Strategy: +;; - Comprehensive testing in C (the primary language for this style) +;; - Representative testing in JavaScript/Java (similar block comment syntax) +;; - This style is specifically designed for block comments, so we focus +;; testing on languages that use /* */ syntax +;; - See test-custom-comments-delete-buffer-comments.el for detailed rationale + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-comments) + +;;; Test Helpers + +(defun test-block-banner-at-column (column-pos comment-start comment-end decoration-char text length) + "Test cj/--comment-block-banner at COLUMN-POS indentation. +Insert spaces to reach COLUMN-POS, then call cj/--comment-block-banner with +COMMENT-START, COMMENT-END, DECORATION-CHAR, TEXT, and LENGTH. +Returns the buffer string for assertions." + (with-temp-buffer + (when (> column-pos 0) + (insert (make-string column-pos ?\s))) + (cj/--comment-block-banner comment-start comment-end decoration-char text length) + (buffer-string))) + +;;; C/JavaScript/Java Tests (Block Comment Languages - Comprehensive Coverage) + +;;; Normal Cases + +(ert-deftest test-block-banner-c-basic () + "Should generate 3-line block banner in C style." + (let ((result (test-block-banner-at-column 0 "/*" "*/" "*" "Section Header" 70))) + ;; Should have 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; First line should start with /* + (should (string-match-p "^/\\*\\*" result)) + ;; Middle line should contain text + (should (string-match-p "\\* Section Header" result)) + ;; Last line should end with */ + (should (string-match-p "\\*/$" result)))) + +(ert-deftest test-block-banner-c-custom-decoration () + "Should use custom decoration character." + (let ((result (test-block-banner-at-column 0 "/*" "*/" "#" "Header" 70))) + (should (string-match-p "/\\*#" result)) + (should (string-match-p " # Header" result)))) + +(ert-deftest test-block-banner-c-custom-text () + "Should include custom text in banner." + (let ((result (test-block-banner-at-column 0 "/*" "*/" "*" "Custom Text Here" 70))) + (should (string-match-p "Custom Text Here" result)))) + +(ert-deftest test-block-banner-c-empty-text () + "Should handle empty text string." + (let ((result (test-block-banner-at-column 0 "/*" "*/" "*" "" 70))) + ;; Should still generate 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Should have comment delimiters + (should (string-match-p "/\\*" result)) + (should (string-match-p "\\*/$" result)))) + +(ert-deftest test-block-banner-c-at-column-0 () + "Should work at column 0." + (let ((result (test-block-banner-at-column 0 "/*" "*/" "*" "Header" 70))) + ;; First character should be / + (should (string-prefix-p "/*" result)))) + +(ert-deftest test-block-banner-c-indented () + "Should work when indented." + (let ((result (test-block-banner-at-column 4 "/*" "*/" "*" "Header" 70))) + ;; First line should start with spaces + (should (string-prefix-p " /*" result)) + ;; Other lines should be indented + (let ((lines (split-string result "\n" t))) + (should (string-prefix-p " " (nth 1 lines))) ; text line has extra space + (should (string-prefix-p " " (nth 2 lines)))))) ; bottom line has extra space + +(ert-deftest test-block-banner-c-short-text () + "Should handle short text properly." + (let ((result (test-block-banner-at-column 0 "/*" "*/" "*" "X" 70))) + ;; Should have 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Text should be present + (should (string-match-p "X" result)))) + +(ert-deftest test-block-banner-c-long-text () + "Should handle longer text." + (let ((result (test-block-banner-at-column 0 "/*" "*/" "*" "This is a longer header text" 70))) + ;; Should have 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Text should be present + (should (string-match-p "This is a longer header text" result)))) + +(ert-deftest test-block-banner-c-custom-length () + "Should respect custom length." + (let ((result (test-block-banner-at-column 0 "/*" "*/" "*" "Header" 50))) + ;; Top line should be approximately 50 chars + (let ((first-line (car (split-string result "\n" t)))) + (should (<= (length first-line) 51)) + (should (>= (length first-line) 48))))) + +;;; Boundary Cases + +(ert-deftest test-block-banner-c-minimum-length () + "Should work with minimum viable length." + (let ((result (test-block-banner-at-column 0 "/*" "*/" "*" "X" 10))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "X" result)))) + +(ert-deftest test-block-banner-c-very-long-length () + "Should handle very long length." + (let ((result (test-block-banner-at-column 0 "/*" "*/" "*" "Header" 200))) + (should (= 3 (length (split-string result "\n" t)))) + ;; Top line should be very long + (let ((first-line (car (split-string result "\n" t)))) + (should (> (length first-line) 100))))) + +(ert-deftest test-block-banner-c-unicode-decoration () + "Should handle unicode decoration character." + (let ((result (test-block-banner-at-column 0 "/*" "*/" "✦" "Header" 70))) + (should (string-match-p "✦" result)))) + +(ert-deftest test-block-banner-c-unicode-text () + "Should handle unicode in text." + (let ((result (test-block-banner-at-column 0 "/*" "*/" "*" "Hello 👋 مرحبا café" 70))) + (should (string-match-p "👋" result)) + (should (string-match-p "مرحبا" result)) + (should (string-match-p "café" result)))) + +(ert-deftest test-block-banner-c-very-long-text () + "Should handle very long text." + (let* ((long-text (make-string 100 ?x)) + (result (test-block-banner-at-column 0 "/*" "*/" "*" long-text 70))) + ;; Should still generate output + (should (= 3 (length (split-string result "\n" t)))) + ;; Middle line should contain some of the text + (should (string-match-p "xxx" result)))) + +(ert-deftest test-block-banner-c-max-indentation () + "Should handle maximum practical indentation." + (let ((result (test-block-banner-at-column 60 "/*" "*/" "*" "Header" 100))) + (should (= 3 (length (split-string result "\n" t)))) + ;; First line should start with 60 spaces + (should (string-prefix-p (make-string 60 ?\s) result)))) + +;;; Error Cases + +(ert-deftest test-block-banner-c-length-too-small () + "Should error when length is too small." + (should-error + (test-block-banner-at-column 0 "/*" "*/" "*" "Header" 3) + :type 'error)) + +(ert-deftest test-block-banner-c-negative-length () + "Should error with negative length." + (should-error + (test-block-banner-at-column 0 "/*" "*/" "*" "Header" -10) + :type 'error)) + +(ert-deftest test-block-banner-c-zero-length () + "Should error with zero length." + (should-error + (test-block-banner-at-column 0 "/*" "*/" "*" "Header" 0) + :type 'error)) + +(ert-deftest test-block-banner-c-nil-decoration () + "Should error when decoration-char is nil." + (should-error + (test-block-banner-at-column 0 "/*" "*/" nil "Header" 70) + :type 'wrong-type-argument)) + +(ert-deftest test-block-banner-c-nil-text () + "Should error when text is nil." + (should-error + (test-block-banner-at-column 0 "/*" "*/" "*" nil 70) + :type 'wrong-type-argument)) + +(ert-deftest test-block-banner-c-non-integer-length () + "Should error when length is not an integer." + (should-error + (test-block-banner-at-column 0 "/*" "*/" "*" "Header" "not-a-number") + :type 'wrong-type-argument)) + +;;; Alternative Block Comment Styles + +(ert-deftest test-block-banner-java-style () + "Should work with Java-style block comments." + (let ((result (test-block-banner-at-column 0 "/**" "*/" "*" "JavaDoc Comment" 70))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "^/\\*\\*\\*" result)) + (should (string-match-p "JavaDoc Comment" result)))) + +(ert-deftest test-block-banner-js-style () + "Should work with JavaScript-style block comments." + (let ((result (test-block-banner-at-column 2 "/*" "*/" "*" "Function Documentation" 70))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-prefix-p " /*" result)) + (should (string-match-p "Function Documentation" result)))) + +(provide 'test-custom-comments-comment-block-banner) +;;; test-custom-comments-comment-block-banner.el ends here diff --git a/tests/test-custom-comments-comment-box.el b/tests/test-custom-comments-comment-box.el new file mode 100644 index 00000000..10b1a67d --- /dev/null +++ b/tests/test-custom-comments-comment-box.el @@ -0,0 +1,241 @@ +;;; test-custom-comments-comment-box.el --- Tests for cj/comment-box -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/comment-box function from custom-comments.el +;; +;; This function generates a 3-line box comment: +;; - Top border: comment-start + full decoration line +;; - Text line: comment-start + decoration + spaces + text + spaces + decoration +;; - Bottom border: comment-start + full decoration line +;; +;; The text is centered within the box with decoration characters on the sides. +;; +;; We test the NON-INTERACTIVE implementation (cj/--comment-box) +;; to avoid mocking user prompts. This follows our testing best practice +;; of separating business logic from UI interaction. +;; +;; Cross-Language Testing Strategy: +;; - Comprehensive testing in Emacs Lisp (our primary language) +;; - Representative testing in Python and C (hash-based and C-style comments) +;; - Function handles comment syntax generically, so testing 3 syntaxes +;; proves cross-language compatibility +;; - See test-custom-comments-delete-buffer-comments.el for detailed rationale + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-comments) + +;;; Test Helpers + +(defun test-comment-box-at-column (column-pos comment-start comment-end decoration-char text length) + "Test cj/--comment-box at COLUMN-POS indentation. +Insert spaces to reach COLUMN-POS, then call cj/--comment-box with +COMMENT-START, COMMENT-END, DECORATION-CHAR, TEXT, and LENGTH. +Returns the buffer string for assertions." + (with-temp-buffer + (when (> column-pos 0) + (insert (make-string column-pos ?\s))) + (cj/--comment-box comment-start comment-end decoration-char text length) + (buffer-string))) + +;;; Emacs Lisp Tests (Primary Language - Comprehensive Coverage) + +;;; Normal Cases + +(ert-deftest test-comment-box-elisp-basic () + "Should generate 3-line box in emacs-lisp style." + (let ((result (test-comment-box-at-column 0 ";;" "" "-" "Section Header" 70))) + ;; Should have 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; First line should start with ;; and have decoration + (should (string-match-p "^;; -" result)) + ;; Middle line should contain text with side borders + (should (string-match-p ";; - .* Section Header .* - ;;" result)) + ;; Should have top and bottom borders + (should (string-match-p "^;; -" result)))) + +(ert-deftest test-comment-box-elisp-custom-decoration () + "Should use custom decoration character." + (let ((result (test-comment-box-at-column 0 ";;" "" "*" "Header" 70))) + (should (string-match-p ";; \\*" result)) + (should-not (string-match-p "-" result)))) + +(ert-deftest test-comment-box-elisp-custom-text () + "Should include custom text centered in box." + (let ((result (test-comment-box-at-column 0 ";;" "" "-" "Custom Text Here" 70))) + (should (string-match-p "Custom Text Here" result)))) + +(ert-deftest test-comment-box-elisp-empty-text () + "Should handle empty text string." + (let ((result (test-comment-box-at-column 0 ";;" "" "-" "" 70))) + ;; Should still generate 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Should have side borders + (should (string-match-p "- .*-" result)))) + +(ert-deftest test-comment-box-elisp-at-column-0 () + "Should work at column 0." + (let ((result (test-comment-box-at-column 0 ";;" "" "-" "Header" 70))) + ;; First character should be semicolon + (should (string-prefix-p ";;" result)))) + +(ert-deftest test-comment-box-elisp-indented () + "Should work when indented." + (let ((result (test-comment-box-at-column 4 ";;" "" "-" "Header" 70))) + ;; First line should start with spaces + (should (string-prefix-p " ;;" result)) + ;; Other lines should be indented + (let ((lines (split-string result "\n" t))) + (should (string-prefix-p " " (nth 1 lines))) + (should (string-prefix-p " " (nth 2 lines)))))) + +(ert-deftest test-comment-box-elisp-short-text () + "Should center short text properly." + (let ((result (test-comment-box-at-column 0 ";;" "" "-" "X" 70))) + ;; Should have 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Text should be present and centered + (should (string-match-p "- .* X .* -" result)))) + +(ert-deftest test-comment-box-elisp-long-text () + "Should handle longer text." + (let ((result (test-comment-box-at-column 0 ";;" "" "-" "This is a longer header text" 70))) + ;; Should have 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Text should be present + (should (string-match-p "This is a longer header text" result)))) + +;;; Boundary Cases + +(ert-deftest test-comment-box-elisp-minimum-length () + "Should work with minimum viable length." + (let ((result (test-comment-box-at-column 0 ";;" "" "-" "X" 15))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "X" result)))) + +(ert-deftest test-comment-box-elisp-very-long-length () + "Should handle very long length." + (let ((result (test-comment-box-at-column 0 ";;" "" "-" "Header" 200))) + (should (= 3 (length (split-string result "\n" t)))) + ;; Border lines should be very long + (let ((first-line (car (split-string result "\n" t)))) + (should (> (length first-line) 100))))) + +(ert-deftest test-comment-box-elisp-unicode-decoration () + "Should handle unicode decoration character." + (let ((result (test-comment-box-at-column 0 ";;" "" "═" "Header" 70))) + (should (string-match-p "═" result)))) + +(ert-deftest test-comment-box-elisp-unicode-text () + "Should handle unicode in text." + (let ((result (test-comment-box-at-column 0 ";;" "" "-" "Hello 👋 مرحبا café" 70))) + (should (string-match-p "👋" result)) + (should (string-match-p "مرحبا" result)) + (should (string-match-p "café" result)))) + +(ert-deftest test-comment-box-elisp-very-long-text () + "Should handle very long text." + (let* ((long-text (make-string 100 ?x)) + (result (test-comment-box-at-column 0 ";;" "" "-" long-text 70))) + ;; Should still generate output + (should (= 3 (length (split-string result "\n" t)))) + ;; Middle line should contain some of the text + (should (string-match-p "xxx" result)))) + +(ert-deftest test-comment-box-elisp-comment-end-symmetric () + "Should use symmetric comment syntax when comment-end is empty." + (let ((result (test-comment-box-at-column 0 ";;" "" "-" "Header" 70))) + (should (= 3 (length (split-string result "\n" t)))) + ;; Should use ;; on both sides for symmetry + (should (string-match-p ";;.*;;$" result)))) + +(ert-deftest test-comment-box-elisp-max-indentation () + "Should handle maximum practical indentation." + (let ((result (test-comment-box-at-column 60 ";;" "" "-" "Header" 100))) + (should (= 3 (length (split-string result "\n" t)))) + ;; First line should start with 60 spaces + (should (string-prefix-p (make-string 60 ?\s) result)))) + +(ert-deftest test-comment-box-elisp-text-centering-even () + "Should center text properly with even length." + (let ((result (test-comment-box-at-column 0 ";;" "" "-" "EVEN" 70))) + ;; Text should be centered (roughly equal padding on both sides) + (should (string-match-p "- .* EVEN .* -" result)))) + +(ert-deftest test-comment-box-elisp-text-centering-odd () + "Should center text properly with odd length." + (let ((result (test-comment-box-at-column 0 ";;" "" "-" "ODD" 70))) + ;; Text should be centered (roughly equal padding on both sides) + (should (string-match-p "- .* ODD .* -" result)))) + +;;; Error Cases + +(ert-deftest test-comment-box-elisp-length-too-small () + "Should error when length is too small." + (should-error + (test-comment-box-at-column 0 ";;" "" "-" "Header" 5) + :type 'error)) + +(ert-deftest test-comment-box-elisp-negative-length () + "Should error with negative length." + (should-error + (test-comment-box-at-column 0 ";;" "" "-" "Header" -10) + :type 'error)) + +(ert-deftest test-comment-box-elisp-zero-length () + "Should error with zero length." + (should-error + (test-comment-box-at-column 0 ";;" "" "-" "Header" 0) + :type 'error)) + +(ert-deftest test-comment-box-elisp-nil-decoration () + "Should error when decoration-char is nil." + (should-error + (test-comment-box-at-column 0 ";;" "" nil "Header" 70) + :type 'wrong-type-argument)) + +(ert-deftest test-comment-box-elisp-non-integer-length () + "Should error when length is not an integer." + (should-error + (test-comment-box-at-column 0 ";;" "" "-" "Header" "not-a-number") + :type 'wrong-type-argument)) + +;;; Python Tests (Hash-based comments) + +(ert-deftest test-comment-box-python-basic () + "Should generate box with Python comment syntax." + (let ((result (test-comment-box-at-column 0 "#" "" "-" "Section" 70))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "^# -" result)) + (should (string-match-p "Section" result)))) + +(ert-deftest test-comment-box-python-indented () + "Should handle indented Python comments." + (let ((result (test-comment-box-at-column 4 "#" "" "#" "Function Section" 70))) + (should (string-prefix-p " #" result)) + (should (string-match-p "Function Section" result)))) + +;;; C Tests (C-style comments) + +(ert-deftest test-comment-box-c-block-comments () + "Should generate box with C block comment syntax." + (let ((result (test-comment-box-at-column 0 "/*" "*/" "-" "Section" 70))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "^/\\* -" result)) + (should (string-match-p "Section" result)) + ;; Should include comment-end + (should (string-match-p "\\*/" result)))) + +(provide 'test-custom-comments-comment-box) +;;; test-custom-comments-comment-box.el ends here diff --git a/tests/test-custom-comments-comment-heavy-box.el b/tests/test-custom-comments-comment-heavy-box.el new file mode 100644 index 00000000..30289625 --- /dev/null +++ b/tests/test-custom-comments-comment-heavy-box.el @@ -0,0 +1,251 @@ +;;; test-custom-comments-comment-heavy-box.el --- Tests for cj/comment-heavy-box -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/comment-heavy-box function from custom-comments.el +;; +;; This function generates a 5-line heavy box comment: +;; - Top border: comment-start + full decoration line +;; - Empty line: decoration char + spaces + decoration char +;; - Centered text: decoration char + spaces + text + spaces + decoration char +;; - Empty line: decoration char + spaces + decoration char +;; - Bottom border: comment-start + full decoration line +;; +;; The text is centered within the box with padding on both sides. +;; +;; We test the NON-INTERACTIVE implementation (cj/--comment-heavy-box) +;; to avoid mocking user prompts. This follows our testing best practice +;; of separating business logic from UI interaction. +;; +;; Cross-Language Testing Strategy: +;; - Comprehensive testing in Emacs Lisp (our primary language) +;; - Representative testing in Python and C (hash-based and C-style comments) +;; - Function handles comment syntax generically, so testing 3 syntaxes +;; proves cross-language compatibility +;; - See test-custom-comments-delete-buffer-comments.el for detailed rationale + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-comments) + +;;; Test Helpers + +(defun test-heavy-box-at-column (column-pos comment-start comment-end decoration-char text length) + "Test cj/--comment-heavy-box at COLUMN-POS indentation. +Insert spaces to reach COLUMN-POS, then call cj/--comment-heavy-box with +COMMENT-START, COMMENT-END, DECORATION-CHAR, TEXT, and LENGTH. +Returns the buffer string for assertions." + (with-temp-buffer + (when (> column-pos 0) + (insert (make-string column-pos ?\s))) + (cj/--comment-heavy-box comment-start comment-end decoration-char text length) + (buffer-string))) + +;;; Emacs Lisp Tests (Primary Language - Comprehensive Coverage) + +;;; Normal Cases + +(ert-deftest test-heavy-box-elisp-basic () + "Should generate 5-line heavy box in emacs-lisp style." + (let ((result (test-heavy-box-at-column 0 ";;" "" "*" "Section Header" 70))) + ;; Should have 5 lines + (should (= 5 (length (split-string result "\n" t)))) + ;; First line should start with ;; and have decoration + (should (string-match-p "^;; \\*" result)) + ;; Middle line should contain centered text + (should (string-match-p "Section Header" result)) + ;; Should have side borders + (should (string-match-p "^\\*.*\\*$" result)))) + +(ert-deftest test-heavy-box-elisp-custom-decoration () + "Should use custom decoration character." + (let ((result (test-heavy-box-at-column 0 ";;" "" "#" "Header" 70))) + (should (string-match-p ";; #" result)) + (should-not (string-match-p "\\*" result)))) + +(ert-deftest test-heavy-box-elisp-custom-text () + "Should include custom text centered in box." + (let ((result (test-heavy-box-at-column 0 ";;" "" "*" "Custom Text Here" 70))) + (should (string-match-p "Custom Text Here" result)))) + +(ert-deftest test-heavy-box-elisp-empty-text () + "Should handle empty text string." + (let ((result (test-heavy-box-at-column 0 ";;" "" "*" "" 70))) + ;; Should still generate 5 lines + (should (= 5 (length (split-string result "\n" t)))) + ;; Middle line should just have side borders and spaces + (should (string-match-p "^\\*.*\\*$" result)))) + +(ert-deftest test-heavy-box-elisp-at-column-0 () + "Should work at column 0." + (let ((result (test-heavy-box-at-column 0 ";;" "" "*" "Header" 70))) + ;; First character should be semicolon + (should (string-prefix-p ";;" result)))) + +(ert-deftest test-heavy-box-elisp-indented () + "Should work when indented." + (let ((result (test-heavy-box-at-column 4 ";;" "" "*" "Header" 70))) + ;; First line should start with spaces + (should (string-prefix-p " ;;" result)) + ;; Other lines should be indented + (let ((lines (split-string result "\n" t))) + (should (string-prefix-p " " (nth 1 lines))) + (should (string-prefix-p " " (nth 2 lines)))))) + +(ert-deftest test-heavy-box-elisp-short-text () + "Should center short text properly." + (let ((result (test-heavy-box-at-column 0 ";;" "" "*" "X" 70))) + ;; Should have 5 lines + (should (= 5 (length (split-string result "\n" t)))) + ;; Text should be present and centered + (should (string-match-p "\\* .* X .* \\*" result)))) + +(ert-deftest test-heavy-box-elisp-long-text () + "Should handle longer text." + (let ((result (test-heavy-box-at-column 0 ";;" "" "*" "This is a longer header text" 70))) + ;; Should have 5 lines + (should (= 5 (length (split-string result "\n" t)))) + ;; Text should be present + (should (string-match-p "This is a longer header text" result)))) + +;;; Boundary Cases + +(ert-deftest test-heavy-box-elisp-minimum-length () + "Should work with minimum viable length." + ;; Minimum for a box: comment + spaces + borders + minimal content + (let ((result (test-heavy-box-at-column 0 ";;" "" "*" "X" 15))) + (should (= 5 (length (split-string result "\n" t)))) + (should (string-match-p "X" result)))) + +(ert-deftest test-heavy-box-elisp-very-long-length () + "Should handle very long length." + (let ((result (test-heavy-box-at-column 0 ";;" "" "*" "Header" 200))) + (should (= 5 (length (split-string result "\n" t)))) + ;; Border lines should be very long + (let ((first-line (car (split-string result "\n" t)))) + (should (> (length first-line) 100))))) + +(ert-deftest test-heavy-box-elisp-unicode-decoration () + "Should handle unicode decoration character." + (let ((result (test-heavy-box-at-column 0 ";;" "" "═" "Header" 70))) + (should (string-match-p "═" result)))) + +(ert-deftest test-heavy-box-elisp-unicode-text () + "Should handle unicode in text." + (let ((result (test-heavy-box-at-column 0 ";;" "" "*" "Hello 👋 مرحبا café" 70))) + (should (string-match-p "👋" result)) + (should (string-match-p "مرحبا" result)) + (should (string-match-p "café" result)))) + +(ert-deftest test-heavy-box-elisp-very-long-text () + "Should handle very long text." + (let* ((long-text (make-string 100 ?x)) + (result (test-heavy-box-at-column 0 ";;" "" "*" long-text 70))) + ;; Should still generate output + (should (= 5 (length (split-string result "\n" t)))) + ;; Middle line should contain some of the text + (should (string-match-p "xxx" result)))) + +(ert-deftest test-heavy-box-elisp-comment-end-empty () + "Should handle empty comment-end by using symmetric comment syntax." + (let ((result (test-heavy-box-at-column 0 ";;" "" "*" "Header" 70))) + (should (= 5 (length (split-string result "\n" t)))) + ;; When comment-end is empty, function uses comment-char for symmetry + ;; So border lines will have ";; ... ;;" for visual balance + (should (string-match-p ";;.*;;$" result)))) + +(ert-deftest test-heavy-box-elisp-max-indentation () + "Should handle maximum practical indentation." + (let ((result (test-heavy-box-at-column 60 ";;" "" "*" "Header" 100))) + (should (= 5 (length (split-string result "\n" t)))) + ;; First line should start with 60 spaces + (should (string-prefix-p (make-string 60 ?\s) result)))) + +(ert-deftest test-heavy-box-elisp-text-centering-even () + "Should center text properly with even length." + (let ((result (test-heavy-box-at-column 0 ";;" "" "*" "EVEN" 70))) + ;; Text should be centered (roughly equal padding on both sides) + (should (string-match-p "\\* .* EVEN .* \\*" result)))) + +(ert-deftest test-heavy-box-elisp-text-centering-odd () + "Should center text properly with odd length." + (let ((result (test-heavy-box-at-column 0 ";;" "" "*" "ODD" 70))) + ;; Text should be centered (roughly equal padding on both sides) + (should (string-match-p "\\* .* ODD .* \\*" result)))) + +;;; Error Cases + +(ert-deftest test-heavy-box-elisp-length-too-small () + "Should error when length is too small." + (should-error + (test-heavy-box-at-column 0 ";;" "" "*" "Header" 5) + :type 'error)) + +(ert-deftest test-heavy-box-elisp-negative-length () + "Should error with negative length." + (should-error + (test-heavy-box-at-column 0 ";;" "" "*" "Header" -10) + :type 'error)) + +(ert-deftest test-heavy-box-elisp-zero-length () + "Should error with zero length." + (should-error + (test-heavy-box-at-column 0 ";;" "" "*" "Header" 0) + :type 'error)) + +(ert-deftest test-heavy-box-elisp-nil-decoration () + "Should error when decoration-char is nil." + (should-error + (test-heavy-box-at-column 0 ";;" "" nil "Header" 70) + :type 'wrong-type-argument)) + +(ert-deftest test-heavy-box-elisp-nil-text () + "Should error when text is nil." + (should-error + (test-heavy-box-at-column 0 ";;" "" "*" nil 70) + :type 'wrong-type-argument)) + +(ert-deftest test-heavy-box-elisp-non-integer-length () + "Should error when length is not an integer." + (should-error + (test-heavy-box-at-column 0 ";;" "" "*" "Header" "not-a-number") + :type 'wrong-type-argument)) + +;;; Python Tests (Hash-based comments) + +(ert-deftest test-heavy-box-python-basic () + "Should generate heavy box with Python comment syntax." + (let ((result (test-heavy-box-at-column 0 "#" "" "*" "Section" 70))) + (should (= 5 (length (split-string result "\n" t)))) + (should (string-match-p "^# \\*" result)) + (should (string-match-p "Section" result)))) + +(ert-deftest test-heavy-box-python-indented () + "Should handle indented Python comments." + (let ((result (test-heavy-box-at-column 4 "#" "" "#" "Function Section" 70))) + (should (string-prefix-p " #" result)) + (should (string-match-p "Function Section" result)))) + +;;; C Tests (C-style comments) + +(ert-deftest test-heavy-box-c-block-comments () + "Should generate heavy box with C block comment syntax." + (let ((result (test-heavy-box-at-column 0 "/*" "*/" "*" "Section" 70))) + (should (= 5 (length (split-string result "\n" t)))) + (should (string-match-p "^/\\* \\*" result)) + (should (string-match-p "Section" result)) + ;; Should include comment-end + (should (string-match-p "\\*/" result)))) + +(provide 'test-custom-comments-comment-heavy-box) +;;; test-custom-comments-comment-heavy-box.el ends here diff --git a/tests/test-custom-comments-comment-inline-border.el b/tests/test-custom-comments-comment-inline-border.el new file mode 100644 index 00000000..ca2bef06 --- /dev/null +++ b/tests/test-custom-comments-comment-inline-border.el @@ -0,0 +1,235 @@ +;;; test-custom-comments-comment-inline-border.el --- Tests for cj/comment-inline-border -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/comment-inline-border function from custom-comments.el +;; +;; This function generates a single-line centered comment with decoration borders: +;; Format: comment-start + decoration + space + text + space + decoration + comment-end +;; Example: ";; ======= Section Header =======" +;; +;; The text is centered with decoration characters on both sides. When text has +;; odd length, the right side gets one less decoration character. +;; +;; We test the NON-INTERACTIVE implementation (cj/--comment-inline-border) +;; to avoid mocking user prompts. This follows our testing best practice +;; of separating business logic from UI interaction. +;; +;; Cross-Language Testing Strategy: +;; - Comprehensive testing in Emacs Lisp (our primary language) +;; - Representative testing in Python and C (hash-based and C-style comments) +;; - Function handles comment syntax generically, so testing 3 syntaxes +;; proves cross-language compatibility +;; - See test-custom-comments-delete-buffer-comments.el for detailed rationale + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-comments) + +;;; Test Helpers + +(defun test-inline-border-at-column (column-pos comment-start comment-end decoration-char text length) + "Test cj/--comment-inline-border at COLUMN-POS indentation. +Insert spaces to reach COLUMN-POS, then call cj/--comment-inline-border with +COMMENT-START, COMMENT-END, DECORATION-CHAR, TEXT, and LENGTH. +Returns the buffer string for assertions." + (with-temp-buffer + (when (> column-pos 0) + (insert (make-string column-pos ?\s))) + (cj/--comment-inline-border comment-start comment-end decoration-char text length) + (buffer-string))) + +;;; Emacs Lisp Tests (Primary Language - Comprehensive Coverage) + +;;; Normal Cases + +(ert-deftest test-inline-border-elisp-basic () + "Should generate single-line centered comment in emacs-lisp style." + (let ((result (test-inline-border-at-column 0 ";;" "" "=" "Section Header" 70))) + ;; Should be single line + (should (= 1 (length (split-string result "\n" t)))) + ;; Should start with ;; + (should (string-match-p "^;; =" result)) + ;; Should contain text + (should (string-match-p "Section Header" result)) + ;; Should have decoration on both sides + (should (string-match-p "= Section Header =" result)))) + +(ert-deftest test-inline-border-elisp-custom-decoration () + "Should use custom decoration character." + (let ((result (test-inline-border-at-column 0 ";;" "" "#" "Header" 70))) + (should (string-match-p ";; #" result)) + (should (string-match-p "# Header #" result)) + (should-not (string-match-p "=" result)))) + +(ert-deftest test-inline-border-elisp-custom-text () + "Should include custom text centered." + (let ((result (test-inline-border-at-column 0 ";;" "" "=" "Custom Text Here" 70))) + (should (string-match-p "Custom Text Here" result)))) + +(ert-deftest test-inline-border-elisp-empty-text () + "Should handle empty text string." + (let ((result (test-inline-border-at-column 0 ";;" "" "=" "" 70))) + ;; Should still generate output with decoration + (should (string-match-p ";; =" result)) + ;; Should not have extra spaces where text would be + (should-not (string-match-p " " result)))) + +(ert-deftest test-inline-border-elisp-at-column-0 () + "Should work at column 0." + (let ((result (test-inline-border-at-column 0 ";;" "" "=" "Header" 70))) + ;; First character should be semicolon + (should (string-prefix-p ";;" result)))) + +(ert-deftest test-inline-border-elisp-indented () + "Should work when indented." + (let ((result (test-inline-border-at-column 4 ";;" "" "=" "Header" 70))) + ;; Result should start with spaces + (should (string-prefix-p " ;;" result)))) + +(ert-deftest test-inline-border-elisp-short-text () + "Should center short text properly." + (let ((result (test-inline-border-at-column 0 ";;" "" "=" "X" 70))) + (should (string-match-p "X" result)) + ;; Should have decoration on both sides + (should (string-match-p "= X =" result)))) + +(ert-deftest test-inline-border-elisp-custom-length () + "Should respect custom length." + (let ((result (test-inline-border-at-column 0 ";;" "" "=" "Header" 50))) + ;; Line should be approximately 50 chars + (let ((line (car (split-string result "\n" t)))) + (should (<= (length line) 51)) + (should (>= (length line) 48))))) + +;;; Boundary Cases + +(ert-deftest test-inline-border-elisp-minimum-length () + "Should work with minimum viable length." + ;; Minimum: 2 (;;) + 1 (space) + 1 (space) + 2 (min decoration each side) = 6 + (let ((result (test-inline-border-at-column 0 ";;" "" "=" "" 10))) + (should (string-match-p ";" result)))) + +(ert-deftest test-inline-border-elisp-text-centering-even () + "Should center text properly with even length." + (let ((result (test-inline-border-at-column 0 ";;" "" "=" "EVEN" 70))) + ;; Text should be centered with roughly equal decoration + (should (string-match-p "= EVEN =" result)))) + +(ert-deftest test-inline-border-elisp-text-centering-odd () + "Should center text properly with odd length." + (let ((result (test-inline-border-at-column 0 ";;" "" "=" "ODD" 70))) + ;; Text should be centered (right side has one less due to odd length) + (should (string-match-p "= ODD =" result)))) + +(ert-deftest test-inline-border-elisp-very-long-text () + "Should handle text that fills most of the line." + (let* ((long-text (make-string 50 ?x)) + (result (test-inline-border-at-column 0 ";;" "" "=" long-text 70))) + ;; Should still have decoration + (should (string-match-p "=" result)) + ;; Text should be present + (should (string-match-p "xxx" result)))) + +(ert-deftest test-inline-border-elisp-unicode-decoration () + "Should handle unicode decoration character." + (let ((result (test-inline-border-at-column 0 ";;" "" "─" "Header" 70))) + (should (string-match-p "─" result)))) + +(ert-deftest test-inline-border-elisp-unicode-text () + "Should handle unicode in text." + (let ((result (test-inline-border-at-column 0 ";;" "" "=" "Hello 👋 café" 70))) + (should (string-match-p "👋" result)) + (should (string-match-p "café" result)))) + +(ert-deftest test-inline-border-elisp-comment-end-empty () + "Should handle empty comment-end correctly." + (let ((result (test-inline-border-at-column 0 ";;" "" "=" "Header" 70))) + ;; Line should not have trailing comment-end + (should-not (string-match-p ";;$" result)))) + +(ert-deftest test-inline-border-elisp-max-indentation () + "Should handle maximum practical indentation." + (let ((result (test-inline-border-at-column 60 ";;" "" "=" "H" 100))) + (should (string-prefix-p (make-string 60 ?\s) result)))) + +(ert-deftest test-inline-border-elisp-minimum-decoration-each-side () + "Should have at least 2 decoration chars on each side." + (let ((result (test-inline-border-at-column 0 ";;" "" "=" "Test" 20))) + ;; Should have at least == on each side + (should (string-match-p "== Test ==" result)))) + +;;; Error Cases + +(ert-deftest test-inline-border-elisp-length-too-small () + "Should error when length is too small for text." + (should-error + (test-inline-border-at-column 0 ";;" "" "=" "Very Long Header Text" 20) + :type 'error)) + +(ert-deftest test-inline-border-elisp-negative-length () + "Should error with negative length." + (should-error + (test-inline-border-at-column 0 ";;" "" "=" "Header" -10) + :type 'error)) + +(ert-deftest test-inline-border-elisp-zero-length () + "Should error with zero length." + (should-error + (test-inline-border-at-column 0 ";;" "" "=" "Header" 0) + :type 'error)) + +(ert-deftest test-inline-border-elisp-nil-decoration () + "Should error when decoration-char is nil." + (should-error + (test-inline-border-at-column 0 ";;" "" nil "Header" 70) + :type 'wrong-type-argument)) + +(ert-deftest test-inline-border-elisp-non-integer-length () + "Should error when length is not an integer." + (should-error + (test-inline-border-at-column 0 ";;" "" "=" "Header" "not-a-number") + :type 'wrong-type-argument)) + +;;; Python Tests (Hash-based comments) + +(ert-deftest test-inline-border-python-basic () + "Should generate inline border with Python comment syntax." + (let ((result (test-inline-border-at-column 0 "#" "" "=" "Section" 70))) + (should (string-match-p "^# =" result)) + (should (string-match-p "Section" result)))) + +(ert-deftest test-inline-border-python-indented () + "Should handle indented Python comments." + (let ((result (test-inline-border-at-column 4 "#" "" "-" "Function Section" 70))) + (should (string-prefix-p " #" result)) + (should (string-match-p "Function Section" result)))) + +;;; C Tests (C-style comments) + +(ert-deftest test-inline-border-c-block-comments () + "Should generate inline border with C block comment syntax." + (let ((result (test-inline-border-at-column 0 "/*" "*/" "=" "Section" 70))) + (should (string-match-p "^/\\* =" result)) + (should (string-match-p "Section" result)) + ;; Should include comment-end + (should (string-match-p "\\*/$" result)))) + +(ert-deftest test-inline-border-c-line-comments () + "Should generate inline border with C line comment syntax." + (let ((result (test-inline-border-at-column 0 "//" "" "-" "Header" 70))) + (should (string-match-p "^// -" result)) + (should (string-match-p "Header" result)))) + +(provide 'test-custom-comments-comment-inline-border) +;;; test-custom-comments-comment-inline-border.el ends here diff --git a/tests/test-custom-comments-comment-padded-divider.el b/tests/test-custom-comments-comment-padded-divider.el new file mode 100644 index 00000000..702a4c67 --- /dev/null +++ b/tests/test-custom-comments-comment-padded-divider.el @@ -0,0 +1,250 @@ +;;; test-custom-comments-comment-padded-divider.el --- Tests for cj/comment-padded-divider -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/comment-padded-divider function from custom-comments.el +;; +;; This function generates a padded 3-line comment divider banner: +;; - Top line: comment-start + decoration chars +;; - Middle line: comment-start + padding spaces + text +;; - Bottom line: comment-start + decoration chars +;; +;; The key difference from simple-divider is the PADDING parameter which +;; adds spaces before the text to create visual indentation. +;; +;; We test the NON-INTERACTIVE implementation (cj/--comment-padded-divider) +;; to avoid mocking user prompts. This follows our testing best practice +;; of separating business logic from UI interaction. +;; +;; Cross-Language Testing Strategy: +;; - Comprehensive testing in Emacs Lisp (our primary language) +;; - Representative testing in Python and C (hash-based and C-style comments) +;; - Function handles comment syntax generically, so testing 3 syntaxes +;; proves cross-language compatibility +;; - See test-custom-comments-delete-buffer-comments.el for detailed rationale + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-comments) + +;;; Test Helpers + +(defun test-padded-divider-at-column (column-pos comment-start comment-end decoration-char text length padding) + "Test cj/--comment-padded-divider at COLUMN-POS indentation. +Insert spaces to reach COLUMN-POS, then call cj/--comment-padded-divider with +COMMENT-START, COMMENT-END, DECORATION-CHAR, TEXT, LENGTH, and PADDING. +Returns the buffer string for assertions." + (with-temp-buffer + (when (> column-pos 0) + (insert (make-string column-pos ?\s))) + (cj/--comment-padded-divider comment-start comment-end decoration-char text length padding) + (buffer-string))) + +;;; Emacs Lisp Tests (Primary Language - Comprehensive Coverage) + +;;; Normal Cases + +(ert-deftest test-padded-divider-elisp-basic () + "Should generate padded 3-line divider in emacs-lisp style." + (let ((result (test-padded-divider-at-column 0 ";;" "" "=" "Section Header" 70 2))) + ;; Should have 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; First line should start with ;; and have decoration + (should (string-match-p "^;; =" result)) + ;; Middle line should contain text with padding + (should (string-match-p ";; Section Header" result)))) + +(ert-deftest test-padded-divider-elisp-custom-padding () + "Should respect custom padding value." + (let ((result (test-padded-divider-at-column 0 ";;" "" "=" "Header" 70 4))) + ;; Middle line should have 4 spaces before text + (should (string-match-p ";; Header" result)))) + +(ert-deftest test-padded-divider-elisp-zero-padding () + "Should work with zero padding." + (let ((result (test-padded-divider-at-column 0 ";;" "" "-" "Header" 70 0))) + ;; Middle line should have text immediately after comment-start + space + (should (string-match-p "^;; Header$" result)))) + +(ert-deftest test-padded-divider-elisp-large-padding () + "Should work with large padding value." + (let ((result (test-padded-divider-at-column 0 ";;" "" "=" "Text" 70 10))) + ;; Middle line should have 10 spaces before text + (should (string-match-p ";; Text" result)))) + +(ert-deftest test-padded-divider-elisp-custom-decoration () + "Should use custom decoration character." + (let ((result (test-padded-divider-at-column 0 ";;" "" "*" "Header" 70 2))) + (should (string-match-p ";; \\*" result)) + (should-not (string-match-p ";; =" result)))) + +(ert-deftest test-padded-divider-elisp-custom-text () + "Should include custom text in middle line." + (let ((result (test-padded-divider-at-column 0 ";;" "" "=" "Custom Text Here" 70 2))) + (should (string-match-p "Custom Text Here" result)))) + +(ert-deftest test-padded-divider-elisp-empty-text () + "Should handle empty text string." + (let ((result (test-padded-divider-at-column 0 ";;" "" "-" "" 70 2))) + ;; Should still generate 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Middle line should just be comment-start + padding + (should (string-match-p "^;; *\n" result)))) + +(ert-deftest test-padded-divider-elisp-at-column-0 () + "Should work at column 0." + (let ((result (test-padded-divider-at-column 0 ";;" "" "=" "Header" 70 2))) + ;; First character should be semicolon + (should (string-prefix-p ";;" result)))) + +(ert-deftest test-padded-divider-elisp-indented () + "Should work when indented." + (let ((result (test-padded-divider-at-column 4 ";;" "" "=" "Header" 70 2))) + ;; Result should start with spaces + (should (string-prefix-p " ;;" result)) + ;; All lines should be indented + (dolist (line (split-string result "\n" t)) + (should (string-prefix-p " ;;" line))))) + +;;; Boundary Cases + +(ert-deftest test-padded-divider-elisp-minimum-length () + "Should work with minimum viable length at column 0." + ;; Minimum: 2 (;;) + 1 (space) + 1 (space) + 3 (dashes) = 7 + (let ((result (test-padded-divider-at-column 0 ";;" "" "-" "" 7 0))) + (should (= 3 (length (split-string result "\n" t)))))) + +(ert-deftest test-padded-divider-elisp-very-long-length () + "Should handle very long length." + (let ((result (test-padded-divider-at-column 0 ";;" "" "=" "Header" 200 2))) + (should (= 3 (length (split-string result "\n" t)))) + ;; Decoration lines should be very long + (let ((first-line (car (split-string result "\n" t)))) + (should (> (length first-line) 100))))) + +(ert-deftest test-padded-divider-elisp-padding-larger-than-length () + "Should handle padding that exceeds reasonable bounds." + ;; This tests behavior when padding is very large relative to length + (let ((result (test-padded-divider-at-column 0 ";;" "" "=" "X" 70 50))) + ;; Should still generate output (text may extend beyond decoration) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "X" result)))) + +(ert-deftest test-padded-divider-elisp-unicode-decoration () + "Should handle unicode decoration character." + (let ((result (test-padded-divider-at-column 0 ";;" "" "─" "Header" 70 2))) + (should (string-match-p "─" result)))) + +(ert-deftest test-padded-divider-elisp-unicode-text () + "Should handle unicode in text." + (let ((result (test-padded-divider-at-column 0 ";;" "" "=" "Hello 👋 مرحبا café" 70 2))) + (should (string-match-p "👋" result)) + (should (string-match-p "مرحبا" result)) + (should (string-match-p "café" result)))) + +(ert-deftest test-padded-divider-elisp-very-long-text () + "Should handle very long text." + (let* ((long-text (make-string 100 ?x)) + (result (test-padded-divider-at-column 0 ";;" "" "=" long-text 70 2))) + ;; Should still generate output + (should (= 3 (length (split-string result "\n" t)))) + ;; Middle line should contain some of the text + (should (string-match-p "xxx" result)))) + +(ert-deftest test-padded-divider-elisp-comment-end-empty () + "Should handle empty comment-end correctly." + (let ((result (test-padded-divider-at-column 0 ";;" "" "=" "Header" 70 2))) + (should (= 3 (length (split-string result "\n" t)))) + ;; Lines should not have trailing comment-end + (should-not (string-match-p ";;.*;;$" result)))) + +(ert-deftest test-padded-divider-elisp-max-indentation () + "Should handle maximum practical indentation." + (let ((result (test-padded-divider-at-column 60 ";;" "" "=" "Header" 100 2))) + (should (= 3 (length (split-string result "\n" t)))) + ;; All lines should start with 60 spaces + (dolist (line (split-string result "\n" t)) + (should (string-prefix-p (make-string 60 ?\s) line))))) + +;;; Error Cases + +(ert-deftest test-padded-divider-elisp-negative-padding () + "Should error with negative padding." + (should-error + (test-padded-divider-at-column 0 ";;" "" "=" "Header" 70 -5) + :type 'error)) + +(ert-deftest test-padded-divider-elisp-negative-length () + "Should error with negative length." + (should-error + (test-padded-divider-at-column 0 ";;" "" "=" "Header" -10 2) + :type 'error)) + +(ert-deftest test-padded-divider-elisp-zero-length () + "Should error with zero length." + (should-error + (test-padded-divider-at-column 0 ";;" "" "=" "Header" 0 2) + :type 'error)) + +(ert-deftest test-padded-divider-elisp-nil-decoration () + "Should error when decoration-char is nil." + (should-error + (test-padded-divider-at-column 0 ";;" "" nil "Header" 70 2) + :type 'wrong-type-argument)) + +(ert-deftest test-padded-divider-elisp-nil-text () + "Should error when text is nil." + (should-error + (test-padded-divider-at-column 0 ";;" "" "=" nil 70 2) + :type 'wrong-type-argument)) + +(ert-deftest test-padded-divider-elisp-non-integer-length () + "Should error when length is not an integer." + (should-error + (test-padded-divider-at-column 0 ";;" "" "=" "Header" "not-a-number" 2) + :type 'wrong-type-argument)) + +(ert-deftest test-padded-divider-elisp-non-integer-padding () + "Should error when padding is not an integer." + (should-error + (test-padded-divider-at-column 0 ";;" "" "=" "Header" 70 "not-a-number") + :type 'wrong-type-argument)) + +;;; Python Tests (Hash-based comments) + +(ert-deftest test-padded-divider-python-basic () + "Should generate padded divider with Python comment syntax." + (let ((result (test-padded-divider-at-column 0 "#" "" "=" "Section" 70 2))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "^# =" result)) + (should (string-match-p "# Section" result)))) + +(ert-deftest test-padded-divider-python-indented () + "Should handle indented Python comments with padding." + (let ((result (test-padded-divider-at-column 4 "#" "" "-" "Function Section" 70 4))) + (should (string-prefix-p " #" result)) + (should (string-match-p "Function Section" result)))) + +;;; C Tests (C-style comments) + +(ert-deftest test-padded-divider-c-block-comments () + "Should generate padded divider with C block comment syntax." + (let ((result (test-padded-divider-at-column 0 "/*" "*/" "=" "Section" 70 2))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "^/\\* =" result)) + (should (string-match-p "/\\* Section" result)) + ;; Should include comment-end + (should (string-match-p "\\*/" result)))) + +(provide 'test-custom-comments-comment-padded-divider) +;;; test-custom-comments-comment-padded-divider.el ends here diff --git a/tests/test-custom-comments-comment-reformat.el b/tests/test-custom-comments-comment-reformat.el new file mode 100644 index 00000000..83248aee --- /dev/null +++ b/tests/test-custom-comments-comment-reformat.el @@ -0,0 +1,191 @@ +;;; test-custom-comments-comment-reformat.el --- Tests for cj/comment-reformat -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/comment-reformat function from custom-comments.el +;; +;; This function reformats multi-line comments into a single paragraph by: +;; 1. Uncommenting the selected region +;; 2. Joining lines together (via cj/join-line-or-region) +;; 3. Re-commenting the result +;; 4. Temporarily reducing fill-column by 3 during the join operation +;; +;; Dependencies: +;; - Requires cj/join-line-or-region from custom-line-paragraph.el +;; - We load the REAL module to test actual integration behavior +;; - This follows our "test production code" guideline +;; - If join-line-or-region has bugs, our tests will catch integration issues +;; +;; Cross-Language Testing Strategy: +;; - Comprehensive testing in Emacs Lisp (12 tests) +;; - Representative testing in Python and C (1 test each) +;; - Function delegates to uncomment-region/comment-region, so we test OUR logic +;; - See test-custom-comments-delete-buffer-comments.el for detailed rationale + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Load the real custom-line-paragraph module (for cj/join-line-or-region) +(require 'custom-line-paragraph) + +;; Now load the actual production module +(require 'custom-comments) + +;;; Test Helpers + +(defun test-comment-reformat-in-mode (mode content-before expected-after) + "Test comment reformatting in MODE. +Insert CONTENT-BEFORE, select all, run cj/comment-reformat, verify EXPECTED-AFTER." + (with-temp-buffer + (transient-mark-mode 1) ; Enable transient-mark-mode for batch testing + (funcall mode) + (insert content-before) + (mark-whole-buffer) + (activate-mark) ; Explicitly activate the mark + (cj/comment-reformat) + (should (equal (string-trim (buffer-string)) (string-trim expected-after))))) + +;;; Emacs Lisp Tests (Primary Language - Comprehensive Coverage) + +(ert-deftest test-comment-reformat-elisp-simple-multiline () + "Should join multiple commented lines into one." + (test-comment-reformat-in-mode + 'emacs-lisp-mode + ";; Line one\n;; Line two\n;; Line three" + ";; Line one Line two Line three")) + +(ert-deftest test-comment-reformat-elisp-preserves-content () + "Should preserve text content after reformat." + (test-comment-reformat-in-mode + 'emacs-lisp-mode + ";; Hello world\n;; from Emacs" + ";; Hello world from Emacs")) + +(ert-deftest test-comment-reformat-elisp-restores-fill-column () + "Should restore fill-column after operation." + (with-temp-buffer + (transient-mark-mode 1) + (emacs-lisp-mode) + (let ((original-fill-column fill-column)) + (insert ";; Line one\n;; Line two") + (mark-whole-buffer) + (activate-mark) + (cj/comment-reformat) + (should (= fill-column original-fill-column))))) + +(ert-deftest test-comment-reformat-elisp-single-line () + "Should handle single commented line." + (test-comment-reformat-in-mode + 'emacs-lisp-mode + ";; Single line comment" + ";; Single line comment")) + +(ert-deftest test-comment-reformat-elisp-empty-region () + "Should error when trying to comment empty buffer." + (with-temp-buffer + (transient-mark-mode 1) + (emacs-lisp-mode) + (mark-whole-buffer) + (activate-mark) + (should-error (cj/comment-reformat)))) + +(ert-deftest test-comment-reformat-elisp-whitespace-in-comments () + "Should handle comments with only whitespace." + (test-comment-reformat-in-mode + 'emacs-lisp-mode + ";; \n;; \n;; text" + ";; text")) + +(ert-deftest test-comment-reformat-elisp-unicode () + "Should handle unicode in comments." + (test-comment-reformat-in-mode + 'emacs-lisp-mode + ";; Hello 👋\n;; مرحبا café" + ";; Hello 👋 مرحبا café")) + +(ert-deftest test-comment-reformat-elisp-long-text () + "Should handle many lines of comments." + (test-comment-reformat-in-mode + 'emacs-lisp-mode + ";; Line 1\n;; Line 2\n;; Line 3\n;; Line 4\n;; Line 5" + ";; Line 1 Line 2 Line 3 Line 4 Line 5")) + +(ert-deftest test-comment-reformat-elisp-indented-comments () + "Should handle indented comments." + (with-temp-buffer + (transient-mark-mode 1) + (emacs-lisp-mode) + (insert " ;; Indented line 1\n ;; Indented line 2") + (mark-whole-buffer) + (activate-mark) + (cj/comment-reformat) + ;; After reformatting, should still be commented + (should (string-match-p ";;" (buffer-string))) + ;; Content should be joined + (should (string-match-p "line 1.*line 2" (buffer-string))))) + +(ert-deftest test-comment-reformat-elisp-region-at-buffer-start () + "Should handle region at buffer start." + (with-temp-buffer + (transient-mark-mode 1) + (emacs-lisp-mode) + (insert ";; Start line 1\n;; Start line 2\n(setq x 1)") + (goto-char (point-min)) + (set-mark (point)) + (forward-line 2) + (activate-mark) + (cj/comment-reformat) + (should (string-match-p ";; Start line 1.*Start line 2" (buffer-string))))) + +(ert-deftest test-comment-reformat-elisp-no-region-active () + "Should show message when no region selected." + (with-temp-buffer + (emacs-lisp-mode) + (insert ";; Comment line") + (deactivate-mark) + (let ((message-log-max nil) + (messages '())) + ;; Capture messages + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (push (apply #'format format-string args) messages)))) + (cj/comment-reformat) + (should (string-match-p "No region was selected" (car messages))))))) + +(ert-deftest test-comment-reformat-elisp-read-only-buffer () + "Should signal error in read-only buffer." + (with-temp-buffer + (emacs-lisp-mode) + (insert ";; Line 1\n;; Line 2") + (mark-whole-buffer) + (read-only-mode 1) + (should-error (cj/comment-reformat)))) + +;;; Python Tests (Hash-based comments) + +(ert-deftest test-comment-reformat-python-simple () + "Should join Python hash comments." + (test-comment-reformat-in-mode + 'python-mode + "# Line one\n# Line two" + "# Line one Line two")) + +;;; C Tests (C-style comments) + +(ert-deftest test-comment-reformat-c-line-comments () + "Should join C line comments (C-mode converts to block comments)." + (test-comment-reformat-in-mode + 'c-mode + "// Line one\n// Line two" + "/* Line one Line two */")) + +(provide 'test-custom-comments-comment-reformat) +;;; test-custom-comments-comment-reformat.el ends here diff --git a/tests/test-custom-comments-comment-simple-divider.el b/tests/test-custom-comments-comment-simple-divider.el new file mode 100644 index 00000000..a61e6b4c --- /dev/null +++ b/tests/test-custom-comments-comment-simple-divider.el @@ -0,0 +1,246 @@ +;;; test-custom-comments-comment-simple-divider.el --- Tests for cj/comment-simple-divider -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/comment-simple-divider function from custom-comments.el +;; +;; This function generates a simple 3-line comment divider banner: +;; - Top line: comment-start + decoration chars +;; - Middle line: comment-start + text +;; - Bottom line: comment-start + decoration chars +;; +;; We test the NON-INTERACTIVE implementation (cj/--comment-simple-divider) +;; to avoid mocking user prompts. This follows our testing best practice +;; of separating business logic from UI interaction. +;; +;; Cross-Language Testing Strategy: +;; - Comprehensive testing in Emacs Lisp (our primary language) +;; - Representative testing in Python and C (hash-based and C-style comments) +;; - Function handles comment syntax generically, so testing 3 syntaxes +;; proves cross-language compatibility +;; - See test-custom-comments-delete-buffer-comments.el for detailed rationale + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-comments) + +;;; Test Helpers + +(defun test-simple-divider-at-column (column-pos comment-start comment-end decoration-char text length) + "Test cj/--comment-simple-divider at COLUMN-POS indentation. +Insert spaces to reach COLUMN-POS, then call cj/--comment-simple-divider with +COMMENT-START, COMMENT-END, DECORATION-CHAR, TEXT, and LENGTH. +Returns the buffer string for assertions." + (with-temp-buffer + (when (> column-pos 0) + (insert (make-string column-pos ?\s))) + (cj/--comment-simple-divider comment-start comment-end decoration-char text length) + (buffer-string))) + +;;; Emacs Lisp Tests (Primary Language - Comprehensive Coverage) + +;;; Normal Cases + +(ert-deftest test-simple-divider-elisp-basic () + "Should generate simple 3-line divider in emacs-lisp style." + (let ((result (test-simple-divider-at-column 0 ";;" "" "-" "Section Header" 70))) + ;; Should have 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Each line should start with ;; + (should (string-match-p "^;; -" result)) + ;; Middle line should contain text + (should (string-match-p ";; Section Header" result)))) + +(ert-deftest test-simple-divider-elisp-custom-decoration () + "Should use custom decoration character." + (let ((result (test-simple-divider-at-column 0 ";;" "" "=" "Header" 70))) + (should (string-match-p ";; =" result)) + (should-not (string-match-p ";; -" result)))) + +(ert-deftest test-simple-divider-elisp-custom-text () + "Should include custom text in middle line." + (let ((result (test-simple-divider-at-column 0 ";;" "" "-" "Custom Text Here" 70))) + (should (string-match-p ";; Custom Text Here" result)))) + +(ert-deftest test-simple-divider-elisp-custom-length () + "Should respect custom length." + (let* ((result (test-simple-divider-at-column 0 ";;" "" "-" "Header" 50)) + (lines (split-string result "\n" t))) + ;; Should have 3 lines + (should (= 3 (length lines))) + ;; First and last lines (decoration) should be approximately 50 chars + (should (<= (length (car lines)) 51)) + (should (>= (length (car lines)) 48)) + (should (<= (length (car (last lines))) 51)) + (should (>= (length (car (last lines))) 48)))) + +(ert-deftest test-simple-divider-elisp-empty-text () + "Should handle empty text string." + (let ((result (test-simple-divider-at-column 0 ";;" "" "-" "" 70))) + ;; Should still generate 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Middle line should just be comment-start + (should (string-match-p "^;; *\n" result)))) + +(ert-deftest test-simple-divider-elisp-at-column-0 () + "Should work at column 0." + (let ((result (test-simple-divider-at-column 0 ";;" "" "-""Header" 70))) + ;; First character should be semicolon + (should (string-prefix-p ";;" result)))) + +(ert-deftest test-simple-divider-elisp-indented () + "Should work when indented." + (let ((result (test-simple-divider-at-column 4 ";;" "" "-""Header" 70))) + ;; Result should start with spaces + (should (string-prefix-p " ;;" result)) + ;; All lines should be indented + (dolist (line (split-string result "\n" t)) + (should (string-prefix-p " ;;" line))))) + +;;; Boundary Cases + +(ert-deftest test-simple-divider-elisp-minimum-length () + "Should work with minimum viable length at column 0." + ;; Minimum length at column 0: 2 (;;) + 1 (space) + 1 (space) + 3 (dashes) = 7 + (let ((result (test-simple-divider-at-column 0 ";;" "" "-""" 7))) + (should (= 3 (length (split-string result "\n" t)))))) + +(ert-deftest test-simple-divider-elisp-minimum-length-indented () + "Should work with minimum viable length when indented." + ;; At column 4, minimum is 4 + 2 + 1 + 1 + 3 = 11 + (let ((result (test-simple-divider-at-column 4 ";;" "" "-""" 11))) + (should (= 3 (length (split-string result "\n" t)))))) + +(ert-deftest test-simple-divider-elisp-very-long-length () + "Should handle very long length." + (let ((result (test-simple-divider-at-column 0 ";;" "" "-""Header" 200))) + (should (= 3 (length (split-string result "\n" t)))) + ;; Decoration lines should be very long + (let ((first-line (car (split-string result "\n" t)))) + (should (> (length first-line) 100))))) + +(ert-deftest test-simple-divider-elisp-unicode-decoration () + "Should handle unicode decoration character." + (let ((result (test-simple-divider-at-column 0 ";;" "" "─""Header" 70))) + (should (string-match-p "─" result)))) + +(ert-deftest test-simple-divider-elisp-unicode-text () + "Should handle unicode in text." + (let ((result (test-simple-divider-at-column 0 ";;" "" "-""Hello 👋 مرحبا café" 70))) + (should (string-match-p "👋" result)) + (should (string-match-p "مرحبا" result)) + (should (string-match-p "café" result)))) + +(ert-deftest test-simple-divider-elisp-very-long-text () + "Should handle very long text (may wrap or truncate)." + (let* ((long-text (make-string 100 ?x)) + (result (test-simple-divider-at-column 0 ";;" "" "-"long-text 70))) + ;; Should still generate output (behavior may vary) + (should (= 3 (length (split-string result "\n" t)))) + ;; Middle line should contain some of the text + (should (string-match-p "xxx" result)))) + +(ert-deftest test-simple-divider-elisp-comment-end-empty () + "Should handle empty comment-end correctly." + (let ((result (test-simple-divider-at-column 0 ";;" "" "-""Header" 70))) + (should (= 3 (length (split-string result "\n" t)))) + ;; Lines should not have trailing comment-end + (should-not (string-match-p ";;.*;;$" result)))) + +(ert-deftest test-simple-divider-elisp-max-indentation () + "Should handle maximum practical indentation." + (let ((result (test-simple-divider-at-column 60 ";;" "" "-""Header" 100))) + (should (= 3 (length (split-string result "\n" t)))) + ;; All lines should start with 60 spaces + (dolist (line (split-string result "\n" t)) + (should (string-prefix-p (make-string 60 ?\s) line))))) + +;;; Error Cases + +(ert-deftest test-simple-divider-elisp-length-too-small-column-0 () + "Should error when length is too small at column 0." + (should-error + (test-simple-divider-at-column 0 ";;" "" "-" "Header" 5) + :type 'error)) + +(ert-deftest test-simple-divider-elisp-length-too-small-indented () + "Should error when length is too small for indentation level." + (should-error + (test-simple-divider-at-column 10 ";;" "" "-" "Header" 15) + :type 'error)) + +(ert-deftest test-simple-divider-elisp-negative-length () + "Should error with negative length." + (should-error + (test-simple-divider-at-column 0 ";;" "" "-" "Header" -10) + :type 'error)) + +(ert-deftest test-simple-divider-elisp-zero-length () + "Should error with zero length." + (should-error + (test-simple-divider-at-column 0 ";;" "" "-" "Header" 0) + :type 'error)) + +(ert-deftest test-simple-divider-elisp-nil-decoration () + "Should error when decoration-char is nil." + (should-error + (test-simple-divider-at-column 0 ";;" "" nil "Header" 70) + :type 'wrong-type-argument)) + +(ert-deftest test-simple-divider-elisp-nil-text () + "Should error when text is nil." + (should-error + (test-simple-divider-at-column 0 ";;" "" "-" nil 70) + :type 'wrong-type-argument)) + +(ert-deftest test-simple-divider-elisp-non-integer-length () + "Should error when length is not an integer." + (should-error + (test-simple-divider-at-column 0 ";;" "" "-""Header" "not-a-number") + :type 'wrong-type-argument)) + +;;; Python Tests (Hash-based comments) + +(ert-deftest test-simple-divider-python-basic () + "Should generate simple divider with Python comment syntax." + (let ((result (test-simple-divider-at-column 0 "#" "" "-""Section" 70))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "^# -" result)) + (should (string-match-p "# Section" result)))) + +(ert-deftest test-simple-divider-python-indented () + "Should handle indented Python comments." + (let ((result (test-simple-divider-at-column 4 "#" "" "=""Function Section" 70))) + (should (string-prefix-p " #" result)) + (should (string-match-p "Function Section" result)))) + +;;; C Tests (C-style comments) + +(ert-deftest test-simple-divider-c-block-comments () + "Should generate simple divider with C block comment syntax." + (let ((result (test-simple-divider-at-column 0 "/*" "*/" "-""Section" 70))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "^/\\* -" result)) + (should (string-match-p "/\\* Section" result)) + ;; Should include comment-end + (should (string-match-p "\\*/" result)))) + +(ert-deftest test-simple-divider-c-line-comments () + "Should generate simple divider with C line comment syntax." + (let ((result (test-simple-divider-at-column 0 "//" "" "=""Header" 70))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "^// =" result)) + (should (string-match-p "// Header" result)))) + +(provide 'test-custom-comments-comment-simple-divider) +;;; test-custom-comments-comment-simple-divider.el ends here diff --git a/tests/test-custom-comments-comment-unicode-box.el b/tests/test-custom-comments-comment-unicode-box.el new file mode 100644 index 00000000..f34329c8 --- /dev/null +++ b/tests/test-custom-comments-comment-unicode-box.el @@ -0,0 +1,264 @@ +;;; test-custom-comments-comment-unicode-box.el --- Tests for cj/comment-unicode-box -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/comment-unicode-box function from custom-comments.el +;; +;; This function generates a 3-line unicode box comment: +;; - Top line: comment-start + top-left corner + horizontal lines + top-right corner +;; - Text line: comment-start + vertical bar + text + vertical bar +;; - Bottom line: comment-start + bottom-left corner + horizontal lines + bottom-right corner +;; +;; Supports both 'single and 'double box styles with different unicode characters. +;; +;; We test the NON-INTERACTIVE implementation (cj/--comment-unicode-box) +;; to avoid mocking user prompts. This follows our testing best practice +;; of separating business logic from UI interaction. +;; +;; Cross-Language Testing Strategy: +;; - Comprehensive testing in Emacs Lisp (our primary language) +;; - Representative testing in Python and C (hash-based and C-style comments) +;; - Function handles comment syntax generically, so testing 3 syntaxes +;; proves cross-language compatibility +;; - See test-custom-comments-delete-buffer-comments.el for detailed rationale + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-comments) + +;;; Test Helpers + +(defun test-unicode-box-at-column (column-pos comment-start comment-end text length box-style) + "Test cj/--comment-unicode-box at COLUMN-POS indentation. +Insert spaces to reach COLUMN-POS, then call cj/--comment-unicode-box with +COMMENT-START, COMMENT-END, TEXT, LENGTH, and BOX-STYLE. +Returns the buffer string for assertions." + (with-temp-buffer + (when (> column-pos 0) + (insert (make-string column-pos ?\s))) + (cj/--comment-unicode-box comment-start comment-end text length box-style) + (buffer-string))) + +;;; Emacs Lisp Tests (Primary Language - Comprehensive Coverage) + +;;; Normal Cases - Single Box Style + +(ert-deftest test-unicode-box-elisp-single-basic () + "Should generate 3-line single-line unicode box in emacs-lisp style." + (let ((result (test-unicode-box-at-column 0 ";;" "" "Section Header" 70 'single))) + ;; Should have 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Should have single-line box characters + (should (string-match-p "┌" result)) + (should (string-match-p "┐" result)) + (should (string-match-p "└" result)) + (should (string-match-p "┘" result)) + (should (string-match-p "─" result)) + (should (string-match-p "│" result)) + ;; Should contain text + (should (string-match-p "Section Header" result)))) + +(ert-deftest test-unicode-box-elisp-double-basic () + "Should generate 3-line double-line unicode box in emacs-lisp style." + (let ((result (test-unicode-box-at-column 0 ";;" "" "Section Header" 70 'double))) + ;; Should have 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Should have double-line box characters + (should (string-match-p "╔" result)) + (should (string-match-p "╗" result)) + (should (string-match-p "╚" result)) + (should (string-match-p "╝" result)) + (should (string-match-p "═" result)) + (should (string-match-p "║" result)) + ;; Should contain text + (should (string-match-p "Section Header" result)))) + +(ert-deftest test-unicode-box-elisp-single-vs-double () + "Should use different characters for single vs double." + (let ((single-result (test-unicode-box-at-column 0 ";;" "" "Header" 70 'single)) + (double-result (test-unicode-box-at-column 0 ";;" "" "Header" 70 'double))) + ;; Single should have single-line chars but not double + (should (string-match-p "─" single-result)) + (should-not (string-match-p "═" single-result)) + ;; Double should have double-line chars but not single + (should (string-match-p "═" double-result)) + (should-not (string-match-p "─" double-result)))) + +(ert-deftest test-unicode-box-elisp-custom-text () + "Should include custom text in box." + (let ((result (test-unicode-box-at-column 0 ";;" "" "Custom Text Here" 70 'single))) + (should (string-match-p "Custom Text Here" result)))) + +(ert-deftest test-unicode-box-elisp-empty-text () + "Should handle empty text string." + (let ((result (test-unicode-box-at-column 0 ";;" "" "" 70 'single))) + ;; Should still generate 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Should have box characters + (should (string-match-p "┌" result)))) + +(ert-deftest test-unicode-box-elisp-at-column-0 () + "Should work at column 0." + (let ((result (test-unicode-box-at-column 0 ";;" "" "Header" 70 'single))) + ;; First character should be semicolon + (should (string-prefix-p ";;" result)))) + +(ert-deftest test-unicode-box-elisp-indented () + "Should work when indented." + (let ((result (test-unicode-box-at-column 4 ";;" "" "Header" 70 'single))) + ;; Result should start with spaces + (should (string-prefix-p " ;;" result)) + ;; All lines should be indented + (dolist (line (split-string result "\n" t)) + (should (string-prefix-p " ;;" line))))) + +(ert-deftest test-unicode-box-elisp-short-text () + "Should handle short text properly." + (let ((result (test-unicode-box-at-column 0 ";;" "" "X" 70 'single))) + ;; Should have 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Text should be present + (should (string-match-p "X" result)))) + +(ert-deftest test-unicode-box-elisp-long-text () + "Should handle longer text." + (let ((result (test-unicode-box-at-column 0 ";;" "" "This is a longer header text" 70 'single))) + ;; Should have 3 lines + (should (= 3 (length (split-string result "\n" t)))) + ;; Text should be present + (should (string-match-p "This is a longer header text" result)))) + +;;; Boundary Cases + +(ert-deftest test-unicode-box-elisp-minimum-length () + "Should work with minimum viable length." + (let ((result (test-unicode-box-at-column 0 ";;" "" "X" 15 'single))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "X" result)))) + +(ert-deftest test-unicode-box-elisp-very-long-length () + "Should handle very long length." + (let ((result (test-unicode-box-at-column 0 ";;" "" "Header" 200 'single))) + (should (= 3 (length (split-string result "\n" t)))) + ;; Border lines should be very long + (let ((first-line (car (split-string result "\n" t)))) + (should (> (length first-line) 100))))) + +(ert-deftest test-unicode-box-elisp-unicode-text () + "Should handle unicode in text." + (let ((result (test-unicode-box-at-column 0 ";;" "" "Hello 👋 مرحبا café" 70 'single))) + (should (string-match-p "👋" result)) + (should (string-match-p "مرحبا" result)) + (should (string-match-p "café" result)))) + +(ert-deftest test-unicode-box-elisp-very-long-text () + "Should handle very long text." + (let* ((long-text (make-string 100 ?x)) + (result (test-unicode-box-at-column 0 ";;" "" long-text 70 'single))) + ;; Should still generate output + (should (= 3 (length (split-string result "\n" t)))) + ;; Middle line should contain some of the text + (should (string-match-p "xxx" result)))) + +(ert-deftest test-unicode-box-elisp-comment-end-empty () + "Should handle empty comment-end correctly." + (let ((result (test-unicode-box-at-column 0 ";;" "" "Header" 70 'single))) + (should (= 3 (length (split-string result "\n" t)))) + ;; Lines should not have trailing comment-end + (should-not (string-match-p ";;.*;;$" result)))) + +(ert-deftest test-unicode-box-elisp-max-indentation () + "Should handle maximum practical indentation." + (let ((result (test-unicode-box-at-column 60 ";;" "" "Header" 100 'single))) + (should (= 3 (length (split-string result "\n" t)))) + ;; All lines should start with 60 spaces + (dolist (line (split-string result "\n" t)) + (should (string-prefix-p (make-string 60 ?\s) line))))) + +;;; Error Cases + +(ert-deftest test-unicode-box-elisp-length-too-small () + "Should error when length is too small." + (should-error + (test-unicode-box-at-column 0 ";;" "" "Header" 5 'single) + :type 'error)) + +(ert-deftest test-unicode-box-elisp-negative-length () + "Should error with negative length." + (should-error + (test-unicode-box-at-column 0 ";;" "" "Header" -10 'single) + :type 'error)) + +(ert-deftest test-unicode-box-elisp-zero-length () + "Should error with zero length." + (should-error + (test-unicode-box-at-column 0 ";;" "" "Header" 0 'single) + :type 'error)) + +(ert-deftest test-unicode-box-elisp-nil-text () + "Should error when text is nil." + (should-error + (test-unicode-box-at-column 0 ";;" "" nil 70 'single) + :type 'wrong-type-argument)) + +(ert-deftest test-unicode-box-elisp-non-integer-length () + "Should error when length is not an integer." + (should-error + (test-unicode-box-at-column 0 ";;" "" "Header" "not-a-number" 'single) + :type 'wrong-type-argument)) + +(ert-deftest test-unicode-box-elisp-invalid-box-style () + "Should handle invalid box-style gracefully." + ;; Function may use a default or error - either is acceptable + (let ((result (test-unicode-box-at-column 0 ";;" "" "Header" 70 'invalid))) + ;; Should still generate some output + (should (stringp result)))) + +;;; Python Tests (Hash-based comments) + +(ert-deftest test-unicode-box-python-single () + "Should generate unicode box with Python comment syntax." + (let ((result (test-unicode-box-at-column 0 "#" "" "Section" 70 'single))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "^# ┌" result)) + (should (string-match-p "Section" result)))) + +(ert-deftest test-unicode-box-python-double () + "Should generate double-line unicode box with Python comment syntax." + (let ((result (test-unicode-box-at-column 0 "#" "" "Section" 70 'double))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "^# ╔" result)) + (should (string-match-p "Section" result)))) + +;;; C Tests (C-style comments) + +(ert-deftest test-unicode-box-c-block-comments-single () + "Should generate unicode box with C block comment syntax." + (let ((result (test-unicode-box-at-column 0 "/*" "*/" "Section" 70 'single))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "^/\\* ┌" result)) + (should (string-match-p "Section" result)) + ;; Should include comment-end + (should (string-match-p "\\*/" result)))) + +(ert-deftest test-unicode-box-c-block-comments-double () + "Should generate double-line unicode box with C block comment syntax." + (let ((result (test-unicode-box-at-column 0 "/*" "*/" "Section" 70 'double))) + (should (= 3 (length (split-string result "\n" t)))) + (should (string-match-p "^/\\* ╔" result)) + (should (string-match-p "Section" result)) + ;; Should include comment-end + (should (string-match-p "\\*/" result)))) + +(provide 'test-custom-comments-comment-unicode-box) +;;; test-custom-comments-comment-unicode-box.el ends here diff --git a/tests/test-custom-comments-delete-buffer-comments.el b/tests/test-custom-comments-delete-buffer-comments.el new file mode 100644 index 00000000..a21386f9 --- /dev/null +++ b/tests/test-custom-comments-delete-buffer-comments.el @@ -0,0 +1,224 @@ +;;; test-custom-comments-delete-buffer-comments.el --- Tests for cj/delete-buffer-comments -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/delete-buffer-comments function from custom-comments.el +;; +;; This function deletes all comments in the current buffer by delegating to +;; Emacs' built-in `comment-kill` function. +;; +;; Cross-Language Testing Strategy: +;; -------------------------------- +;; This function works across multiple programming languages/major modes because +;; it delegates to `comment-kill`, which respects each mode's comment syntax +;; (comment-start, comment-end). +;; +;; Rather than testing exhaustively in every language (8+ languages = 100+ tests), +;; we test strategically: +;; +;; 1. EXTENSIVE testing in Emacs Lisp (our primary language): +;; - ~15 tests covering all normal/boundary/error cases +;; - Tests edge cases: empty buffers, inline comments, unicode, etc. +;; +;; 2. REPRESENTATIVE testing in Python and C: +;; - ~3 tests each proving different comment syntaxes work +;; - Python: hash-based comments (#) +;; - C: C-style line (//) and block (/* */) comments +;; +;; Why this approach? +;; - OUR code is simple: (goto-char (point-min)) + (comment-kill ...) +;; - We're testing OUR integration logic, not Emacs' comment-kill implementation +;; - After proving 3 different syntaxes work, additional languages have +;; diminishing returns (testing Emacs internals, not our code) +;; - Avoids test suite bloat (21 tests vs 100+) while maintaining confidence +;; - Groups languages by similarity: C-style covers C/Java/Go/JavaScript/Rust +;; +;; See ai-prompts/quality-engineer.org: "Testing Framework/Library Integration" + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-comments) + +;;; Test Helper + +(defun test-delete-comments-in-mode (mode content-before expected-after) + "Test comment deletion in MODE. +Insert CONTENT-BEFORE, run cj/delete-buffer-comments, verify EXPECTED-AFTER." + (with-temp-buffer + (funcall mode) + (insert content-before) + (cj/delete-buffer-comments) + (should (equal (string-trim (buffer-string)) (string-trim expected-after))))) + +;;; Emacs Lisp Tests (Primary Language - Comprehensive Coverage) + +(ert-deftest test-delete-comments-elisp-simple-line-comments () + "Should delete simple line comments in emacs-lisp-mode." + (test-delete-comments-in-mode + 'emacs-lisp-mode + ";; This is a comment\n(defun foo () nil)" + "(defun foo () nil)")) + +(ert-deftest test-delete-comments-elisp-inline-comments () + "Should delete inline/end-of-line comments." + (test-delete-comments-in-mode + 'emacs-lisp-mode + "(setq x 10) ;; set x to 10" + "(setq x 10)")) + +(ert-deftest test-delete-comments-elisp-only-comments () + "Buffer with only comments should become empty." + (test-delete-comments-in-mode + 'emacs-lisp-mode + ";; Comment 1\n;; Comment 2\n;; Comment 3" + "")) + +(ert-deftest test-delete-comments-elisp-mixed-code-and-comments () + "Should preserve code and delete all comments." + (test-delete-comments-in-mode + 'emacs-lisp-mode + ";; Header comment\n(defun foo ()\n ;; body comment\n (+ 1 2)) ;; inline" + "(defun foo ()\n\n (+ 1 2))")) + +(ert-deftest test-delete-comments-elisp-empty-buffer () + "Should do nothing in empty buffer." + (test-delete-comments-in-mode + 'emacs-lisp-mode + "" + "")) + +(ert-deftest test-delete-comments-elisp-no-comments () + "Should preserve all content when no comments exist." + (test-delete-comments-in-mode + 'emacs-lisp-mode + "(defun foo ()\n (+ 1 2))" + "(defun foo ()\n (+ 1 2))")) + +(ert-deftest test-delete-comments-elisp-whitespace-only-comments () + "Should delete comments containing only whitespace." + (test-delete-comments-in-mode + 'emacs-lisp-mode + ";; \n;; \t\n(setq x 1)" + "(setq x 1)")) + +(ert-deftest test-delete-comments-elisp-unicode-in-comments () + "Should handle unicode characters in comments." + (test-delete-comments-in-mode + 'emacs-lisp-mode + ";; Hello 👋 مرحبا café\n(setq x 1)" + "(setq x 1)")) + +(ert-deftest test-delete-comments-elisp-indented-comments () + "Should delete comments at various indentation levels." + (test-delete-comments-in-mode + 'emacs-lisp-mode + "(defun foo ()\n ;; indented comment\n ;; more indented\n (+ 1 2))" + "(defun foo ()\n\n\n (+ 1 2))")) + +(ert-deftest test-delete-comments-elisp-special-chars-in-comments () + "Should handle special characters in comments." + (test-delete-comments-in-mode + 'emacs-lisp-mode + ";; Special: !@#$%^&*()[]{}|\\/<>?\n(setq x 1)" + "(setq x 1)")) + +(ert-deftest test-delete-comments-elisp-point-not-at-beginning () + "Should work regardless of initial point position." + (with-temp-buffer + (emacs-lisp-mode) + (insert ";; Comment 1\n(setq x 1)\n;; Comment 2") + (goto-char (point-max)) ; Point at end + (cj/delete-buffer-comments) + (should (equal (string-trim (buffer-string)) "(setq x 1)")))) + +(ert-deftest test-delete-comments-elisp-does-not-affect-kill-ring () + "Should not add deleted comments to kill-ring." + (with-temp-buffer + (emacs-lisp-mode) + (insert ";; Comment\n(setq x 1)") + (setq kill-ring nil) + (cj/delete-buffer-comments) + (should (null kill-ring)))) + +(ert-deftest test-delete-comments-elisp-read-only-buffer () + "Should signal error in read-only buffer." + (with-temp-buffer + (emacs-lisp-mode) + (insert ";; Comment\n(setq x 1)") + (read-only-mode 1) + (should-error (cj/delete-buffer-comments)))) + +(ert-deftest test-delete-comments-elisp-narrowed-buffer () + "Should only affect visible region when narrowed." + (with-temp-buffer + (emacs-lisp-mode) + (insert ";; Comment 1\n(setq x 1)\n;; Comment 2\n(setq y 2)") + (goto-char (point-min)) + (forward-line 2) + (narrow-to-region (point) (point-max)) + (cj/delete-buffer-comments) + (widen) + ;; First comment should remain (was outside narrowed region) + ;; Second comment should be deleted + (should (string-match-p "Comment 1" (buffer-string))) + (should-not (string-match-p "Comment 2" (buffer-string))))) + + +;;; Python Tests (Hash-based comments) + +(ert-deftest test-delete-comments-python-simple () + "Should delete Python hash comments." + (test-delete-comments-in-mode + 'python-mode + "# This is a comment\ndef foo():\n return 42" + "def foo():\n return 42")) + +(ert-deftest test-delete-comments-python-inline () + "Should delete inline Python comments." + (test-delete-comments-in-mode + 'python-mode + "x = 10 # set x to 10\ny = 20" + "x = 10\ny = 20")) + +(ert-deftest test-delete-comments-python-mixed () + "Should preserve code and delete Python comments." + (test-delete-comments-in-mode + 'python-mode + "# Header\ndef foo():\n # body\n return 42 # inline" + "def foo():\n\n return 42")) + +;;; C Tests (C-style line and block comments) + +(ert-deftest test-delete-comments-c-line-comments () + "Should delete C line comments (//)." + (test-delete-comments-in-mode + 'c-mode + "// This is a comment\nint main() {\n return 0;\n}" + "int main() {\n return 0;\n}")) + +(ert-deftest test-delete-comments-c-block-comments () + "Should delete C block comments (/* */)." + (test-delete-comments-in-mode + 'c-mode + "/* Block comment */\nint x = 10;" + "int x = 10;")) + +(ert-deftest test-delete-comments-c-mixed () + "Should delete both line and block comments in C." + (test-delete-comments-in-mode + 'c-mode + "// Line comment\n/* Block comment */\nint x = 10; // inline" + "int x = 10;")) + +(provide 'test-custom-comments-delete-buffer-comments) +;;; test-custom-comments-delete-buffer-comments.el ends here diff --git a/tests/test-custom-functions-join-line-or-region.el.disabled b/tests/test-custom-functions-join-line-or-region.el.disabled new file mode 100644 index 00000000..d694e407 --- /dev/null +++ b/tests/test-custom-functions-join-line-or-region.el.disabled @@ -0,0 +1,84 @@ +;;; test-custom-functions-join-line-or-region.el --- Test cj/join-line-or-region -*- lexical-binding: t; -*- +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Tests for the cj/join-line-or-region function in custom-functions.el + +;;; Code: + +(add-to-list 'load-path (concat user-emacs-directory "modules")) +(require 'ert) +(require 'custom-functions) + + +(ert-deftest test-cj/join-line-or-region-normal-case () + (let* ((given "Line1\nLine2\nLine3\n") + (expected "Line1 Line2 Line3\n")) ; Note: join-line adds newline. + (with-temp-buffer + (insert given) + + ;; Properly set and activate the region + (push-mark (point-min) t t) ; Set mark, no message, activate + (goto-char (point-max)) ; This creates active region from min to max + + ;; Call the function being tested + (cj/join-line-or-region) + + ;; Perform assertions to check the expected result + (should (equal (buffer-substring-no-properties (point-min) (point-max)) + expected))))) + +(ert-deftest test-cj/join-line-or-region-multiple-spaces () + (let* ((given "Line1\n\n\n\n\nLine2\nLine3\n") + (expected "Line1 Line2 Line3\n")) ; Note: join-line adds newline. + (with-temp-buffer + (insert given) + + ;; Properly set and activate the region + (push-mark (point-min) t t) + (goto-char (point-max)) + + ;; Call the function being tested + (cj/join-line-or-region) + + ;; Perform assertions to check the expected result + (should (equal (buffer-substring-no-properties (point-min) (point-max)) + expected))))) + + +(ert-deftest test-cj/join-line-or-region-single-line () + (let* ((given "Line1\n") + (expected "Line1\n")) ; Note: join-line adds newline. + (with-temp-buffer + (insert given) + + ;; push the mark mid-way on the line + (goto-char (/ (point-max) 2)) + + ;; Call the function being tested + (cj/join-line-or-region) + + ;; Perform assertions to check the expected result + (should (equal (buffer-substring-no-properties (point-min) (point-max)) + expected))))) + +(ert-deftest test-cj/join-line-or-region-nothing () + (let* ((given "") + (expected "\n")) ; Note: join-line adds newline. + (with-temp-buffer + (insert given) + + ;; Properly set and activate the region + (push-mark (point-min) t t) + (goto-char (point-max)) + + ;; Call the function being tested + (cj/join-line-or-region) + + ;; Perform assertions to check the expected result + (should (equal (buffer-substring-no-properties (point-min) (point-max)) + expected))))) + + +(provide 'test-custom-functions.el-join-line-or-region) +;;; test-custom-functions-join-line-or-region.el ends here. diff --git a/tests/test-custom-line-paragraph-duplicate-line-or-region.el b/tests/test-custom-line-paragraph-duplicate-line-or-region.el new file mode 100644 index 00000000..bd82e00f --- /dev/null +++ b/tests/test-custom-line-paragraph-duplicate-line-or-region.el @@ -0,0 +1,451 @@ +;;; test-custom-line-paragraph-duplicate-line-or-region.el --- Tests for cj/duplicate-line-or-region -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/duplicate-line-or-region function from custom-line-paragraph.el +;; +;; This function duplicates the current line or active region below the original. +;; When called with a prefix argument, the duplicated text is commented out. +;; +;; IMPORTANT NOTE ON REGION ACTIVATION IN BATCH MODE: +;; When testing functions that use (region-active-p) in batch mode, you must +;; explicitly activate the region. Unlike interactive Emacs, batch mode does +;; not automatically activate regions when you set mark and point. +;; +;; To properly test region-based behavior in batch mode: +;; 1. Enable transient-mark-mode: (transient-mark-mode 1) +;; 2. Set mark and point as needed +;; 3. Explicitly activate the mark: (activate-mark) + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub expand-region package +(provide 'expand-region) + +;; Now load the actual production module +(require 'custom-line-paragraph) + +;;; Setup and Teardown + +(defun test-duplicate-line-or-region-setup () + "Setup for duplicate-line-or-region tests." + (cj/create-test-base-dir)) + +(defun test-duplicate-line-or-region-teardown () + "Teardown for duplicate-line-or-region tests." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-duplicate-line-or-region-single-line-without-comment () + "Should duplicate single line below original without commenting." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (string-match-p "line one\nline one" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-single-line-with-comment () + "Should duplicate single line and comment the duplicate." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (emacs-lisp-mode) ; Enable comment syntax + (insert "line one") + (goto-char (point-min)) + (cj/duplicate-line-or-region t) ; Pass comment argument + (should (string-match-p "line one\n;; line one" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-multi-line-region-without-comment () + "Should duplicate entire region below without commenting." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (transient-mark-mode 1) + (activate-mark) + (cj/duplicate-line-or-region) + (should (string-match-p "line one\nline two\nline three\nline one\nline two\nline three" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-multi-line-region-with-comment () + "Should duplicate region and comment all duplicated lines." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (emacs-lisp-mode) + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (transient-mark-mode 1) + (activate-mark) + (cj/duplicate-line-or-region t) + ;; All duplicated lines should be commented + (should (string-match-p ";; line one\n;; line two\n;; line three" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-cursor-position-unchanged () + "Should keep cursor at original position (save-excursion)." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two") + (goto-char (point-min)) + (forward-char 5) ; Position in middle of first line + (let ((original-pos (point))) + (cj/duplicate-line-or-region) + (should (= (point) original-pos)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-original-content-preserved () + "Should preserve original text unchanged." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "original line") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + ;; Original should still be there + (goto-char (point-min)) + (should (looking-at "original line"))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-preserves-text-content () + "Should exactly duplicate text content." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "exact text") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + ;; Count occurrences of "exact text" + (should (= 2 (how-many "exact text" (point-min) (point-max))))) + (test-duplicate-line-or-region-teardown))) + +;;; Boundary Cases + +(ert-deftest test-duplicate-line-or-region-at-buffer-start () + "Should handle duplication from beginning of buffer." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "first line\nsecond line") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (string-match-p "first line\nfirst line\nsecond line" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-at-buffer-end () + "Should handle duplication at end of buffer." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "first line\nlast line") + (goto-char (point-max)) + (cj/duplicate-line-or-region) + (should (string-match-p "last line\nlast line$" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-empty-line () + "Should duplicate empty line." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "") + (cj/duplicate-line-or-region) + ;; Should have duplicated the empty content + (should (string= "\n" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-only-whitespace () + "Should preserve whitespace in duplicate." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert " ") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (string= " \n " (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-very-long-line () + "Should handle very long lines (5000+ chars)." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (let ((long-line (make-string 5000 ?x))) + (insert long-line) + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (= 2 (how-many long-line (point-min) (point-max)))))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-region-with-empty-lines () + "Should duplicate empty lines within region." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\n\nline three") + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (transient-mark-mode 1) + (activate-mark) + (cj/duplicate-line-or-region) + ;; Should have empty line duplicated + (should (string-match-p "line one\n\nline three\nline one\n\nline three" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-single-character () + "Should handle minimal single character content." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "x") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (string= "x\nx" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-unicode-emoji () + "Should handle Unicode and emoji characters." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "hello 👋 café") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (string-match-p "hello 👋 café\nhello 👋 café" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-with-tabs () + "Should preserve tab characters." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line\twith\ttabs") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (string-match-p "line\twith\ttabs\nline\twith\ttabs" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-mixed-whitespace () + "Should preserve exact whitespace." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert " line \t text ") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (string= " line \t text \n line \t text " (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-narrowed-buffer () + "Should respect buffer narrowing." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "before\ntarget\nafter") + (goto-char (point-min)) + (forward-line 1) + (let ((beg (point))) + (forward-line 1) + (narrow-to-region beg (point)) + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (widen) + ;; Should still have before and after + (should (string-match-p "before" (buffer-string))) + (should (string-match-p "after" (buffer-string))) + ;; Target should be duplicated + (should (= 2 (how-many "target" (point-min) (point-max)))))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-backwards-region () + "Should handle backwards region (mark after point)." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two") + (goto-char (point-max)) + (set-mark (point)) + (goto-char (point-min)) + (transient-mark-mode 1) + (activate-mark) + (cj/duplicate-line-or-region) + (should (= 2 (how-many "line one" (point-min) (point-max)))) + (should (= 2 (how-many "line two" (point-min) (point-max))))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-entire-buffer () + "Should handle entire buffer selected as region." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "one\ntwo\nthree") + (transient-mark-mode 1) + (mark-whole-buffer) + (activate-mark) + (cj/duplicate-line-or-region) + (should (= 2 (how-many "one" (point-min) (point-max)))) + (should (= 2 (how-many "two" (point-min) (point-max)))) + (should (= 2 (how-many "three" (point-min) (point-max))))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-ending-mid-line () + "Should handle region ending mid-line." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (forward-char 5) ; Middle of first line + (set-mark (point)) + (forward-line 2) + (forward-char 5) ; Middle of third line + (transient-mark-mode 1) + (activate-mark) + (cj/duplicate-line-or-region) + ;; Should duplicate the selected portion + (should (> (length (buffer-string)) (length "line one\nline two\nline three")))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-trailing-whitespace () + "Should preserve trailing whitespace." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line with trailing ") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (string= "line with trailing \nline with trailing " (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-rtl-text () + "Should handle RTL text." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "مرحبا") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (= 2 (how-many "مرحبا" (point-min) (point-max))))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-combining-characters () + "Should handle Unicode combining characters." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "cafe\u0301") ; e with combining acute + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (string-match-p "cafe\u0301\ncafe\u0301" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-at-point-min () + "Should handle duplication at point-min edge case." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "first") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (= 2 (how-many "first" (point-min) (point-max))))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-at-point-max () + "Should handle duplication at point-max edge case." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "last") + (goto-char (point-max)) + (cj/duplicate-line-or-region) + (should (= 2 (how-many "last" (point-min) (point-max))))) + (test-duplicate-line-or-region-teardown))) + +;;; Error Cases + +(ert-deftest test-duplicate-line-or-region-read-only-buffer () + "Should error when attempting to modify read-only buffer." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "read only line") + (goto-char (point-min)) + (read-only-mode 1) + (should-error (cj/duplicate-line-or-region))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-buffer-modified-flag () + "Should set buffer modified flag." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line") + (set-buffer-modified-p nil) + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (buffer-modified-p))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-undo-behavior () + "Should support undo after duplication." + (test-duplicate-line-or-region-setup) + (unwind-protect + (let* ((temp-file (expand-file-name "test-undo-dup.txt" cj/test-base-dir)) + (original-content "line one")) + ;; Create file with initial content + (with-temp-file temp-file + (insert original-content)) + ;; Open file and test undo + (find-file temp-file) + (buffer-enable-undo) + ;; Establish undo history + (goto-char (point-min)) + (insert " ") + (delete-char -1) + (undo-boundary) + (goto-char (point-min)) + (let ((before-dup (buffer-string))) + (cj/duplicate-line-or-region) + (undo-boundary) + (let ((after-dup (buffer-string))) + (should-not (string= before-dup after-dup)) + (undo) + (should (string= before-dup (buffer-string))))) + (kill-buffer (current-buffer))) + (test-duplicate-line-or-region-teardown))) + + +(ert-deftest test-duplicate-line-or-region-special-characters () + "Should handle control characters." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line\u000Cwith\u000Dcontrol") + (goto-char (point-min)) + (cj/duplicate-line-or-region) + (should (string-match-p "line\u000Cwith\u000Dcontrol\nline\u000Cwith\u000Dcontrol" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(provide 'test-custom-line-paragraph-duplicate-line-or-region) +;;; test-custom-line-paragraph-duplicate-line-or-region.el ends here diff --git a/tests/test-custom-line-paragraph-join-line-or-region.el b/tests/test-custom-line-paragraph-join-line-or-region.el new file mode 100644 index 00000000..0d28ab6c --- /dev/null +++ b/tests/test-custom-line-paragraph-join-line-or-region.el @@ -0,0 +1,618 @@ +;;; test-custom-line-paragraph-join-line-or-region.el --- Tests for cj/join-line-or-region -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/join-line-or-region function from custom-line-paragraph.el +;; +;; IMPORTANT NOTE ON REGION ACTIVATION IN BATCH MODE: +;; When testing functions that use (use-region-p) in batch mode, you must +;; explicitly activate the region. Unlike interactive Emacs, batch mode does +;; not automatically activate regions when you set mark and point. +;; +;; To properly test region-based behavior in batch mode: +;; 1. Enable transient-mark-mode: (transient-mark-mode 1) +;; 2. Set mark and point as needed +;; 3. Explicitly activate the mark: (activate-mark) +;; +;; Without these steps, (use-region-p) will return nil even when mark and +;; point are set, causing the function to take the no-region code path. +;; This is a common pitfall that junior developers may miss when writing +;; ERT tests for region-aware commands. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub expand-region package +(provide 'expand-region) + +;; Now load the actual production module +(require 'custom-line-paragraph) + +;;; Setup and Teardown + +(defun test-join-line-or-region-setup () + "Setup for join-line-or-region tests." + (cj/create-test-base-dir)) + +(defun test-join-line-or-region-teardown () + "Teardown for join-line-or-region tests." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-join-line-or-region-no-region-joins-with-previous-line () + "Without region, should join current line with previous line." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (string-match-p "line one line two" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-no-region-adds-newline-after-join () + "Without region, should add newline after joining." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (string-suffix-p "\n" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-with-region-joins-all-lines () + "With region, should join all lines in region." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (activate-mark) + (cj/join-line-or-region) + (should (string-match-p "line one line two line three" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-with-region-adds-newline-at-end () + "With region, should add newline at end." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (activate-mark) + (cj/join-line-or-region) + (should (string-suffix-p "\n" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-preserves-text-content () + "Should preserve all text content when joining." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "hello\nworld") + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (activate-mark) + (cj/join-line-or-region) + (should (string-match-p "hello.*world" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-removes-line-breaks-between-words () + "Should remove line breaks and add spaces between words." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "hello\nworld") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (string-match-p "hello world" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-multiple-lines-in-region () + "Should handle multiple lines in region correctly." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "one\ntwo\nthree\nfour\nfive") + (goto-char (point-min)) + (forward-line 1) + (set-mark (point)) + (forward-line 3) + (activate-mark) + (cj/join-line-or-region) + (should (string-match-p "two three four" (buffer-string)))) + (test-join-line-or-region-teardown))) + +;;; Boundary Cases + +(ert-deftest test-join-line-or-region-on-first-line-no-region-does-nothing-except-newline () + "On first line without region, should only add newline." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "only line") + (goto-char (point-min)) + (cj/join-line-or-region) + (should (string= "only line\n" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-empty-lines-in-region () + "Should handle empty lines in region." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\n\nline three") + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (activate-mark) + (cj/join-line-or-region) + (should (string-match-p "line one.*line three" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-single-line-region () + "Should handle single-line region." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "only line") + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (activate-mark) + (cj/join-line-or-region) + (should (string= "only line\n" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-region-with-only-whitespace-lines () + "Should handle region with only whitespace lines." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert " \n \n ") + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (activate-mark) + (cj/join-line-or-region) + (should (stringp (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-lines-with-leading-whitespace () + "Should handle lines with leading whitespace." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\n line two") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (string-match-p "line one.*line two" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-lines-with-trailing-whitespace () + "Should handle lines with trailing whitespace." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one \nline two") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (string-match-p "line one.*line two" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-lines-with-tabs () + "Should handle lines with tab characters." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line\tone\nline\ttwo") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (string-match-p "line.*one.*line.*two" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-lines-with-mixed-whitespace () + "Should handle lines with mixed whitespace." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert " line \t one \n\t line two\t") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (string-match-p "line.*one.*line.*two" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-very-long-lines () + "Should handle very long lines." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (let ((long-line (make-string 5000 ?x))) + (insert long-line "\n" long-line) + (goto-char (point-max)) + (cj/join-line-or-region) + (should (= (length (buffer-string)) (+ (* 2 5000) 1 1))))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-unicode-characters () + "Should handle unicode characters." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "café\nnaïve") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (string-match-p "café.*naïve" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-emoji-content () + "Should handle emoji content." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "hello 👋\nworld 🌍") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (string-match-p "hello 👋.*world 🌍" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-rtl-text () + "Should handle RTL text." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "مرحبا\nعالم") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (string-match-p "مرحبا.*عالم" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-region-at-buffer-start () + "Should handle region starting at buffer beginning." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (set-mark (point)) + (forward-line 2) + (activate-mark) + (cj/join-line-or-region) + (should (string-match-p "line one line two" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-region-at-buffer-end () + "Should handle region ending at buffer end." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (forward-line 1) + (set-mark (point)) + (goto-char (point-max)) + (activate-mark) + (cj/join-line-or-region) + (should (string-match-p "line two line three" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-entire-buffer-as-region () + "Should handle entire buffer selected as region." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "one\ntwo\nthree") + (transient-mark-mode 1) + (mark-whole-buffer) + (activate-mark) + (cj/join-line-or-region) + (should (string-match-p "one two three" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-single-character-lines () + "Should handle single character lines." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "a\nb\nc") + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (activate-mark) + (cj/join-line-or-region) + (should (string-match-p "a b c" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-cursor-position-after-no-region () + "Cursor should be at end after joining without region." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (= (point) (point-max)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-cursor-position-after-region () + "Cursor should be at region end marker after joining region." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (let ((end-pos (point))) + (activate-mark) + (cj/join-line-or-region) + ;; Point should be near the original end position + (should (>= (point) (- end-pos 10))))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-marker-validity-after-operation () + "Marker should remain valid after operation." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (let ((marker (set-marker (make-marker) (point-min)))) + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (activate-mark) + (cj/join-line-or-region) + (should (marker-position marker)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-backwards-region () + "Should handle backwards region (mark after point)." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (goto-char (point-max)) + (set-mark (point)) + (goto-char (point-min)) + (activate-mark) + (cj/join-line-or-region) + (should (string-match-p "line one line two line three" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-partial-line-selection () + "Should handle region starting mid-line and ending mid-line." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (forward-char 5) ; Middle of "line one" + (set-mark (point)) + (forward-line 2) + (forward-char 5) ; Middle of "line three" + (activate-mark) + (cj/join-line-or-region) + ;; Should join lines regardless of partial selection + (should (string-match-p "line two" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-stress-test-many-lines () + "Should handle many lines (1000+) without hanging." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (dotimes (i 1000) + (insert (format "line %d\n" i))) + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (activate-mark) + (let ((start-time (current-time))) + (cj/join-line-or-region) + (let ((elapsed (float-time (time-subtract (current-time) start-time)))) + ;; Should complete in reasonable time (< 5 seconds) + (should (< elapsed 5.0)))) + ;; Verify all lines joined + (goto-char (point-min)) + (should (string-match-p "line 0.*line 999" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-combining-characters () + "Should handle Unicode combining characters." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + ;; e with combining acute accent (é) + (insert "cafe\u0301\nnaive\u0308") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (string-match-p "cafe\u0301.*naive\u0308" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-control-characters () + "Should handle control characters." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line\u000Cone\nline\u000Ctwo") + (goto-char (point-max)) + (cj/join-line-or-region) + ;; Should preserve control characters + (should (string-match-p "line.*one.*line.*two" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-narrowed-buffer () + "Should respect buffer narrowing." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "before\nline one\nline two\nafter") + (goto-char (point-min)) + (forward-line 1) + (let ((beg (point))) + (forward-line 2) + (narrow-to-region beg (point)) + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (activate-mark) + (cj/join-line-or-region) + (widen) + ;; Should only affect narrowed region + (should (string-match-p "before" (buffer-string))) + (should (string-match-p "after" (buffer-string))) + (should (string-match-p "line one.*line two" (buffer-string))))) + (test-join-line-or-region-teardown))) + +;;; Error Cases + +(ert-deftest test-join-line-or-region-empty-buffer-no-region () + "Should handle empty buffer gracefully without region." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (cj/join-line-or-region) + (should (string= "\n" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-empty-buffer-with-region () + "Should handle empty buffer gracefully with region." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (mark-whole-buffer) + (cj/join-line-or-region) + (should (string= "\n" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-single-line-buffer-no-region () + "Should handle single line buffer without region." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "only line") + (goto-char (point-max)) + (cj/join-line-or-region) + (should (string= "only line\n" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-read-only-buffer-should-error () + "Should error when attempting to modify read-only buffer." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two") + (goto-char (point-max)) + (read-only-mode 1) + (should-error (cj/join-line-or-region))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-undo-behavior () + "Should properly support undo after joining lines." + (test-join-line-or-region-setup) + (unwind-protect + (let* ((temp-file (expand-file-name "test-undo.txt" cj/test-base-dir)) + (original-content "line one\nline two")) + ;; Create file with initial content + (with-temp-file temp-file + (insert original-content)) + ;; Open file and test undo + (find-file temp-file) + (buffer-enable-undo) ; Ensure undo is enabled + ;; Make a small change to establish undo history + (goto-char (point-min)) + (insert " ") + (delete-char -1) + (undo-boundary) ; Create explicit boundary + (goto-char (point-max)) + (let ((before-join (buffer-string))) + (cj/join-line-or-region) + (undo-boundary) ; Create boundary after operation + (let ((after-join (buffer-string))) + (should-not (string= before-join after-join)) + ;; Undo should work now + (undo) + (should (string= before-join (buffer-string))))) + (kill-buffer (current-buffer))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-buffer-modified-flag () + "Should set buffer modified flag after joining lines." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two") + (set-buffer-modified-p nil) + (goto-char (point-max)) + (cj/join-line-or-region) + (should (buffer-modified-p))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-region-deactivation () + "Should deactivate region after operation." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (transient-mark-mode 1) + (goto-char (point-min)) + (set-mark (point)) + (goto-char (point-max)) + (activate-mark) + (should (use-region-p)) + (cj/join-line-or-region) + ;; Region should be deactivated after operation + (should-not (use-region-p))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-dos-line-endings () + "Should handle DOS-style line endings (CRLF) and preserve them." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\r\nline two\r\n") + ;; Go to line two so we can join with line one + (goto-char (point-min)) + (forward-line 1) + (cj/join-line-or-region) + ;; Should join lines (join-line handles the line endings) + (should (string-match-p "line one.*line two" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(ert-deftest test-join-line-or-region-consecutive-operations () + "Should handle consecutive join operations correctly." + (test-join-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three\nline four") + ;; First operation: on line two, joins with line one + (goto-char (point-min)) + (forward-line 1) + (cj/join-line-or-region) + (should (string-match-p "line one line two" (buffer-string))) + ;; Second operation: on line four, joins with line three + (goto-char (point-min)) + (search-forward "line four") + (cj/join-line-or-region) + (should (string-match-p "line three line four" (buffer-string))) + ;; Both operations should have worked (note: each operation adds a newline) + (should (string-match-p "line one line two\n+line three line four" (buffer-string)))) + (test-join-line-or-region-teardown))) + +(provide 'test-custom-line-paragraph-join-line-or-region) +;;; test-custom-line-paragraph-join-line-or-region.el ends here diff --git a/tests/test-custom-line-paragraph-join-paragraph.el b/tests/test-custom-line-paragraph-join-paragraph.el new file mode 100644 index 00000000..a84adc6c --- /dev/null +++ b/tests/test-custom-line-paragraph-join-paragraph.el @@ -0,0 +1,360 @@ +;;; test-custom-line-paragraph-join-paragraph.el --- Tests for cj/join-paragraph -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/join-paragraph function from custom-line-paragraph.el +;; +;; IMPORTANT NOTE ON REGION ACTIVATION IN BATCH MODE: +;; When testing functions that use (use-region-p) in batch mode, you must +;; explicitly activate the region. Unlike interactive Emacs, batch mode does +;; not automatically activate regions when you set mark and point. +;; +;; To properly test region-based behavior in batch mode: +;; 1. Enable transient-mark-mode: (transient-mark-mode 1) +;; 2. Set mark and point as needed +;; 3. Explicitly activate the mark: (activate-mark) +;; +;; Without these steps, (use-region-p) will return nil even when mark and +;; point are set, causing the function to take the no-region code path. +;; This is a common pitfall that junior developers may miss when writing +;; ERT tests for region-aware commands. +;; +;; The cj/join-paragraph function uses er/mark-paragraph which sets a region, +;; so we need to ensure transient-mark-mode is enabled in our tests. + +;;; Code: + +;; Add tests directory to load path for testutil-general +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) + +(require 'ert) +(require 'testutil-general) + +;; Initialize package system to load expand-region +(require 'package) +(setq package-user-dir (expand-file-name "elpa" user-emacs-directory)) +(package-initialize) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Add expand-region to load path explicitly +(add-to-list 'load-path (expand-file-name "elpa/expand-region-1.0.0" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Load expand-region for real (needed by cj/join-paragraph) +(require 'expand-region) +(require 'the-org-mode-expansions) + +;; Now load the actual production module +(require 'custom-line-paragraph) + +;; -------------------------------- Test Fixtures ------------------------------ + +(defun test-join-paragraph-setup () + "Set up test environment." + (cj/create-test-base-dir)) + +(defun test-join-paragraph-teardown () + "Clean up test environment." + (cj/delete-test-base-dir)) + +;; ---------------------------- Normal Cases ----------------------------------- + +(ert-deftest test-join-paragraph-simple-multiline-cursor-at-start () + "Join a simple 3-line paragraph with cursor at start." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (cj/join-paragraph) + (should (string= (buffer-substring-no-properties (point-min) (point-max)) + "line one line two line three\n"))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-simple-multiline-cursor-in-middle () + "Join a simple 3-line paragraph with cursor in middle line." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (forward-line 1) + (cj/join-paragraph) + (should (string= (buffer-substring-no-properties (point-min) (point-max)) + "line one line two line three\n"))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-simple-multiline-cursor-at-end () + "Join a simple 3-line paragraph with cursor at end." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "line one\nline two\nline three") + (goto-char (point-max)) + (cj/join-paragraph) + (should (string= (buffer-substring-no-properties (point-min) (point-max)) + "line one line two line three\n"))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-surrounded-by-other-paragraphs () + "Join only the current paragraph when surrounded by others." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "para one line one\npara one line two\n\n") + (insert "para two line one\npara two line two\n\n") + (insert "para three line one\npara three line two") + ;; Position in middle paragraph + (goto-char (point-min)) + (forward-line 3) + (cj/join-paragraph) + (should (string-match-p "para one line one\npara one line two" + (buffer-string))) + (should (string-match-p "para two line one para two line two" + (buffer-string))) + (should (string-match-p "para three line one\npara three line two" + (buffer-string)))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-with-leading-whitespace () + "Join paragraph with indented lines, preserving appropriate spacing." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert " indented line one\n indented line two\n indented line three") + (goto-char (point-min)) + (cj/join-paragraph) + (should (string= (buffer-substring-no-properties (point-min) (point-max)) + " indented line one indented line two indented line three\n"))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-cursor-position-after () + "Verify cursor moves forward one line after joining." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "line one\nline two\nline three\n") + (goto-char (point-min)) + (let ((initial-line (line-number-at-pos))) + (cj/join-paragraph) + (should (= (line-number-at-pos) (1+ initial-line))))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-multiple-paragraphs-first () + "Join only first paragraph when three paragraphs exist." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "first one\nfirst two\n\nsecond one\nsecond two\n\nthird one\nthird two") + (goto-char (point-min)) + (cj/join-paragraph) + (should (string-match-p "^first one first two\n" (buffer-string))) + (should (string-match-p "second one\nsecond two" (buffer-string))) + (should (string-match-p "third one\nthird two" (buffer-string)))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-multiple-paragraphs-middle () + "Join only middle paragraph when three paragraphs exist." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "first one\nfirst two\n\nsecond one\nsecond two\n\nthird one\nthird two") + (goto-char (point-min)) + (forward-line 3) + (cj/join-paragraph) + (should (string-match-p "first one\nfirst two" (buffer-string))) + (should (string-match-p "second one second two" (buffer-string))) + (should (string-match-p "third one\nthird two" (buffer-string)))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-multiple-paragraphs-last () + "Join only last paragraph when three paragraphs exist." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "first one\nfirst two\n\nsecond one\nsecond two\n\nthird one\nthird two") + (goto-char (point-max)) + (cj/join-paragraph) + (should (string-match-p "first one\nfirst two" (buffer-string))) + (should (string-match-p "second one\nsecond two" (buffer-string))) + (should (string-match-p "third one third two" (buffer-string)))) + (test-join-paragraph-teardown))) + +;; ---------------------------- Boundary Cases --------------------------------- + +(ert-deftest test-join-paragraph-single-line-paragraph () + "Handle paragraph with only one line gracefully." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "single line paragraph") + (goto-char (point-min)) + (cj/join-paragraph) + ;; Should still work, even if nothing to join + (should (string= (buffer-substring-no-properties (point-min) (point-max)) + "single line paragraph\n"))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-at-buffer-start () + "Join paragraph at very beginning of buffer." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "first line\nsecond line\nthird line\n\nother paragraph") + (goto-char (point-min)) + (cj/join-paragraph) + (should (string-match-p "^first line second line third line\n" (buffer-string)))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-at-buffer-end () + "Join paragraph at very end of buffer." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "other paragraph\n\nfirst line\nsecond line\nthird line") + (goto-char (point-max)) + (cj/join-paragraph) + (should (string-match-p "first line second line third line\n$" (buffer-string)))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-very-long () + "Join paragraph with many lines (20+ lines)." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (dotimes (i 25) + (insert (format "line %d\n" (1+ i)))) + (goto-char (point-min)) + (cj/join-paragraph) + ;; Should have all 25 "line X" strings joined with spaces + (should (string-match-p "line 1 line 2 line 3.*line 24 line 25" (buffer-string))) + ;; Should not have multiple newlines in sequence + (should-not (string-match-p "\n.*\n.*\n" (buffer-string)))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-with-blank-lines-within () + "Test behavior when expand-region might see internal structure." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + ;; This tests how er/mark-paragraph handles the content + (insert "line one\n\nline two\n\nother para") + (goto-char (point-min)) + (cj/join-paragraph) + ;; er/mark-paragraph should mark just the first line in this case + (should (string-match-p "^line one\n" (buffer-string)))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-cursor-on-blank-line () + "Handle cursor positioned on blank line between paragraphs." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "para one\npara one line two\n\npara two\npara two line two") + (goto-char (point-min)) + (forward-line 2) ;; Position on blank line + (cj/join-paragraph) + ;; Behavior depends on how er/mark-paragraph handles blank lines + ;; At minimum, should not error + (should (bufferp (current-buffer)))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-no-trailing-newline () + "Handle paragraph at end of buffer with no trailing newline." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "line one\nline two\nline three") + (goto-char (point-min)) + (cj/join-paragraph) + (should (string= (buffer-substring-no-properties (point-min) (point-max)) + "line one line two line three\n"))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-only-whitespace-lines () + "Handle paragraph where lines contain only spaces/tabs." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert " \n\t\t\n \t ") + (goto-char (point-min)) + (cj/join-paragraph) + ;; Should handle without error + (should (bufferp (current-buffer)))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-unicode-content () + "Handle paragraph with emoji and special Unicode characters." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "Hello 👋 world\nこんにちは 世界\n🎉 celebration 🎊") + (goto-char (point-min)) + (cj/join-paragraph) + (should (string= (buffer-substring-no-properties (point-min) (point-max)) + "Hello 👋 world こんにちは 世界 🎉 celebration 🎊\n"))) + (test-join-paragraph-teardown))) + +;; ---------------------------- Error Cases ------------------------------------ + +(ert-deftest test-join-paragraph-empty-buffer () + "Handle empty buffer without error." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + ;; Empty buffer - should handle gracefully without error + (cj/join-paragraph) + (should (bufferp (current-buffer)))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-buffer-only-whitespace () + "Handle buffer containing only whitespace." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert " \n\n\t\t\n ") + (goto-char (point-min)) + (cj/join-paragraph) + ;; Should handle without error + (should (bufferp (current-buffer)))) + (test-join-paragraph-teardown))) + +(ert-deftest test-join-paragraph-buffer-single-character () + "Handle buffer with minimal content." + (test-join-paragraph-setup) + (unwind-protect + (with-temp-buffer + (transient-mark-mode 1) + (insert "x") + (goto-char (point-min)) + (cj/join-paragraph) + (should (string= (buffer-substring-no-properties (point-min) (point-max)) + "x\n"))) + (test-join-paragraph-teardown))) + +(provide 'test-custom-line-paragraph-join-paragraph) +;;; test-custom-line-paragraph-join-paragraph.el ends here diff --git a/tests/test-custom-line-paragraph-remove-duplicate-lines-region-or-buffer.el b/tests/test-custom-line-paragraph-remove-duplicate-lines-region-or-buffer.el new file mode 100644 index 00000000..f3fe0fdd --- /dev/null +++ b/tests/test-custom-line-paragraph-remove-duplicate-lines-region-or-buffer.el @@ -0,0 +1,471 @@ +;;; test-custom-line-paragraph-remove-duplicate-lines-region-or-buffer.el --- Tests for cj/remove-duplicate-lines-region-or-buffer -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/remove-duplicate-lines-region-or-buffer function from custom-line-paragraph.el +;; +;; This function removes duplicate lines in the region or buffer, keeping the first occurrence. +;; Operates on the active region when one exists; otherwise operates on the whole buffer. +;; +;; The implementation uses a regex to find duplicate lines: "^\\(.*\\)\n\\(\\(.*\n\\)*\\)\\1\n" +;; This pattern matches a line, then any number of lines in between, then the same line again. +;; +;; IMPORTANT NOTE ON REGION ACTIVATION IN BATCH MODE: +;; When testing functions that use (use-region-p) in batch mode, you must +;; explicitly activate the region. Unlike interactive Emacs, batch mode does +;; not automatically activate regions when you set mark and point. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub expand-region package +(provide 'expand-region) + +;; Now load the actual production module +(require 'custom-line-paragraph) + +;;; Setup and Teardown + +(defun test-remove-duplicate-lines-setup () + "Setup for remove-duplicate-lines tests." + (cj/create-test-base-dir)) + +(defun test-remove-duplicate-lines-teardown () + "Teardown for remove-duplicate-lines tests." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-remove-duplicate-lines-adjacent-duplicates () + "Should remove adjacent duplicate lines." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline one\nline two") + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= "line one\nline two" (buffer-string)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-keep-first-occurrence () + "Should keep first occurrence and remove subsequent duplicates." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "first\nsecond\nfirst\nthird") + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= "first\nsecond\nthird" (buffer-string)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-multiple-sets () + "Should remove multiple different duplicated lines." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "alpha\nbeta\nalpha\ngamma\nbeta\n") + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= "alpha\nbeta\ngamma\n" (buffer-string)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-no-duplicates () + "Should leave buffer unchanged when no duplicates exist." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (let ((original (buffer-string))) + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= original (buffer-string))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-region-only () + "Should only affect active region, leaving rest of buffer unchanged." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "before\ndup\ndup\nafter") + (goto-char (point-min)) + (forward-line 1) + (set-mark (point)) + (forward-line 2) + (transient-mark-mode 1) + (activate-mark) + (cj/remove-duplicate-lines-region-or-buffer) + ;; Should have removed one "dup" but kept before and after + (should (string-match-p "before" (buffer-string))) + (should (string-match-p "after" (buffer-string))) + (should (= 1 (how-many "^dup$" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-whole-buffer () + "Should operate on entire buffer when no region active." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "one\ntwo\none\nthree\ntwo\n") + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= "one\ntwo\nthree\n" (buffer-string)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-preserve-unique () + "Should preserve all unique lines intact." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "unique1\ndup\nunique2\ndup\nunique3") + (cj/remove-duplicate-lines-region-or-buffer) + (should (string-match-p "unique1" (buffer-string))) + (should (string-match-p "unique2" (buffer-string))) + (should (string-match-p "unique3" (buffer-string))) + (should (= 1 (how-many "^dup$" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-separated-by-content () + "Should remove duplicate lines even when separated by other content." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "target\nother1\nother2\ntarget\n") + (cj/remove-duplicate-lines-region-or-buffer) + (should (= 1 (how-many "^target$" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +;;; Boundary Cases + +(ert-deftest test-remove-duplicate-lines-empty-buffer () + "Should handle empty buffer gracefully." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= "" (buffer-string)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-single-line () + "Should handle single line buffer (no duplicates possible)." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "only line") + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= "only line" (buffer-string)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-two-identical-lines () + "Should handle minimal duplicate case of two identical lines." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "same\nsame\n") + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= "same\n" (buffer-string)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-all-identical () + "Should keep only one line when all lines are identical." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "same\nsame\nsame\nsame\n") + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= "same\n" (buffer-string)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-at-buffer-start () + "Should handle duplicates at beginning of buffer." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "first\nfirst\nsecond\nthird") + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= "first\nsecond\nthird" (buffer-string)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-at-buffer-end () + "Should handle duplicates at end of buffer." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "first\nsecond\nlast\nlast\n") + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= "first\nsecond\nlast\n" (buffer-string)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-empty-lines () + "Should handle duplicate empty lines." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "line1\n\n\nline2") + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= "line1\n\nline2" (buffer-string)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-whitespace-only () + "Should handle duplicate whitespace-only lines." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert " \n \ntext") + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= " \ntext" (buffer-string)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-very-long () + "Should handle very long duplicate lines (5000+ chars)." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (let ((long-line (make-string 5000 ?x))) + (insert long-line "\n" long-line "\nshort") + (cj/remove-duplicate-lines-region-or-buffer) + (should (= 1 (how-many (regexp-quote long-line) (point-min) (point-max)))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-unicode-emoji () + "Should handle Unicode and emoji duplicates." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "hello 👋\nhello 👋\nother") + (cj/remove-duplicate-lines-region-or-buffer) + (should (= 1 (how-many "hello 👋" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-with-tabs () + "Should preserve and match tab characters." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "line\twith\ttabs\nline\twith\ttabs\nother") + (cj/remove-duplicate-lines-region-or-buffer) + (should (= 1 (how-many "line\twith\ttabs" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-mixed-whitespace () + "Should do exact whitespace matching." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert " line \t text \n line \t text \nother") + (cj/remove-duplicate-lines-region-or-buffer) + (should (= 1 (how-many " line \t text " (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-rtl-text () + "Should handle RTL text duplicates." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "مرحبا\nمرحبا\nعالم") + (cj/remove-duplicate-lines-region-or-buffer) + (should (= 1 (how-many "مرحبا" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-case-insensitive () + "Should treat different cases as same line (case-insensitive by default)." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "Line\nline\nLINE\n") + (cj/remove-duplicate-lines-region-or-buffer) + ;; Case-insensitive matching, so duplicates removed + (should (= 1 (how-many "^[Ll][Ii][Nn][Ee]$" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-trailing-whitespace-matters () + "Should treat trailing whitespace as significant." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "line \nline\nline \n") + (cj/remove-duplicate-lines-region-or-buffer) + ;; "line " appears twice, one should be removed + (should (= 1 (how-many "line $" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-leading-whitespace-matters () + "Should treat leading whitespace as significant." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert " line\nline\n line\n") + (cj/remove-duplicate-lines-region-or-buffer) + ;; " line" appears twice, one should be removed + (should (= 1 (how-many "^ line$" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-narrowed-buffer () + "Should respect buffer narrowing." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "before\ndup\ndup\nafter") + (goto-char (point-min)) + (forward-line 1) + (let ((beg (point))) + (forward-line 2) + (narrow-to-region beg (point)) + (cj/remove-duplicate-lines-region-or-buffer) + (widen) + ;; Should still have before and after + (should (string-match-p "before" (buffer-string))) + (should (string-match-p "after" (buffer-string))) + ;; Should have removed one dup + (should (= 1 (how-many "^dup$" (point-min) (point-max)))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-backwards-region () + "Should handle backwards region (mark after point)." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "dup\ndup\nother") + (goto-char (point-max)) + (set-mark (point)) + (goto-char (point-min)) + (transient-mark-mode 1) + (activate-mark) + (cj/remove-duplicate-lines-region-or-buffer) + (should (= 1 (how-many "^dup$" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-entire-buffer-as-region () + "Should handle entire buffer selected as region." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "one\ntwo\none\nthree") + (transient-mark-mode 1) + (mark-whole-buffer) + (activate-mark) + (cj/remove-duplicate-lines-region-or-buffer) + (should (= 1 (how-many "^one$" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-region-no-duplicates () + "Should leave region unchanged when no duplicates exist." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "before\nunique1\nunique2\nafter") + (goto-char (point-min)) + (forward-line 1) + (set-mark (point)) + (forward-line 2) + (transient-mark-mode 1) + (activate-mark) + (let ((original (buffer-string))) + (cj/remove-duplicate-lines-region-or-buffer) + (should (string= original (buffer-string))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-three-or-more () + "Should keep first and remove all other duplicates." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "dup\nother1\ndup\nother2\ndup\nother3\ndup\n") + (cj/remove-duplicate-lines-region-or-buffer) + (should (= 1 (how-many "^dup$" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-alternating-pattern () + "Should handle alternating duplicate pattern (A B A B)." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "A\nB\nA\nB\n") + (cj/remove-duplicate-lines-region-or-buffer) + ;; Should keep first A and first B, remove duplicates + (should (= 1 (how-many "^A$" (point-min) (point-max)))) + (should (= 1 (how-many "^B$" (point-min) (point-max))))) + (test-remove-duplicate-lines-teardown))) + +;;; Error Cases + +(ert-deftest test-remove-duplicate-lines-read-only-buffer () + "Should error when attempting to modify read-only buffer." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "dup\ndup\n") + (read-only-mode 1) + (should-error (cj/remove-duplicate-lines-region-or-buffer))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-buffer-modified-flag () + "Should set buffer modified flag when duplicates removed." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "dup\ndup\n") + (set-buffer-modified-p nil) + (cj/remove-duplicate-lines-region-or-buffer) + (should (buffer-modified-p))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-undo-behavior () + "Should support undo after removing duplicates." + (test-remove-duplicate-lines-setup) + (unwind-protect + (let* ((temp-file (expand-file-name "test-undo-rmdup.txt" cj/test-base-dir)) + (original-content "dup\ndup\nother")) + ;; Create file with initial content + (with-temp-file temp-file + (insert original-content)) + ;; Open file and test undo + (find-file temp-file) + (buffer-enable-undo) + ;; Establish undo history + (goto-char (point-min)) + (insert " ") + (delete-char -1) + (undo-boundary) + (let ((before-remove (buffer-string))) + (cj/remove-duplicate-lines-region-or-buffer) + (undo-boundary) + (let ((after-remove (buffer-string))) + (should-not (string= before-remove after-remove)) + (undo) + (should (string= before-remove (buffer-string))))) + (kill-buffer (current-buffer))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-cursor-position-preserved () + "Should preserve cursor position (save-excursion)." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "line1\ndup\nline2\ndup\nline3") + (goto-char (point-min)) + (forward-char 3) ; Position in middle of first line + (let ((original-pos (point))) + (cj/remove-duplicate-lines-region-or-buffer) + (should (= (point) original-pos)))) + (test-remove-duplicate-lines-teardown))) + +(ert-deftest test-remove-duplicate-lines-region-preserved () + "Should preserve region state (save-excursion maintains mark)." + (test-remove-duplicate-lines-setup) + (unwind-protect + (with-temp-buffer + (insert "dup\ndup\nother\n") + (transient-mark-mode 1) + (mark-whole-buffer) + (activate-mark) + (should (use-region-p)) + (cj/remove-duplicate-lines-region-or-buffer) + ;; save-excursion preserves mark, so region stays active + (should (use-region-p))) + (test-remove-duplicate-lines-teardown))) + +(provide 'test-custom-line-paragraph-remove-duplicate-lines-region-or-buffer) +;;; test-custom-line-paragraph-remove-duplicate-lines-region-or-buffer.el ends here diff --git a/tests/test-custom-line-paragraph-remove-lines-containing.el b/tests/test-custom-line-paragraph-remove-lines-containing.el new file mode 100644 index 00000000..61fab89c --- /dev/null +++ b/tests/test-custom-line-paragraph-remove-lines-containing.el @@ -0,0 +1,456 @@ +;;; test-custom-line-paragraph-remove-lines-containing.el --- Tests for cj/remove-lines-containing -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/remove-lines-containing function from custom-line-paragraph.el +;; +;; This function removes all lines containing TEXT. +;; If region is active, operate only on the region, otherwise on entire buffer. +;; The operation is undoable and reports the count of removed lines. +;; +;; The function uses (regexp-quote text) to treat special regex characters literally. +;; +;; IMPORTANT NOTE ON REGION ACTIVATION IN BATCH MODE: +;; When testing functions that use (use-region-p) in batch mode, you must +;; explicitly activate the region. Unlike interactive Emacs, batch mode does +;; not automatically activate regions when you set mark and point. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub expand-region package +(provide 'expand-region) + +;; Now load the actual production module +(require 'custom-line-paragraph) + +;;; Setup and Teardown + +(defun test-remove-lines-containing-setup () + "Setup for remove-lines-containing tests." + (cj/create-test-base-dir)) + +(defun test-remove-lines-containing-teardown () + "Teardown for remove-lines-containing tests." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-remove-lines-containing-single-match () + "Should remove single line containing text." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (cj/remove-lines-containing "two") + (should-not (string-match-p "two" (buffer-string))) + (should (string-match-p "one" (buffer-string))) + (should (string-match-p "three" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-multiple-matches () + "Should remove multiple lines containing text." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "alpha test\nbeta\ngamma test\ndelta") + (cj/remove-lines-containing "test") + (should-not (string-match-p "alpha" (buffer-string))) + (should-not (string-match-p "gamma" (buffer-string))) + (should (string-match-p "beta" (buffer-string))) + (should (string-match-p "delta" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-preserve-non-matching () + "Should preserve lines not containing text." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "keep this\nremove BAD this\nkeep that\nremove BAD that") + (cj/remove-lines-containing "BAD") + (should (string= "keep this\nkeep that\n" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-region-only () + "Should only affect active region." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "before target\ntarget middle\ntarget end\nafter") + (goto-char (point-min)) + (forward-line 1) + (set-mark (point)) + (forward-line 2) + (transient-mark-mode 1) + (activate-mark) + (cj/remove-lines-containing "target") + ;; Should keep "before target" and "after" + (should (string-match-p "before target" (buffer-string))) + (should (string-match-p "after" (buffer-string))) + ;; Should remove middle and end + (should-not (string-match-p "target middle" (buffer-string))) + (should-not (string-match-p "target end" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-whole-buffer () + "Should operate on entire buffer when no region active." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "one X\ntwo\nthree X\nfour") + (cj/remove-lines-containing "X") + (should (string= "two\nfour" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-partial-match () + "Should match text appearing anywhere in line." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "prefix MATCH suffix\nno match here\nMATCH at start\nat end MATCH") + (cj/remove-lines-containing "MATCH") + (should (string= "no match here\n" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-multiple-occurrences-per-line () + "Should remove line with text appearing multiple times." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "FOO and FOO and FOO\nbar\nFOO again") + (cj/remove-lines-containing "FOO") + (should (string= "bar\n" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-no-matches () + "Should leave buffer unchanged when text not found." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (let ((original (buffer-string))) + (cj/remove-lines-containing "NOTFOUND") + (should (string= original (buffer-string))))) + (test-remove-lines-containing-teardown))) + +;;; Boundary Cases + +(ert-deftest test-remove-lines-containing-empty-buffer () + "Should handle empty buffer gracefully." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (cj/remove-lines-containing "anything") + (should (string= "" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-single-line-with-match () + "Should remove only line when it matches." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "only line with TARGET") + (cj/remove-lines-containing "TARGET") + (should (string= "" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-single-line-without-match () + "Should keep only line when it doesn't match." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "only line") + (cj/remove-lines-containing "NOTHERE") + (should (string= "only line" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-text-at-beginning () + "Should match text at beginning of line." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "TARGET at start\nmiddle TARGET middle\nkeep this") + (cj/remove-lines-containing "TARGET") + (should (string= "keep this" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-text-at-end () + "Should match text at end of line." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "at end TARGET\nkeep this\nanother TARGET") + (cj/remove-lines-containing "TARGET") + (should (string= "keep this\n" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-text-in-middle () + "Should match text in middle of line." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "prefix TARGET suffix\nkeep\nanother TARGET here") + (cj/remove-lines-containing "TARGET") + (should (string= "keep\n" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-empty-string () + "Should handle empty string gracefully without hanging." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nline two\nline three") + (let ((original (buffer-string))) + ;; Should not hang or remove anything + (cj/remove-lines-containing "") + ;; Buffer should be unchanged + (should (string= original (buffer-string))))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-whitespace-only-text () + "Should remove lines with specific whitespace." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "has double space\nsingle space\nhas double space again") + (cj/remove-lines-containing " ") + (should (string= "single space\n" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-very-long-line () + "Should handle very long lines (5000+ chars)." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (let ((long-line (concat (make-string 2500 ?x) "TARGET" (make-string 2500 ?y)))) + (insert long-line "\nshort line\n" long-line) + (cj/remove-lines-containing "TARGET") + (should (string= "short line\n" (buffer-string))))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-unicode-emoji () + "Should handle Unicode and emoji text." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "hello 👋 world\nno emoji\nbye 👋 friend") + (cj/remove-lines-containing "👋") + (should (string= "no emoji\n" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-special-regex-chars () + "Should treat regex special characters literally (regexp-quote)." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "line with .\nanother line\nline with * here\nkeep") + (cj/remove-lines-containing ".") + ;; Should remove only the line with literal ".", not all lines (which . would match) + (should-not (string-match-p "line with \\." (buffer-string))) + (should (string-match-p "another line" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-case-sensitive () + "Should perform case-sensitive matching." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (let ((case-fold-search nil)) ; Ensure case-sensitive + (insert "Line with Target\nLine with target\nLine with TARGET") + (cj/remove-lines-containing "target") + ;; Only lowercase "target" should match + (should (string-match-p "Target" (buffer-string))) + (should (string-match-p "TARGET" (buffer-string))))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-all-lines-match () + "Should remove all lines when every line contains text." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "X one\nX two\nX three") + (cj/remove-lines-containing "X") + (should (string= "" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-first-line-matches () + "Should handle match at buffer start." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "REMOVE first\nkeep second\nkeep third") + (cj/remove-lines-containing "REMOVE") + (should (string= "keep second\nkeep third" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-last-line-matches () + "Should handle match at buffer end." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "keep first\nkeep second\nREMOVE last") + (cj/remove-lines-containing "REMOVE") + (should (string= "keep first\nkeep second\n" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-alternating-matches () + "Should handle alternating matching lines." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "keep\nREMOVE\nkeep\nREMOVE\nkeep") + (cj/remove-lines-containing "REMOVE") + (should (string= "keep\nkeep\nkeep" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-narrowed-buffer () + "Should respect buffer narrowing (save-restriction)." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "before TARGET\nmiddle TARGET\nend TARGET\nafter") + (goto-char (point-min)) + (forward-line 1) + (let ((beg (point))) + (forward-line 2) + (narrow-to-region beg (point)) + (cj/remove-lines-containing "TARGET") + (widen) + ;; Should keep "before TARGET" and "after" + (should (string-match-p "before TARGET" (buffer-string))) + (should (string-match-p "after" (buffer-string))) + ;; Should remove middle and end + (should-not (string-match-p "middle TARGET" (buffer-string))) + (should-not (string-match-p "end TARGET" (buffer-string))))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-backwards-region () + "Should handle backwards region (mark after point)." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "keep\nREMOVE\nREMOVE\nkeep") + (goto-char (point-max)) + (set-mark (point)) + (goto-char (point-min)) + (forward-line 1) + (transient-mark-mode 1) + (activate-mark) + (cj/remove-lines-containing "REMOVE") + ;; Should work same as forward region + (should (= 2 (how-many "keep" (point-min) (point-max))))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-entire-buffer-as-region () + "Should handle entire buffer selected as region." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "keep\nREMOVE\nkeep\nREMOVE") + (transient-mark-mode 1) + (mark-whole-buffer) + (activate-mark) + (cj/remove-lines-containing "REMOVE") + (should (string= "keep\nkeep\n" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-tab-characters () + "Should match lines with tab characters." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "line\twith\ttab\nno tabs here\nanother\ttab") + (cj/remove-lines-containing "\t") + (should (string= "no tabs here\n" (buffer-string)))) + (test-remove-lines-containing-teardown))) + +;;; Error Cases + +(ert-deftest test-remove-lines-containing-read-only-buffer () + "Should error when attempting to modify read-only buffer." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "line to remove\nline to keep") + (read-only-mode 1) + (should-error (cj/remove-lines-containing "remove"))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-buffer-modified-flag () + "Should set buffer modified flag when lines removed." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "REMOVE this\nkeep this") + (set-buffer-modified-p nil) + (cj/remove-lines-containing "REMOVE") + (should (buffer-modified-p))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-undo-behavior () + "Should support undo after removing lines." + (test-remove-lines-containing-setup) + (unwind-protect + (let* ((temp-file (expand-file-name "test-undo-rmlines.txt" cj/test-base-dir)) + (original-content "REMOVE this\nkeep this")) + ;; Create file with initial content + (with-temp-file temp-file + (insert original-content)) + ;; Open file and test undo + (find-file temp-file) + (buffer-enable-undo) + ;; Establish undo history + (goto-char (point-min)) + (insert " ") + (delete-char -1) + (undo-boundary) + (let ((before-remove (buffer-string))) + (cj/remove-lines-containing "REMOVE") + (undo-boundary) + (let ((after-remove (buffer-string))) + (should-not (string= before-remove after-remove)) + (undo) + (should (string= before-remove (buffer-string))))) + (kill-buffer (current-buffer))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-cursor-position-preserved () + "Should preserve cursor position (save-excursion)." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nREMOVE\nline three") + (goto-char (point-min)) + (forward-char 5) ; Position in middle of first line + (let ((original-pos (point))) + (cj/remove-lines-containing "REMOVE") + (should (= (point) original-pos)))) + (test-remove-lines-containing-teardown))) + +(ert-deftest test-remove-lines-containing-widen-after-narrowing () + "Should restore narrowing state (save-restriction)." + (test-remove-lines-containing-setup) + (unwind-protect + (with-temp-buffer + (insert "line one\nREMOVE\nline three\nline four") + (goto-char (point-min)) + (forward-line 1) + (let ((beg (point))) + (forward-line 2) + (narrow-to-region beg (point)) + (cj/remove-lines-containing "REMOVE") + ;; After function, narrowing should be restored + (should (= (point-min) beg)) + (should (< (point-max) (buffer-size))))) + (test-remove-lines-containing-teardown))) + +(provide 'test-custom-line-paragraph-remove-lines-containing) +;;; test-custom-line-paragraph-remove-lines-containing.el ends here diff --git a/tests/test-custom-line-paragraph-underscore-line.el b/tests/test-custom-line-paragraph-underscore-line.el new file mode 100644 index 00000000..b3c092e0 --- /dev/null +++ b/tests/test-custom-line-paragraph-underscore-line.el @@ -0,0 +1,397 @@ +;;; test-custom-line-paragraph-underscore-line.el --- Tests for cj/underscore-line -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/underscore-line function from custom-line-paragraph.el +;; +;; This function underlines the current line by inserting a row of characters below it. +;; If the line is empty or contains only whitespace, it aborts with a message. +;; +;; The function uses (read-char) to get the underline character from the user. +;; In tests, we mock this using cl-letf. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub expand-region package +(provide 'expand-region) + +;; Now load the actual production module +(require 'custom-line-paragraph) + +;;; Setup and Teardown + +(defun test-underscore-line-setup () + "Setup for underscore-line tests." + (cj/create-test-base-dir)) + +(defun test-underscore-line-teardown () + "Teardown for underscore-line tests." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-underscore-line-simple-text () + "Should underline simple text line." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello World") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + (should (string-match-p "Hello World\n-----------" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-preserve-original () + "Should preserve original line text." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Original Text") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?=))) + (cj/underscore-line) + (goto-char (point-min)) + (should (looking-at "Original Text")))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-use-specified-character () + "Should use the character provided by user." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Test") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?*))) + (cj/underscore-line) + (should (string-match-p "\\*\\*\\*\\*" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-match-width () + "Should create underline matching line width." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "12345") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + ;; Should have exactly 5 dashes + (should (string-match-p "12345\n-----$" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-insert-newline () + "Should insert newline before underline." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Line") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + (should (= 2 (count-lines (point-min) (point-max)))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-cursor-preserved () + "Should preserve cursor position." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Some text here") + (goto-char (point-min)) + (forward-char 5) ; Position in middle + (let ((original-pos (point))) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + (should (= (point) original-pos))))) + (test-underscore-line-teardown))) + +;;; Boundary Cases + +(ert-deftest test-underscore-line-empty-line-aborts () + "Should abort on empty line." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "") + (cj/underscore-line) + ;; Buffer should remain empty + (should (string= "" (buffer-string)))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-whitespace-only-aborts () + "Should abort on whitespace-only line." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert " \t ") + (goto-char (point-min)) + (let ((original (buffer-string))) + (cj/underscore-line) + ;; Buffer should be unchanged + (should (string= original (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-single-character () + "Should underline single character line." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "X") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + (should (string= "X\n-" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-very-long-line () + "Should handle very long lines (5000+ chars)." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (let ((long-line (make-string 5000 ?x))) + (insert long-line) + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + ;; Should have 5000 dashes + (should (= 5000 (how-many "-" (point-min) (point-max))))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-with-tabs () + "Should account for tab expansion in column width." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "a\tb") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + ;; Tab expands to column, underline should match visual width + (let ((underline-length (save-excursion + (goto-char (point-min)) + (forward-line 1) + (- (line-end-position) (line-beginning-position))))) + (should (> underline-length 2))))) ; More than just "a" and "b" + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-leading-whitespace () + "Should include leading whitespace in width calculation." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert " text") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + ;; Should have 6 dashes (2 spaces + 4 chars) + (should (string= " text\n------" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-trailing-whitespace () + "Should include trailing whitespace in width calculation." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "text ") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + ;; Should have 6 dashes (4 chars + 2 spaces) + (should (string= "text \n------" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-unicode-emoji () + "Should handle Unicode and emoji characters." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello 👋") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + ;; Should create underline + (should (string-match-p "Hello 👋\n-" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-rtl-text () + "Should handle RTL text." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "مرحبا") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + (should (string-match-p "مرحبا\n-" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-combining-characters () + "Should handle Unicode combining characters." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "cafe\u0301") ; e with combining acute + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + (should (string-match-p "cafe\u0301\n-" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-at-buffer-start () + "Should work on first line in buffer." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "First line\nSecond line") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?=))) + (cj/underscore-line) + (should (string-match-p "First line\n==========" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-at-buffer-end () + "Should work on last line in buffer." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "First line\nLast line") + (goto-char (point-max)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?=))) + (cj/underscore-line) + (should (string-match-p "Last line\n=========$" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-different-characters () + "Should work with various underline characters." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Test") + (goto-char (point-min)) + (dolist (char '(?- ?= ?* ?# ?~ ?_)) + (goto-char (point-min)) + (delete-region (point-min) (point-max)) + (insert "Test") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) char))) + (cj/underscore-line) + (should (string-match-p (regexp-quote (make-string 4 char)) (buffer-string)))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-special-characters () + "Should work with special non-alphanumeric characters." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Text") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?@))) + (cj/underscore-line) + (should (string-match-p "@@@@" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-cursor-in-middle () + "Should work regardless of cursor position on line." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello World") + (goto-char (point-min)) + (forward-char 6) ; Position after "Hello " + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + (should (string-match-p "Hello World\n-----------" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-cursor-at-start () + "Should work when cursor at line beginning." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Text") + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + (should (string-match-p "Text\n----" (buffer-string))))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-cursor-at-end () + "Should work when cursor at line end." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Text") + (goto-char (point-max)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + (should (string-match-p "Text\n----" (buffer-string))))) + (test-underscore-line-teardown))) + +;;; Error Cases + +(ert-deftest test-underscore-line-read-only-buffer () + "Should error when attempting to modify read-only buffer." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Read only text") + (goto-char (point-min)) + (read-only-mode 1) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (should-error (cj/underscore-line)))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-buffer-modified-flag () + "Should set buffer modified flag." + (test-underscore-line-setup) + (unwind-protect + (with-temp-buffer + (insert "Text") + (set-buffer-modified-p nil) + (goto-char (point-min)) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line) + (should (buffer-modified-p)))) + (test-underscore-line-teardown))) + +(ert-deftest test-underscore-line-undo-behavior () + "Should support undo after underlining." + (test-underscore-line-setup) + (unwind-protect + (let* ((temp-file (expand-file-name "test-undo-underline.txt" cj/test-base-dir)) + (original-content "Test line")) + ;; Create file with initial content + (with-temp-file temp-file + (insert original-content)) + ;; Open file and test undo + (find-file temp-file) + (buffer-enable-undo) + ;; Establish undo history + (goto-char (point-min)) + (insert " ") + (delete-char -1) + (undo-boundary) + (goto-char (point-min)) + (let ((before-underline (buffer-string))) + (cl-letf (((symbol-function 'read-char) (lambda (&rest _) ?-))) + (cj/underscore-line)) + (undo-boundary) + (let ((after-underline (buffer-string))) + (should-not (string= before-underline after-underline)) + (undo) + (should (string= before-underline (buffer-string))))) + (kill-buffer (current-buffer))) + (test-underscore-line-teardown))) + +(provide 'test-custom-line-paragraph-underscore-line) +;;; test-custom-line-paragraph-underscore-line.el ends here diff --git a/tests/test-custom-misc-cj--count-characters.el b/tests/test-custom-misc-cj--count-characters.el new file mode 100644 index 00000000..1834b5c4 --- /dev/null +++ b/tests/test-custom-misc-cj--count-characters.el @@ -0,0 +1,171 @@ +;;; test-custom-misc-cj--count-characters.el --- Tests for cj/--count-characters -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--count-characters internal implementation function from custom-misc.el +;; +;; This internal function counts characters between START and END positions. +;; It validates that START is not greater than END and returns the character count. + +;;; Code: + +(require 'ert) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-misc) + +;;; Setup and Teardown + +(defun test-count-characters-setup () + "Set up test environment." + ;; No setup needed for this function + nil) + +(defun test-count-characters-teardown () + "Clean up test environment." + ;; No teardown needed for this function + nil) + +;;; Normal Cases + +(ert-deftest test-custom-misc-cj--count-characters-normal-simple-text-returns-count () + "Should count characters in simple text region." + (test-count-characters-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello, world!") + (let ((result (cj/--count-characters 1 14))) + (should (= result 13)))) + (test-count-characters-teardown))) + +(ert-deftest test-custom-misc-cj--count-characters-normal-partial-region-returns-count () + "Should count characters in partial region." + (test-count-characters-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello, world!") + (let ((result (cj/--count-characters 1 6))) + (should (= result 5)))) + (test-count-characters-teardown))) + +(ert-deftest test-custom-misc-cj--count-characters-normal-multiline-returns-count () + "Should count characters including newlines." + (test-count-characters-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + ;; 6 + 1 + 6 + 1 + 6 = 20 characters + (let ((result (cj/--count-characters (point-min) (point-max)))) + (should (= result 20)))) + (test-count-characters-teardown))) + +;;; Boundary Cases + +(ert-deftest test-custom-misc-cj--count-characters-boundary-empty-region-returns-zero () + "Should return 0 for empty region (start equals end)." + (test-count-characters-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello") + (let ((result (cj/--count-characters 3 3))) + (should (= result 0)))) + (test-count-characters-teardown))) + +(ert-deftest test-custom-misc-cj--count-characters-boundary-single-character-returns-one () + "Should return 1 for single character region." + (test-count-characters-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello") + (let ((result (cj/--count-characters 1 2))) + (should (= result 1)))) + (test-count-characters-teardown))) + +(ert-deftest test-custom-misc-cj--count-characters-boundary-large-region-returns-count () + "Should handle very large region." + (test-count-characters-setup) + (unwind-protect + (with-temp-buffer + (let ((large-content (make-string 100000 ?x))) + (insert large-content) + (let ((result (cj/--count-characters (point-min) (point-max)))) + (should (= result 100000))))) + (test-count-characters-teardown))) + +(ert-deftest test-custom-misc-cj--count-characters-boundary-unicode-returns-count () + "Should count unicode characters (emoji, RTL text, combining characters)." + (test-count-characters-setup) + (unwind-protect + (with-temp-buffer + ;; "Hello 👋 مرحبا" contains emoji and Arabic text + (insert "Hello 👋 مرحبا") + (let ((result (cj/--count-characters (point-min) (point-max)))) + ;; Count the actual characters in the buffer + (should (= result (- (point-max) (point-min)))))) + (test-count-characters-teardown))) + +(ert-deftest test-custom-misc-cj--count-characters-boundary-whitespace-only-returns-count () + "Should count whitespace characters." + (test-count-characters-setup) + (unwind-protect + (with-temp-buffer + (insert " \t\n ") + ;; 3 spaces + 1 tab + 1 newline + 2 spaces = 7 characters + (let ((result (cj/--count-characters (point-min) (point-max)))) + (should (= result 7)))) + (test-count-characters-teardown))) + +(ert-deftest test-custom-misc-cj--count-characters-boundary-newlines-at-boundaries-returns-count () + "Should count newlines at start and end." + (test-count-characters-setup) + (unwind-protect + (with-temp-buffer + (insert "\n\nHello\n\n") + ;; 2 newlines + 5 chars + 2 newlines = 9 characters + (let ((result (cj/--count-characters (point-min) (point-max)))) + (should (= result 9)))) + (test-count-characters-teardown))) + +(ert-deftest test-custom-misc-cj--count-characters-boundary-binary-content-returns-count () + "Should handle binary content." + (test-count-characters-setup) + (unwind-protect + (with-temp-buffer + (insert (string 0 1 2 255)) + (let ((result (cj/--count-characters (point-min) (point-max)))) + (should (= result 4)))) + (test-count-characters-teardown))) + +;;; Error Cases + +(ert-deftest test-custom-misc-cj--count-characters-error-start-greater-than-end-signals-error () + "Should signal error when start is greater than end." + (test-count-characters-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello, world!") + (should-error (cj/--count-characters 10 5) + :type 'error)) + (test-count-characters-teardown))) + +(ert-deftest test-custom-misc-cj--count-characters-error-positions-out-of-bounds-handled () + "Should handle positions beyond buffer bounds (Emacs handles this)." + (test-count-characters-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello") + ;; Emacs will error if positions are truly out of bounds, + ;; but this tests that our function doesn't add additional errors + ;; Buffer has 6 positions (1-6), testing valid bounds + (let ((result (cj/--count-characters 1 6))) + (should (= result 5)))) + (test-count-characters-teardown))) + +(provide 'test-custom-misc-cj--count-characters) +;;; test-custom-misc-cj--count-characters.el ends here diff --git a/tests/test-custom-misc-cj-count-characters-buffer-or-region.el b/tests/test-custom-misc-cj-count-characters-buffer-or-region.el new file mode 100644 index 00000000..dbbda00d --- /dev/null +++ b/tests/test-custom-misc-cj-count-characters-buffer-or-region.el @@ -0,0 +1,231 @@ +;;; test-custom-misc-cj-count-characters-buffer-or-region.el --- Tests for cj/count-characters-buffer-or-region -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/count-characters-buffer-or-region function from custom-misc.el +;; +;; This function counts characters in the active region or the entire buffer +;; if no region is active. It displays the count in the minibuffer. + +;;; Code: + +(require 'ert) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-misc) + +;;; Setup and Teardown + +(defun test-count-characters-buffer-or-region-setup () + "Set up test environment." + ;; No setup needed + nil) + +(defun test-count-characters-buffer-or-region-teardown () + "Clean up test environment." + ;; Clear any active region + (when (use-region-p) + (deactivate-mark))) + +;;; Normal Cases + +(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-normal-whole-buffer-counts-all () + "Should count all characters in buffer when no region is active." + (test-count-characters-buffer-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello, world!") + ;; Ensure no region is active + (deactivate-mark) + (let ((message-output nil)) + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq message-output (apply #'format format-string args))))) + (cj/count-characters-buffer-or-region) + (should (string-match-p "13 characters.*buffer" message-output))))) + (test-count-characters-buffer-or-region-teardown))) + +(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-normal-active-region-counts-region () + "Should count characters in active region." + (test-count-characters-buffer-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello, world!") + ;; Select "Hello" (positions 1-6) + (goto-char 1) + (push-mark 1) + (goto-char 6) + (activate-mark) + (let ((message-output nil)) + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq message-output (apply #'format format-string args))))) + (cj/count-characters-buffer-or-region) + (should (string-match-p "5 characters.*region" message-output))))) + (test-count-characters-buffer-or-region-teardown))) + +(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-normal-multiline-buffer-counts-all () + "Should count characters including newlines in buffer." + (test-count-characters-buffer-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + (deactivate-mark) + (let ((message-output nil)) + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq message-output (apply #'format format-string args))))) + (cj/count-characters-buffer-or-region) + ;; 6 + 1 + 6 + 1 + 6 = 20 characters + (should (string-match-p "20 characters.*buffer" message-output))))) + (test-count-characters-buffer-or-region-teardown))) + +(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-normal-multiline-region-counts-region () + "Should count characters including newlines in region." + (test-count-characters-buffer-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3") + ;; Select first two lines including newlines + (goto-char 1) + (push-mark 1) + (goto-char 14) ; After "Line 1\nLine 2" + (activate-mark) + (let ((message-output nil)) + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq message-output (apply #'format format-string args))))) + (cj/count-characters-buffer-or-region) + ;; "Line 1\nLine 2" = 6 + 1 + 6 = 13 characters + (should (string-match-p "13 characters.*region" message-output))))) + (test-count-characters-buffer-or-region-teardown))) + +;;; Boundary Cases + +(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-empty-buffer-returns-zero () + "Should return 0 for empty buffer." + (test-count-characters-buffer-or-region-setup) + (unwind-protect + (with-temp-buffer + (deactivate-mark) + (let ((message-output nil)) + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq message-output (apply #'format format-string args))))) + (cj/count-characters-buffer-or-region) + (should (string-match-p "0 characters.*buffer" message-output))))) + (test-count-characters-buffer-or-region-teardown))) + +(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-empty-region-counts-buffer () + "Should count whole buffer when region is empty (point equals mark). +When mark and point are at the same position, use-region-p returns nil, +so the function correctly falls back to counting the entire buffer." + (test-count-characters-buffer-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello, world!") + ;; Create empty region (point equals mark) + ;; Even with activate-mark, use-region-p returns nil when mark == point + (goto-char 5) + (push-mark 5) + (activate-mark) + (let ((message-output nil)) + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq message-output (apply #'format format-string args))))) + (cj/count-characters-buffer-or-region) + ;; Should count the whole buffer (13 characters) not the empty region + (should (string-match-p "13 characters.*buffer" message-output))))) + (test-count-characters-buffer-or-region-teardown))) + +(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-large-buffer-counts-all () + "Should handle very large buffer." + (test-count-characters-buffer-or-region-setup) + (unwind-protect + (with-temp-buffer + (let ((large-content (make-string 100000 ?x))) + (insert large-content) + (deactivate-mark) + (let ((message-output nil)) + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq message-output (apply #'format format-string args))))) + (cj/count-characters-buffer-or-region) + (should (string-match-p "100000 characters.*buffer" message-output)))))) + (test-count-characters-buffer-or-region-teardown))) + +(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-unicode-counts-correctly () + "Should count unicode characters (emoji, RTL text) correctly." + (test-count-characters-buffer-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "Hello 👋 مرحبا") + (deactivate-mark) + (let ((message-output nil) + (expected-count (- (point-max) (point-min)))) + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq message-output (apply #'format format-string args))))) + (cj/count-characters-buffer-or-region) + (should (string-match-p (format "%d characters.*buffer" expected-count) + message-output))))) + (test-count-characters-buffer-or-region-teardown))) + +(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-whitespace-only-counts-whitespace () + "Should count whitespace characters." + (test-count-characters-buffer-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert " \t\n ") + (deactivate-mark) + (let ((message-output nil)) + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq message-output (apply #'format format-string args))))) + (cj/count-characters-buffer-or-region) + ;; 3 spaces + 1 tab + 1 newline + 2 spaces = 7 characters + (should (string-match-p "7 characters.*buffer" message-output))))) + (test-count-characters-buffer-or-region-teardown))) + +(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-single-character-returns-one () + "Should return 1 for single character buffer." + (test-count-characters-buffer-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "x") + (deactivate-mark) + (let ((message-output nil)) + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq message-output (apply #'format format-string args))))) + (cj/count-characters-buffer-or-region) + (should (string-match-p "1 character.*buffer" message-output))))) + (test-count-characters-buffer-or-region-teardown))) + +(ert-deftest test-custom-misc-cj-count-characters-buffer-or-region-boundary-narrowed-buffer-counts-visible () + "Should count only visible characters in narrowed buffer." + (test-count-characters-buffer-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "Line 1\nLine 2\nLine 3\n") + (goto-char (point-min)) + (forward-line 1) + (narrow-to-region (point) (progn (forward-line 1) (point))) + (deactivate-mark) + (let ((message-output nil)) + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq message-output (apply #'format format-string args))))) + (cj/count-characters-buffer-or-region) + ;; "Line 2\n" = 7 characters + (should (string-match-p "7 characters.*buffer" message-output))))) + (test-count-characters-buffer-or-region-teardown))) + +(provide 'test-custom-misc-cj-count-characters-buffer-or-region) +;;; test-custom-misc-cj-count-characters-buffer-or-region.el ends here diff --git a/tests/test-custom-misc-count-words.el b/tests/test-custom-misc-count-words.el new file mode 100644 index 00000000..f2bf793f --- /dev/null +++ b/tests/test-custom-misc-count-words.el @@ -0,0 +1,148 @@ +;;; test-custom-misc-count-words.el --- Tests for cj/--count-words -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--count-words function from custom-misc.el +;; +;; This function counts words in a region using Emacs's built-in count-words. +;; A word is defined by Emacs's word boundaries, which generally means +;; sequences of word-constituent characters separated by whitespace or punctuation. +;; +;; We test the NON-INTERACTIVE implementation (cj/--count-words) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-misc) + +;;; Test Helpers + +(defun test-count-words (input-text) + "Test cj/--count-words on INPUT-TEXT. +Returns the word count." + (with-temp-buffer + (insert input-text) + (cj/--count-words (point-min) (point-max)))) + +;;; Normal Cases + +(ert-deftest test-count-words-multiple-words () + "Should count multiple words." + (should (= 5 (test-count-words "The quick brown fox jumps")))) + +(ert-deftest test-count-words-single-word () + "Should count single word." + (should (= 1 (test-count-words "hello")))) + +(ert-deftest test-count-words-with-punctuation () + "Should count words with punctuation." + (should (= 5 (test-count-words "Hello, world! How are you?")))) + +(ert-deftest test-count-words-multiple-spaces () + "Should count words separated by multiple spaces." + (should (= 3 (test-count-words "hello world test")))) + +(ert-deftest test-count-words-with-newlines () + "Should count words across newlines." + (should (= 6 (test-count-words "line one\nline two\nline three")))) + +(ert-deftest test-count-words-with-tabs () + "Should count words separated by tabs." + (should (= 3 (test-count-words "hello\tworld\ttest")))) + +(ert-deftest test-count-words-mixed-whitespace () + "Should count words with mixed whitespace." + (should (= 4 (test-count-words "hello \t world\n\ntest end")))) + +(ert-deftest test-count-words-hyphenated () + "Should count hyphenated words." + ;; Emacs treats hyphens as word separators in count-words + (should (= 7 (test-count-words "This is state-of-the-art technology")))) + +(ert-deftest test-count-words-contractions () + "Should count contractions." + ;; Emacs treats apostrophes as word separators in count-words + (should (= 6 (test-count-words "don't can't won't")))) + +(ert-deftest test-count-words-numbers () + "Should count numbers as words." + (should (= 6 (test-count-words "The year 2024 has 365 days")))) + +;;; Boundary Cases + +(ert-deftest test-count-words-empty-string () + "Should return 0 for empty string." + (should (= 0 (test-count-words "")))) + +(ert-deftest test-count-words-only-whitespace () + "Should return 0 for whitespace-only text." + (should (= 0 (test-count-words " \t\n\n ")))) + +(ert-deftest test-count-words-only-punctuation () + "Should count punctuation-only text." + ;; Emacs may count consecutive punctuation as a word + (should (= 1 (test-count-words "!@#$%^&*()")))) + +(ert-deftest test-count-words-leading-trailing-spaces () + "Should count words ignoring leading/trailing spaces." + (should (= 3 (test-count-words " hello world test ")))) + +(ert-deftest test-count-words-unicode () + "Should count Unicode words." + (should (= 3 (test-count-words "café résumé naïve")))) + +(ert-deftest test-count-words-very-long-text () + "Should handle very long text." + (let ((long-text (mapconcat (lambda (_) "word") (make-list 1000 nil) " "))) + (should (= 1000 (test-count-words long-text))))) + +(ert-deftest test-count-words-multiline-paragraph () + "Should count words in multi-line paragraph." + (let ((text "This is a paragraph +that spans multiple +lines with various +words in it.")) + (should (= 13 (test-count-words text))))) + +;;; Error Cases + +(ert-deftest test-count-words-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "hello world") + (cj/--count-words (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-count-words-empty-region () + "Should return 0 for empty region (start == end)." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (= 0 (cj/--count-words pos pos)))))) + +(ert-deftest test-count-words-partial-region () + "Should count words only in specified region." + (with-temp-buffer + (insert "one two three four five") + ;; Count only "two three four" (positions roughly in middle) + (goto-char (point-min)) + (search-forward "two") + (let ((start (match-beginning 0))) + (search-forward "four") + (let ((end (match-end 0))) + (should (= 3 (cj/--count-words start end))))))) + +(provide 'test-custom-misc-count-words) +;;; test-custom-misc-count-words.el ends here diff --git a/tests/test-custom-misc-format-region.el b/tests/test-custom-misc-format-region.el new file mode 100644 index 00000000..c40a8898 --- /dev/null +++ b/tests/test-custom-misc-format-region.el @@ -0,0 +1,161 @@ +;;; test-custom-misc-format-region.el --- Tests for cj/--format-region -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--format-region function from custom-misc.el +;; +;; This function reformats text by applying three operations: +;; 1. untabify - converts tabs to spaces +;; 2. indent-region - reindents according to major mode +;; 3. delete-trailing-whitespace - removes trailing whitespace +;; +;; Note: indent-region behavior is major-mode dependent. We test in +;; emacs-lisp-mode and fundamental-mode for predictable results. +;; +;; We test the NON-INTERACTIVE implementation (cj/--format-region) +;; to avoid mocking region selection. This follows our testing best practice +;; of separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-misc) + +;;; Test Helpers + +(defun test-format-region (input-text &optional mode) + "Test cj/--format-region on INPUT-TEXT. +MODE is the major mode to use (defaults to fundamental-mode). +Returns the buffer string after operation." + (with-temp-buffer + (funcall (or mode #'fundamental-mode)) + (insert input-text) + (cj/--format-region (point-min) (point-max)) + (buffer-string))) + +;;; Normal Cases - Tab Conversion + +(ert-deftest test-format-region-converts-tabs () + "Should convert tabs to spaces." + (let ((result (test-format-region "hello\tworld"))) + (should-not (string-match-p "\t" result)) + (should (string-match-p " " result)))) + +(ert-deftest test-format-region-multiple-tabs () + "Should convert multiple tabs." + (let ((result (test-format-region "\t\thello\t\tworld\t\t"))) + (should-not (string-match-p "\t" result)))) + +;;; Normal Cases - Trailing Whitespace + +(ert-deftest test-format-region-removes-trailing-spaces () + "Should remove trailing spaces." + (let ((result (test-format-region "hello world "))) + (should (string= result "hello world")))) + +(ert-deftest test-format-region-removes-trailing-tabs () + "Should remove trailing tabs." + (let ((result (test-format-region "hello world\t\t"))) + (should (string= result "hello world")))) + +(ert-deftest test-format-region-removes-trailing-mixed () + "Should remove trailing mixed whitespace." + (let ((result (test-format-region "hello world \t \t "))) + (should (string= result "hello world")))) + +(ert-deftest test-format-region-multiline-trailing () + "Should remove trailing whitespace from multiple lines." + (let ((result (test-format-region "line1 \nline2\t\t\nline3 \t "))) + (should (string= result "line1\nline2\nline3")))) + +;;; Normal Cases - Combined Operations + +(ert-deftest test-format-region-tabs-and-trailing () + "Should handle both tabs and trailing whitespace." + (let ((result (test-format-region "\thello\tworld\t\t"))) + (should-not (string-match-p "\t" result)) + ;; Should not end with whitespace + (should-not (string-match-p "[ \t]+$" result)))) + +(ert-deftest test-format-region-preserves-interior-spaces () + "Should preserve interior spaces while fixing edges." + (let ((result (test-format-region "\thello world\t"))) + (should (string-match-p "hello world" result)) + (should-not (string-match-p "\t" result)))) + +;;; Normal Cases - Indentation (Mode-Specific) + +(ert-deftest test-format-region-elisp-indentation () + "Should reindent Elisp code." + (let* ((input "(defun foo ()\n(+ 1 2))") + (result (test-format-region input #'emacs-lisp-mode)) + (lines (split-string result "\n"))) + ;; The inner form should be indented - second line should start with 2 spaces + (should (= 2 (length lines))) + (should (string-prefix-p "(defun foo ()" (car lines))) + (should (string-prefix-p " " (cadr lines))))) + +;;; Boundary Cases + +(ert-deftest test-format-region-empty-string () + "Should handle empty string." + (let ((result (test-format-region ""))) + (should (string= result "")))) + +(ert-deftest test-format-region-no-issues () + "Should handle text with no formatting issues (no-op)." + (let ((result (test-format-region "hello world"))) + (should (string= result "hello world")))) + +(ert-deftest test-format-region-only-whitespace () + "Should handle text with only whitespace." + (let ((result (test-format-region "\t \t "))) + ;; Should become empty or just spaces, no tabs + (should-not (string-match-p "\t" result)))) + +(ert-deftest test-format-region-single-line () + "Should handle single line." + (let ((result (test-format-region "\thello\t"))) + (should-not (string-match-p "\t" result)))) + +(ert-deftest test-format-region-very-long-text () + "Should handle very long text." + (let* ((long-text (mapconcat (lambda (_) "\thello\t") (make-list 100 nil) "\n")) + (result (test-format-region long-text))) + (should-not (string-match-p "\t" result)))) + +(ert-deftest test-format-region-newlines-preserved () + "Should preserve newlines while fixing formatting." + (let ((result (test-format-region "line1\t \nline2\t \nline3\t "))) + (should (= 2 (cl-count ?\n result))))) + +;;; Error Cases + +(ert-deftest test-format-region-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "hello world") + (cj/--format-region (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-format-region-empty-region () + "Should handle empty region (start == end) without error." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (cj/--format-region pos pos) + ;; Should complete without error + (should (string= (buffer-string) "hello world"))))) + +(provide 'test-custom-misc-format-region) +;;; test-custom-misc-format-region.el ends here diff --git a/tests/test-custom-misc-jump-to-matching-paren.el b/tests/test-custom-misc-jump-to-matching-paren.el new file mode 100644 index 00000000..973b6dfa --- /dev/null +++ b/tests/test-custom-misc-jump-to-matching-paren.el @@ -0,0 +1,197 @@ +;;; test-custom-misc-jump-to-matching-paren.el --- Tests for cj/jump-to-matching-paren -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/jump-to-matching-paren function from custom-misc.el +;; +;; This function jumps to matching delimiters using Emacs's sexp navigation. +;; It works with any delimiter that has matching syntax according to the +;; current syntax table (parentheses, brackets, braces, etc.). +;; +;; Unlike other functions in this test suite, this is an INTERACTIVE function +;; that moves point and displays messages. We test it as an integration test +;; by setting up buffers, positioning point, calling the function, and +;; verifying where point ends up. +;; +;; Key behaviors: +;; - When on opening delimiter: jump forward to matching closing delimiter +;; - When on closing delimiter: jump backward to matching opening delimiter +;; - When just after closing delimiter: jump backward to matching opening +;; - When not on delimiter: display message, don't move +;; - When no matching delimiter: display error message, don't move + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-misc) + +;;; Test Helpers + +(defun test-jump-to-matching-paren (text point-position) + "Test cj/jump-to-matching-paren with TEXT and point at POINT-POSITION. +Returns the new point position after calling the function. +POINT-POSITION is 1-indexed (1 = first character)." + (with-temp-buffer + (emacs-lisp-mode) ; Use elisp mode for proper syntax table + (insert text) + (goto-char point-position) + (cj/jump-to-matching-paren) + (point))) + +;;; Normal Cases - Forward Jump (Opening to Closing) + +(ert-deftest test-jump-paren-forward-simple () + "Should jump forward from opening paren to closing paren." + ;; Text: "(hello)" + ;; Start at position 1 (on opening paren) + ;; Should end at position 8 (after closing paren) + (should (= 8 (test-jump-to-matching-paren "(hello)" 1)))) + +(ert-deftest test-jump-paren-forward-nested () + "Should jump forward over nested parens." + ;; Text: "(foo (bar))" + ;; Start at position 1 (on outer opening paren) + ;; Should end at position 12 (after outer closing paren) + (should (= 12 (test-jump-to-matching-paren "(foo (bar))" 1)))) + +(ert-deftest test-jump-paren-forward-inner-nested () + "Should jump forward from inner opening paren." + ;; Text: "(foo (bar))" + ;; Start at position 6 (on inner opening paren) + ;; Should end at position 11 (after inner closing paren) + (should (= 11 (test-jump-to-matching-paren "(foo (bar))" 6)))) + +(ert-deftest test-jump-bracket-forward () + "Should jump forward from opening bracket." + ;; Text: "[1 2 3]" + ;; Start at position 1 + ;; Should end at position 8 + (should (= 8 (test-jump-to-matching-paren "[1 2 3]" 1)))) + +;; Note: Braces are not treated as matching delimiters in emacs-lisp-mode +;; so we don't test them here + +;;; Normal Cases - Backward Jump (Closing to Opening) + +(ert-deftest test-jump-paren-backward-simple () + "Should jump backward from closing paren to opening paren." + ;; Text: "(hello)" + ;; Start at position 7 (on closing paren) + ;; Should end at position 2 (after opening paren) + (should (= 2 (test-jump-to-matching-paren "(hello)" 7)))) + +(ert-deftest test-jump-paren-backward-nested () + "Should jump backward over nested parens from after outer closing." + ;; Text: "(foo (bar))" + ;; Start at position 12 (after outer closing paren) + ;; backward-sexp goes back to before opening paren + (should (= 1 (test-jump-to-matching-paren "(foo (bar))" 12)))) + +(ert-deftest test-jump-paren-backward-inner-nested () + "Should jump backward from inner closing paren." + ;; Text: "(foo (bar))" + ;; Start at position 10 (on inner closing paren) + ;; Should end at position 7 (after inner opening paren) + (should (= 7 (test-jump-to-matching-paren "(foo (bar))" 10)))) + +(ert-deftest test-jump-bracket-backward () + "Should jump backward from after closing bracket." + ;; Text: "[1 2 3]" + ;; Start at position 8 (after ]) + ;; backward-sexp goes back one sexp + (should (= 1 (test-jump-to-matching-paren "[1 2 3]" 8)))) + +;;; Normal Cases - Jump from After Closing Delimiter + +(ert-deftest test-jump-paren-after-closing () + "Should jump backward when just after closing paren." + ;; Text: "(hello)" + ;; Start at position 8 (after closing paren) + ;; backward-sexp goes back one sexp, ending before the opening paren + (should (= 1 (test-jump-to-matching-paren "(hello)" 8)))) + +;;; Boundary Cases - No Movement + +(ert-deftest test-jump-paren-not-on-delimiter () + "Should not move when not on delimiter." + ;; Text: "(hello world)" + ;; Start at position 3 (on 'e' in hello) + ;; Should stay at position 3 + (should (= 3 (test-jump-to-matching-paren "(hello world)" 3)))) + +(ert-deftest test-jump-paren-on-whitespace () + "Should not move when on whitespace." + ;; Text: "(hello world)" + ;; Start at position 7 (on space) + ;; Should stay at position 7 + (should (= 7 (test-jump-to-matching-paren "(hello world)" 7)))) + +;;; Boundary Cases - Unmatched Delimiters + +(ert-deftest test-jump-paren-unmatched-opening () + "Should not move from unmatched opening paren." + ;; Text: "(hello" + ;; Start at position 1 (on opening paren with no closing) + ;; Should stay at position 1 + (should (= 1 (test-jump-to-matching-paren "(hello" 1)))) + +(ert-deftest test-jump-paren-unmatched-closing () + "Should move to beginning from unmatched closing paren." + ;; Text: "hello)" + ;; Start at position 6 (on closing paren with no opening) + ;; backward-sexp with unmatched closing paren goes to beginning + (should (= 1 (test-jump-to-matching-paren "hello)" 6)))) + +;;; Boundary Cases - Empty Delimiters + +(ert-deftest test-jump-paren-empty () + "Should jump over empty parens." + ;; Text: "()" + ;; Start at position 1 + ;; Should end at position 3 + (should (= 3 (test-jump-to-matching-paren "()" 1)))) + +(ert-deftest test-jump-paren-empty-backward () + "Should stay put when on closing paren of empty parens." + ;; Text: "()" + ;; Start at position 2 (on closing paren) + ;; backward-sexp from closing of empty parens gives an error, so stays at 2 + (should (= 2 (test-jump-to-matching-paren "()" 2)))) + +;;; Boundary Cases - Multiple Delimiter Types + +(ert-deftest test-jump-paren-mixed-delimiters () + "Should jump over mixed delimiter types." + ;; Text: "(foo [bar {baz}])" + ;; Start at position 1 (on opening paren) + ;; Should end at position 18 (after closing paren) + (should (= 18 (test-jump-to-matching-paren "(foo [bar {baz}])" 1)))) + +(ert-deftest test-jump-bracket-in-parens () + "Should jump from bracket inside parens." + ;; Text: "(foo [bar])" + ;; Start at position 6 (on opening bracket) + ;; Should end at position 11 (after closing bracket) + (should (= 11 (test-jump-to-matching-paren "(foo [bar])" 6)))) + +;;; Complex Cases - Strings and Comments + +(ert-deftest test-jump-paren-over-string () + "Should jump over parens containing strings." + ;; Text: "(\"hello (world)\")" + ;; Start at position 1 (on opening paren) + ;; Should end at position 18 (after closing paren) + ;; The parens in the string should be ignored + (should (= 18 (test-jump-to-matching-paren "(\"hello (world)\")" 1)))) + +(provide 'test-custom-misc-jump-to-matching-paren) +;;; test-custom-misc-jump-to-matching-paren.el ends here diff --git a/tests/test-custom-misc-replace-fraction-glyphs.el b/tests/test-custom-misc-replace-fraction-glyphs.el new file mode 100644 index 00000000..81d1546e --- /dev/null +++ b/tests/test-custom-misc-replace-fraction-glyphs.el @@ -0,0 +1,185 @@ +;;; test-custom-misc-replace-fraction-glyphs.el --- Tests for cj/--replace-fraction-glyphs -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--replace-fraction-glyphs function from custom-misc.el +;; +;; This function bidirectionally converts between text fractions (1/4) and +;; Unicode fraction glyphs (¼). It supports 5 common fractions: +;; - 1/4 ↔ ¼ +;; - 1/2 ↔ ½ +;; - 3/4 ↔ ¾ +;; - 1/3 ↔ ⅓ +;; - 2/3 ↔ ⅔ +;; +;; We test the NON-INTERACTIVE implementation (cj/--replace-fraction-glyphs) +;; to avoid mocking prefix arguments. This follows our testing best practice +;; of separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-misc) + +;;; Test Helpers + +(defun test-replace-fraction-glyphs (input-text to-glyphs) + "Test cj/--replace-fraction-glyphs on INPUT-TEXT. +TO-GLYPHS determines conversion direction. +Returns the buffer string after operation." + (with-temp-buffer + (insert input-text) + (cj/--replace-fraction-glyphs (point-min) (point-max) to-glyphs) + (buffer-string))) + +;;; Normal Cases - Text to Glyphs + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-quarter () + "Should convert 1/4 to ¼." + (let ((result (test-replace-fraction-glyphs "1/4" t))) + (should (string= result "¼")))) + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-half () + "Should convert 1/2 to ½." + (let ((result (test-replace-fraction-glyphs "1/2" t))) + (should (string= result "½")))) + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-three-quarters () + "Should convert 3/4 to ¾." + (let ((result (test-replace-fraction-glyphs "3/4" t))) + (should (string= result "¾")))) + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-third () + "Should convert 1/3 to ⅓." + (let ((result (test-replace-fraction-glyphs "1/3" t))) + (should (string= result "⅓")))) + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-two-thirds () + "Should convert 2/3 to ⅔." + (let ((result (test-replace-fraction-glyphs "2/3" t))) + (should (string= result "⅔")))) + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-multiple () + "Should convert multiple fractions in text." + (let ((result (test-replace-fraction-glyphs "Use 1/4 cup and 1/2 teaspoon" t))) + (should (string= result "Use ¼ cup and ½ teaspoon")))) + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-all-types () + "Should convert all fraction types." + (let ((result (test-replace-fraction-glyphs "1/4 1/2 3/4 1/3 2/3" t))) + (should (string= result "¼ ½ ¾ ⅓ ⅔")))) + +;;; Normal Cases - Glyphs to Text + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-quarter () + "Should convert ¼ to 1/4." + (let ((result (test-replace-fraction-glyphs "¼" nil))) + (should (string= result "1/4")))) + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-half () + "Should convert ½ to 1/2." + (let ((result (test-replace-fraction-glyphs "½" nil))) + (should (string= result "1/2")))) + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-three-quarters () + "Should convert ¾ to 3/4." + (let ((result (test-replace-fraction-glyphs "¾" nil))) + (should (string= result "3/4")))) + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-third () + "Should convert ⅓ to 1/3." + (let ((result (test-replace-fraction-glyphs "⅓" nil))) + (should (string= result "1/3")))) + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-two-thirds () + "Should convert ⅔ to 2/3." + (let ((result (test-replace-fraction-glyphs "⅔" nil))) + (should (string= result "2/3")))) + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-multiple () + "Should convert multiple glyphs in text." + (let ((result (test-replace-fraction-glyphs "Use ¼ cup and ½ teaspoon" nil))) + (should (string= result "Use 1/4 cup and 1/2 teaspoon")))) + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-all-types () + "Should convert all glyph types." + (let ((result (test-replace-fraction-glyphs "¼ ½ ¾ ⅓ ⅔" nil))) + (should (string= result "1/4 1/2 3/4 1/3 2/3")))) + +;;; Boundary Cases + +(ert-deftest test-replace-fraction-glyphs-empty-string () + "Should handle empty string." + (let ((result (test-replace-fraction-glyphs "" t))) + (should (string= result "")))) + +(ert-deftest test-replace-fraction-glyphs-no-fractions-to-glyphs () + "Should handle text with no fractions (no-op) when converting to glyphs." + (let ((result (test-replace-fraction-glyphs "hello world" t))) + (should (string= result "hello world")))) + +(ert-deftest test-replace-fraction-glyphs-no-fractions-to-text () + "Should handle text with no glyphs (no-op) when converting to text." + (let ((result (test-replace-fraction-glyphs "hello world" nil))) + (should (string= result "hello world")))) + +(ert-deftest test-replace-fraction-glyphs-at-start () + "Should handle fraction at start of text." + (let ((result (test-replace-fraction-glyphs "1/2 of the total" t))) + (should (string= result "½ of the total")))) + +(ert-deftest test-replace-fraction-glyphs-at-end () + "Should handle fraction at end of text." + (let ((result (test-replace-fraction-glyphs "Reduce by 1/4" t))) + (should (string= result "Reduce by ¼")))) + +(ert-deftest test-replace-fraction-glyphs-repeated () + "Should handle repeated fractions." + (let ((result (test-replace-fraction-glyphs "1/4 and 1/4 and 1/4" t))) + (should (string= result "¼ and ¼ and ¼")))) + +(ert-deftest test-replace-fraction-glyphs-very-long-text () + "Should handle very long text with many fractions." + (let* ((long-text (mapconcat (lambda (_) "1/4") (make-list 50 nil) " ")) + (result (test-replace-fraction-glyphs long-text t))) + (should (string-match-p "¼" result)) + (should-not (string-match-p "1/4" result)))) + +(ert-deftest test-replace-fraction-glyphs-bidirectional () + "Should correctly convert back and forth." + (let* ((original "Use 1/4 cup") + (to-glyph (test-replace-fraction-glyphs original t)) + (back-to-text (test-replace-fraction-glyphs to-glyph nil))) + (should (string= to-glyph "Use ¼ cup")) + (should (string= back-to-text original)))) + +;;; Error Cases + +(ert-deftest test-replace-fraction-glyphs-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "1/4") + (cj/--replace-fraction-glyphs (point-max) (point-min) t)) + :type 'error)) + +(ert-deftest test-replace-fraction-glyphs-empty-region () + "Should handle empty region (start == end) without error." + (with-temp-buffer + (insert "1/4") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (cj/--replace-fraction-glyphs pos pos t) + ;; Should complete without error + (should (string= (buffer-string) "1/4"))))) + +(provide 'test-custom-misc-replace-fraction-glyphs) +;;; test-custom-misc-replace-fraction-glyphs.el ends here diff --git a/tests/test-custom-ordering-alphabetize.el b/tests/test-custom-ordering-alphabetize.el new file mode 100644 index 00000000..c609e324 --- /dev/null +++ b/tests/test-custom-ordering-alphabetize.el @@ -0,0 +1,176 @@ +;;; test-custom-ordering-alphabetize.el --- Tests for cj/--alphabetize-region -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--alphabetize-region function from custom-ordering.el +;; +;; This function alphabetically sorts words in a region. +;; It splits by whitespace and commas, sorts alphabetically, and joins with ", ". +;; +;; Examples: +;; Input: "zebra apple banana" +;; Output: "apple, banana, zebra" +;; +;; Input: "dog, cat, bird" +;; Output: "bird, cat, dog" +;; +;; We test the NON-INTERACTIVE implementation (cj/--alphabetize-region) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-alphabetize (input-text) + "Test cj/--alphabetize-region on INPUT-TEXT. +Returns the sorted, comma-separated string." + (with-temp-buffer + (insert input-text) + (cj/--alphabetize-region (point-min) (point-max)))) + +;;; Normal Cases - Simple Words + +(ert-deftest test-alphabetize-simple-words () + "Should alphabetize simple words." + (let ((result (test-alphabetize "zebra apple banana"))) + (should (string= result "apple, banana, zebra")))) + +(ert-deftest test-alphabetize-already-sorted () + "Should handle already sorted words." + (let ((result (test-alphabetize "apple banana cherry"))) + (should (string= result "apple, banana, cherry")))) + +(ert-deftest test-alphabetize-reverse-order () + "Should alphabetize reverse-ordered words." + (let ((result (test-alphabetize "zebra yankee xray"))) + (should (string= result "xray, yankee, zebra")))) + +(ert-deftest test-alphabetize-two-words () + "Should alphabetize two words." + (let ((result (test-alphabetize "world hello"))) + (should (string= result "hello, world")))) + +;;; Normal Cases - With Commas + +(ert-deftest test-alphabetize-comma-separated () + "Should alphabetize comma-separated words." + (let ((result (test-alphabetize "dog, cat, bird"))) + (should (string= result "bird, cat, dog")))) + +(ert-deftest test-alphabetize-comma-separated-with-spaces () + "Should handle comma-separated with various spacing." + (let ((result (test-alphabetize "dog,cat,bird"))) + (should (string= result "bird, cat, dog")))) + +;;; Normal Cases - With Newlines + +(ert-deftest test-alphabetize-multiline () + "Should alphabetize words across multiple lines." + (let ((result (test-alphabetize "zebra\napple\nbanana"))) + (should (string= result "apple, banana, zebra")))) + +(ert-deftest test-alphabetize-mixed-separators () + "Should alphabetize with mixed separators (spaces, commas, newlines)." + (let ((result (test-alphabetize "zebra, apple\nbanana cherry"))) + (should (string= result "apple, banana, cherry, zebra")))) + +;;; Normal Cases - Case Sensitivity + +(ert-deftest test-alphabetize-case-sensitive () + "Should sort case-sensitively (uppercase before lowercase)." + (let ((result (test-alphabetize "zebra Apple banana"))) + ;; string-lessp sorts uppercase before lowercase + (should (string= result "Apple, banana, zebra")))) + +(ert-deftest test-alphabetize-mixed-case () + "Should handle mixed case words." + (let ((result (test-alphabetize "ZEBRA apple BANANA"))) + (should (string= result "BANANA, ZEBRA, apple")))) + +;;; Normal Cases - Numbers and Special Characters + +(ert-deftest test-alphabetize-with-numbers () + "Should alphabetize numbers as strings." + (let ((result (test-alphabetize "10 2 1 20"))) + ;; Alphabetic sort: "1", "10", "2", "20" + (should (string= result "1, 10, 2, 20")))) + +(ert-deftest test-alphabetize-mixed-alphanumeric () + "Should alphabetize mixed alphanumeric content." + (let ((result (test-alphabetize "item2 item1 item10"))) + (should (string= result "item1, item10, item2")))) + +(ert-deftest test-alphabetize-with-punctuation () + "Should alphabetize words with punctuation." + (let ((result (test-alphabetize "world! hello? test."))) + (should (string= result "hello?, test., world!")))) + +;;; Boundary Cases + +(ert-deftest test-alphabetize-empty-string () + "Should handle empty string." + (let ((result (test-alphabetize ""))) + (should (string= result "")))) + +(ert-deftest test-alphabetize-single-word () + "Should handle single word." + (let ((result (test-alphabetize "hello"))) + (should (string= result "hello")))) + +(ert-deftest test-alphabetize-only-whitespace () + "Should handle whitespace-only text." + (let ((result (test-alphabetize " \n\n\t\t "))) + (should (string= result "")))) + +(ert-deftest test-alphabetize-duplicates () + "Should handle duplicate words." + (let ((result (test-alphabetize "apple banana apple cherry"))) + (should (string= result "apple, apple, banana, cherry")))) + +(ert-deftest test-alphabetize-many-commas () + "Should handle multiple consecutive commas." + (let ((result (test-alphabetize "apple,,,banana,,,cherry"))) + (should (string= result "apple, banana, cherry")))) + +(ert-deftest test-alphabetize-very-long-list () + "Should handle very long list." + (let* ((words (mapcar (lambda (i) (format "word%03d" i)) (number-sequence 100 1 -1))) + (input (mapconcat #'identity words " ")) + (result (test-alphabetize input)) + (sorted-words (split-string result ", "))) + (should (= 100 (length sorted-words))) + (should (string= "word001" (car sorted-words))) + (should (string= "word100" (car (last sorted-words)))))) + +;;; Error Cases + +(ert-deftest test-alphabetize-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "hello world") + (cj/--alphabetize-region (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-alphabetize-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "" (cj/--alphabetize-region pos pos)))))) + +(provide 'test-custom-ordering-alphabetize) +;;; test-custom-ordering-alphabetize.el ends here diff --git a/tests/test-custom-ordering-arrayify.el b/tests/test-custom-ordering-arrayify.el new file mode 100644 index 00000000..9aedbc46 --- /dev/null +++ b/tests/test-custom-ordering-arrayify.el @@ -0,0 +1,215 @@ +;;; test-custom-ordering-arrayify.el --- Tests for cj/--arrayify -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--arrayify function from custom-ordering.el +;; +;; This function converts lines of text into a quoted, comma-separated array format. +;; It splits input by whitespace, wraps each element in quotes, and joins with ", ". +;; +;; Examples: +;; Input: "apple\nbanana\ncherry" +;; Output: "\"apple\", \"banana\", \"cherry\"" +;; +;; Input: "one two three" (with single quotes) +;; Output: "'one', 'two', 'three'" +;; +;; We test the NON-INTERACTIVE implementation (cj/--arrayify) to avoid +;; mocking user input for quote characters. This follows our testing best +;; practice of separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-arrayify (input-text quote) + "Test cj/--arrayify on INPUT-TEXT with QUOTE character. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--arrayify (point-min) (point-max) quote))) + +(defun test-arrayify-with-prefix-suffix (input-text quote prefix suffix) + "Test cj/--arrayify with PREFIX and SUFFIX on INPUT-TEXT. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--arrayify (point-min) (point-max) quote prefix suffix))) + +;;; Normal Cases - Double Quotes + +(ert-deftest test-arrayify-single-line-double-quotes () + "Should arrayify single line with double quotes." + (let ((result (test-arrayify "apple banana cherry" "\""))) + (should (string= result "\"apple\", \"banana\", \"cherry\"")))) + +(ert-deftest test-arrayify-multiple-lines-double-quotes () + "Should arrayify multiple lines with double quotes." + (let ((result (test-arrayify "apple\nbanana\ncherry" "\""))) + (should (string= result "\"apple\", \"banana\", \"cherry\"")))) + +(ert-deftest test-arrayify-mixed-whitespace-double-quotes () + "Should arrayify text with mixed whitespace using double quotes." + (let ((result (test-arrayify "apple \n\n banana\t\tcherry" "\""))) + (should (string= result "\"apple\", \"banana\", \"cherry\"")))) + +;;; Normal Cases - Single Quotes + +(ert-deftest test-arrayify-single-line-single-quotes () + "Should arrayify single line with single quotes." + (let ((result (test-arrayify "one two three" "'"))) + (should (string= result "'one', 'two', 'three'")))) + +(ert-deftest test-arrayify-multiple-lines-single-quotes () + "Should arrayify multiple lines with single quotes." + (let ((result (test-arrayify "one\ntwo\nthree" "'"))) + (should (string= result "'one', 'two', 'three'")))) + +;;; Normal Cases - Various Quote Types + +(ert-deftest test-arrayify-backticks () + "Should arrayify with backticks." + (let ((result (test-arrayify "foo bar baz" "`"))) + (should (string= result "`foo`, `bar`, `baz`")))) + +(ert-deftest test-arrayify-no-quotes () + "Should arrayify with empty quote string." + (let ((result (test-arrayify "alpha beta gamma" ""))) + (should (string= result "alpha, beta, gamma")))) + +(ert-deftest test-arrayify-square-brackets () + "Should arrayify with square brackets as quotes." + (let ((result (test-arrayify "x y z" "[]"))) + (should (string= result "[]x[], []y[], []z[]")))) + +;;; Normal Cases - Various Content + +(ert-deftest test-arrayify-with-numbers () + "Should arrayify numbers." + (let ((result (test-arrayify "1 2 3 4 5" "\""))) + (should (string= result "\"1\", \"2\", \"3\", \"4\", \"5\"")))) + +(ert-deftest test-arrayify-with-punctuation () + "Should arrayify words with punctuation." + (let ((result (test-arrayify "hello! world? test." "\""))) + (should (string= result "\"hello!\", \"world?\", \"test.\"")))) + +(ert-deftest test-arrayify-mixed-content () + "Should arrayify mixed alphanumeric content." + (let ((result (test-arrayify "item1 item2 item3" "\""))) + (should (string= result "\"item1\", \"item2\", \"item3\"")))) + +;;; Boundary Cases + +(ert-deftest test-arrayify-empty-string () + "Should handle empty string." + (let ((result (test-arrayify "" "\""))) + (should (string= result "")))) + +(ert-deftest test-arrayify-single-word () + "Should arrayify single word." + (let ((result (test-arrayify "hello" "\""))) + (should (string= result "\"hello\"")))) + +(ert-deftest test-arrayify-only-whitespace () + "Should handle whitespace-only text." + (let ((result (test-arrayify " \n\n\t\t " "\""))) + (should (string= result "")))) + +(ert-deftest test-arrayify-leading-trailing-whitespace () + "Should ignore leading and trailing whitespace." + (let ((result (test-arrayify " apple banana " "\""))) + (should (string= result "\"apple\", \"banana\"")))) + +(ert-deftest test-arrayify-very-long-list () + "Should handle very long list." + (let* ((words (make-list 100 "word")) + (input (mapconcat #'identity words " ")) + (result (test-arrayify input "\""))) + (should (= 100 (length (split-string result ", ")))))) + +(ert-deftest test-arrayify-two-words () + "Should arrayify two words." + (let ((result (test-arrayify "hello world" "\""))) + (should (string= result "\"hello\", \"world\"")))) + +;;; Normal Cases - Prefix/Suffix + +(ert-deftest test-arrayify-with-square-brackets () + "Should arrayify with square brackets prefix/suffix." + (let ((result (test-arrayify-with-prefix-suffix "apple banana cherry" "\"" "[" "]"))) + (should (string= result "[\"apple\", \"banana\", \"cherry\"]")))) + +(ert-deftest test-arrayify-with-parens () + "Should arrayify with parentheses prefix/suffix." + (let ((result (test-arrayify-with-prefix-suffix "one two three" "\"" "(" ")"))) + (should (string= result "(\"one\", \"two\", \"three\")")))) + +(ert-deftest test-arrayify-unquoted-with-brackets () + "Should create unquoted list with brackets." + (let ((result (test-arrayify-with-prefix-suffix "a b c" "" "[" "]"))) + (should (string= result "[a, b, c]")))) + +(ert-deftest test-arrayify-single-quotes-with-brackets () + "Should create single-quoted array with brackets." + (let ((result (test-arrayify-with-prefix-suffix "x y z" "'" "[" "]"))) + (should (string= result "['x', 'y', 'z']")))) + +(ert-deftest test-arrayify-only-prefix () + "Should handle only prefix, no suffix." + (let ((result (test-arrayify-with-prefix-suffix "foo bar" "\"" "[" nil))) + (should (string= result "[\"foo\", \"bar\"")))) + +(ert-deftest test-arrayify-only-suffix () + "Should handle only suffix, no prefix." + (let ((result (test-arrayify-with-prefix-suffix "foo bar" "\"" nil "]"))) + (should (string= result "\"foo\", \"bar\"]")))) + +(ert-deftest test-arrayify-multichar-prefix-suffix () + "Should handle multi-character prefix/suffix." + (let ((result (test-arrayify-with-prefix-suffix "a b" "\"" "Array(" ")"))) + (should (string= result "Array(\"a\", \"b\")")))) + +(ert-deftest test-arrayify-json-style () + "Should create JSON-style array." + (let ((result (test-arrayify-with-prefix-suffix "apple banana" "\"" "[" "]"))) + (should (string= result "[\"apple\", \"banana\"]")))) + +;;; Error Cases + +(ert-deftest test-arrayify-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "hello world") + (cj/--arrayify (point-max) (point-min) "\"")) + :type 'error)) + +(ert-deftest test-arrayify-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "" (cj/--arrayify pos pos "\"")))))) + +(ert-deftest test-arrayify-empty-region-with-brackets () + "Should handle empty region with brackets." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "[]" (cj/--arrayify pos pos "\"" "[" "]")))))) + +(provide 'test-custom-ordering-arrayify) +;;; test-custom-ordering-arrayify.el ends here diff --git a/tests/test-custom-ordering-comma-to-lines.el b/tests/test-custom-ordering-comma-to-lines.el new file mode 100644 index 00000000..93e37ec6 --- /dev/null +++ b/tests/test-custom-ordering-comma-to-lines.el @@ -0,0 +1,159 @@ +;;; test-custom-ordering-comma-to-lines.el --- Tests for cj/--comma-separated-text-to-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--comma-separated-text-to-lines function from custom-ordering.el +;; +;; This function converts comma-separated text to separate lines. +;; It replaces commas with newlines and removes trailing whitespace from each line. +;; +;; Examples: +;; Input: "apple, banana, cherry" +;; Output: "apple\nbanana\ncherry" +;; +;; Input: "one,two,three" +;; Output: "one\ntwo\nthree" +;; +;; We test the NON-INTERACTIVE implementation (cj/--comma-separated-text-to-lines) +;; to avoid mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-comma-to-lines (input-text) + "Test cj/--comma-separated-text-to-lines on INPUT-TEXT. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--comma-separated-text-to-lines (point-min) (point-max)))) + +;;; Normal Cases - Simple Comma-Separated + +(ert-deftest test-comma-to-lines-simple () + "Should convert simple comma-separated text to lines." + (let ((result (test-comma-to-lines "apple, banana, cherry"))) + (should (string= result "apple\n banana\n cherry")))) + +(ert-deftest test-comma-to-lines-no-spaces () + "Should convert comma-separated text without spaces." + (let ((result (test-comma-to-lines "one,two,three"))) + (should (string= result "one\ntwo\nthree")))) + +(ert-deftest test-comma-to-lines-two-elements () + "Should convert two comma-separated elements." + (let ((result (test-comma-to-lines "hello,world"))) + (should (string= result "hello\nworld")))) + +(ert-deftest test-comma-to-lines-with-varied-spacing () + "Should preserve leading spaces after commas." + (let ((result (test-comma-to-lines "alpha, beta, gamma"))) + (should (string= result "alpha\n beta\n gamma")))) + +;;; Normal Cases - Trailing Whitespace + +(ert-deftest test-comma-to-lines-trailing-spaces () + "Should remove trailing spaces but preserve leading spaces." + (let ((result (test-comma-to-lines "apple , banana , cherry "))) + (should (string= result "apple\n banana\n cherry")))) + +(ert-deftest test-comma-to-lines-trailing-tabs () + "Should remove trailing tabs after conversion." + (let ((result (test-comma-to-lines "apple\t,banana\t,cherry\t"))) + (should (string= result "apple\nbanana\ncherry")))) + +;;; Boundary Cases + +(ert-deftest test-comma-to-lines-empty-string () + "Should handle empty string." + (let ((result (test-comma-to-lines ""))) + (should (string= result "")))) + +(ert-deftest test-comma-to-lines-single-element () + "Should handle single element with no comma." + (let ((result (test-comma-to-lines "hello"))) + (should (string= result "hello")))) + +(ert-deftest test-comma-to-lines-single-element-with-trailing-comma () + "Should handle single element with trailing comma." + (let ((result (test-comma-to-lines "hello,"))) + (should (string= result "hello\n")))) + +(ert-deftest test-comma-to-lines-leading-comma () + "Should handle leading comma." + (let ((result (test-comma-to-lines ",apple,banana"))) + (should (string= result "\napple\nbanana")))) + +(ert-deftest test-comma-to-lines-consecutive-commas () + "Should handle consecutive commas." + (let ((result (test-comma-to-lines "apple,,banana"))) + (should (string= result "apple\n\nbanana")))) + +(ert-deftest test-comma-to-lines-many-consecutive-commas () + "Should handle many consecutive commas." + (let ((result (test-comma-to-lines "apple,,,banana"))) + (should (string= result "apple\n\n\nbanana")))) + +(ert-deftest test-comma-to-lines-only-commas () + "Should handle string with only commas (trailing blank lines removed)." + (let ((result (test-comma-to-lines ",,,"))) + ;; delete-trailing-whitespace removes trailing blank lines + (should (string= result "\n")))) + +;;; Normal Cases - With Spaces Around Elements + +(ert-deftest test-comma-to-lines-leading-spaces () + "Should preserve leading spaces within elements." + (let ((result (test-comma-to-lines " apple, banana, cherry"))) + (should (string= result " apple\n banana\n cherry")))) + +(ert-deftest test-comma-to-lines-mixed-content () + "Should handle mixed alphanumeric content." + (let ((result (test-comma-to-lines "item1,item2,item3"))) + (should (string= result "item1\nitem2\nitem3")))) + +(ert-deftest test-comma-to-lines-with-numbers () + "Should handle numbers." + (let ((result (test-comma-to-lines "1,2,3,4,5"))) + (should (string= result "1\n2\n3\n4\n5")))) + +(ert-deftest test-comma-to-lines-very-long-list () + "Should handle very long list." + (let* ((elements (mapcar #'number-to-string (number-sequence 1 100))) + (input (mapconcat #'identity elements ",")) + (result (test-comma-to-lines input)) + (lines (split-string result "\n"))) + (should (= 100 (length lines))))) + +;;; Error Cases + +(ert-deftest test-comma-to-lines-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "a,b,c") + (cj/--comma-separated-text-to-lines (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-comma-to-lines-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "a,b,c") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "" (cj/--comma-separated-text-to-lines pos pos)))))) + +(provide 'test-custom-ordering-comma-to-lines) +;;; test-custom-ordering-comma-to-lines.el ends here diff --git a/tests/test-custom-ordering-number-lines.el b/tests/test-custom-ordering-number-lines.el new file mode 100644 index 00000000..adda84f0 --- /dev/null +++ b/tests/test-custom-ordering-number-lines.el @@ -0,0 +1,181 @@ +;;; test-custom-ordering-number-lines.el --- Tests for cj/--number-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--number-lines function from custom-ordering.el +;; +;; This function numbers lines in a region with a customizable format. +;; The format string uses "N" as a placeholder for the line number. +;; Optionally supports zero-padding for alignment. +;; +;; Examples: +;; Input: "apple\nbanana\ncherry" +;; Format: "N. " +;; Output: "1. apple\n2. banana\n3. cherry" +;; +;; With zero-padding and 100 lines: +;; "001. line\n002. line\n...\n100. line" +;; +;; We test the NON-INTERACTIVE implementation (cj/--number-lines) to avoid +;; mocking user input. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) +(require 'cl-lib) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-number-lines (input-text format-string zero-pad) + "Test cj/--number-lines on INPUT-TEXT. +FORMAT-STRING is the format template. +ZERO-PAD enables zero-padding. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--number-lines (point-min) (point-max) format-string zero-pad))) + +;;; Normal Cases - Standard Format "N. " + +(ert-deftest test-number-lines-standard-format () + "Should number lines with standard format." + (let ((result (test-number-lines "apple\nbanana\ncherry" "N. " nil))) + (should (string= result "1. apple\n2. banana\n3. cherry")))) + +(ert-deftest test-number-lines-two-lines () + "Should number two lines." + (let ((result (test-number-lines "first\nsecond" "N. " nil))) + (should (string= result "1. first\n2. second")))) + +(ert-deftest test-number-lines-single-line () + "Should number single line." + (let ((result (test-number-lines "only" "N. " nil))) + (should (string= result "1. only")))) + +;;; Normal Cases - Alternative Formats + +(ert-deftest test-number-lines-parenthesis-format () + "Should number with parenthesis format." + (let ((result (test-number-lines "a\nb\nc" "N) " nil))) + (should (string= result "1) a\n2) b\n3) c")))) + +(ert-deftest test-number-lines-bracket-format () + "Should number with bracket format." + (let ((result (test-number-lines "x\ny\nz" "[N] " nil))) + (should (string= result "[1] x\n[2] y\n[3] z")))) + +(ert-deftest test-number-lines-no-space-format () + "Should number without space." + (let ((result (test-number-lines "a\nb" "N." nil))) + (should (string= result "1.a\n2.b")))) + +(ert-deftest test-number-lines-custom-format () + "Should number with custom format." + (let ((result (test-number-lines "foo\nbar" "Item N: " nil))) + (should (string= result "Item 1: foo\nItem 2: bar")))) + +;;; Normal Cases - Zero Padding + +(ert-deftest test-number-lines-zero-pad-single-digit () + "Should not pad when max is single digit." + (let ((result (test-number-lines "a\nb\nc" "N. " t))) + (should (string= result "1. a\n2. b\n3. c")))) + +(ert-deftest test-number-lines-zero-pad-double-digit () + "Should pad to 2 digits when max is 10-99." + (let* ((lines (make-list 12 "line")) + (input (mapconcat #'identity lines "\n")) + (result (test-number-lines input "N. " t)) + (result-lines (split-string result "\n"))) + (should (string-prefix-p "01. " (nth 0 result-lines))) + (should (string-prefix-p "09. " (nth 8 result-lines))) + (should (string-prefix-p "10. " (nth 9 result-lines))) + (should (string-prefix-p "12. " (nth 11 result-lines))))) + +(ert-deftest test-number-lines-zero-pad-triple-digit () + "Should pad to 3 digits when max is 100+." + (let* ((lines (make-list 105 "x")) + (input (mapconcat #'identity lines "\n")) + (result (test-number-lines input "N. " t)) + (result-lines (split-string result "\n"))) + (should (string-prefix-p "001. " (nth 0 result-lines))) + (should (string-prefix-p "099. " (nth 98 result-lines))) + (should (string-prefix-p "100. " (nth 99 result-lines))) + (should (string-prefix-p "105. " (nth 104 result-lines))))) + +;;; Boundary Cases + +(ert-deftest test-number-lines-empty-string () + "Should handle empty string." + (let ((result (test-number-lines "" "N. " nil))) + (should (string= result "1. ")))) + +(ert-deftest test-number-lines-empty-lines () + "Should number empty lines." + (let ((result (test-number-lines "\n\n" "N. " nil))) + (should (string= result "1. \n2. \n3. ")))) + +(ert-deftest test-number-lines-with-existing-numbers () + "Should number lines that already have content." + (let ((result (test-number-lines "1. old\n2. old" "N. " nil))) + (should (string= result "1. 1. old\n2. 2. old")))) + +(ert-deftest test-number-lines-multiple-N-in-format () + "Should replace multiple N occurrences." + (let ((result (test-number-lines "a\nb" "N-N. " nil))) + (should (string= result "1-1. a\n2-2. b")))) + +(ert-deftest test-number-lines-long-content () + "Should number lines with long content." + (let* ((long-line (make-string 100 ?x)) + (input (format "%s\n%s" long-line long-line)) + (result (test-number-lines input "N. " nil))) + (should (string-prefix-p "1. " result)) + (should (string-match "2\\. " result)))) + +;;; Normal Cases - No Zero Padding vs Zero Padding + +(ert-deftest test-number-lines-comparison-no-pad-vs-pad () + "Should show difference between no padding and padding." + (let* ((input "a\nb\nc\nd\ne\nf\ng\nh\ni\nj") + (no-pad (test-number-lines input "N. " nil)) + (with-pad (test-number-lines input "N. " t)) + (no-pad-lines (split-string no-pad "\n")) + (with-pad-lines (split-string with-pad "\n"))) + ;; Without padding: "1. ", "10. " + (should (string-prefix-p "1. " (nth 0 no-pad-lines))) + (should (string-prefix-p "10. " (nth 9 no-pad-lines))) + ;; With padding: "01. ", "10. " + (should (string-prefix-p "01. " (nth 0 with-pad-lines))) + (should (string-prefix-p "10. " (nth 9 with-pad-lines))))) + +;;; Error Cases + +(ert-deftest test-number-lines-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "line1\nline2") + (cj/--number-lines (point-max) (point-min) "N. " nil)) + :type 'error)) + +(ert-deftest test-number-lines-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "line1\nline2") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "1. " (cj/--number-lines pos pos "N. " nil)))))) + +(provide 'test-custom-ordering-number-lines) +;;; test-custom-ordering-number-lines.el ends here diff --git a/tests/test-custom-ordering-reverse-lines.el b/tests/test-custom-ordering-reverse-lines.el new file mode 100644 index 00000000..3c71362d --- /dev/null +++ b/tests/test-custom-ordering-reverse-lines.el @@ -0,0 +1,131 @@ +;;; test-custom-ordering-reverse-lines.el --- Tests for cj/--reverse-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--reverse-lines function from custom-ordering.el +;; +;; This function reverses the order of lines in a region. +;; The first line becomes last, last becomes first, etc. +;; +;; Examples: +;; Input: "line1\nline2\nline3" +;; Output: "line3\nline2\nline1" +;; +;; We test the NON-INTERACTIVE implementation (cj/--reverse-lines) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-reverse-lines (input-text) + "Test cj/--reverse-lines on INPUT-TEXT. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--reverse-lines (point-min) (point-max)))) + +;;; Normal Cases + +(ert-deftest test-reverse-lines-three-lines () + "Should reverse three lines." + (let ((result (test-reverse-lines "line1\nline2\nline3"))) + (should (string= result "line3\nline2\nline1")))) + +(ert-deftest test-reverse-lines-two-lines () + "Should reverse two lines." + (let ((result (test-reverse-lines "first\nsecond"))) + (should (string= result "second\nfirst")))) + +(ert-deftest test-reverse-lines-many-lines () + "Should reverse many lines." + (let ((result (test-reverse-lines "a\nb\nc\nd\ne"))) + (should (string= result "e\nd\nc\nb\na")))) + +(ert-deftest test-reverse-lines-with-content () + "Should reverse lines with actual content." + (let ((result (test-reverse-lines "apple banana\ncherry date\negg fig"))) + (should (string= result "egg fig\ncherry date\napple banana")))) + +(ert-deftest test-reverse-lines-bidirectional () + "Should reverse back and forth correctly." + (let* ((original "line1\nline2\nline3") + (reversed (test-reverse-lines original)) + (back (test-reverse-lines reversed))) + (should (string= reversed "line3\nline2\nline1")) + (should (string= back original)))) + +;;; Boundary Cases + +(ert-deftest test-reverse-lines-empty-string () + "Should handle empty string." + (let ((result (test-reverse-lines ""))) + (should (string= result "")))) + +(ert-deftest test-reverse-lines-single-line () + "Should handle single line (no change)." + (let ((result (test-reverse-lines "single line"))) + (should (string= result "single line")))) + +(ert-deftest test-reverse-lines-empty-lines () + "Should reverse including empty lines." + (let ((result (test-reverse-lines "a\n\nb"))) + (should (string= result "b\n\na")))) + +(ert-deftest test-reverse-lines-trailing-newline () + "Should handle trailing newline." + (let ((result (test-reverse-lines "line1\nline2\n"))) + (should (string= result "\nline2\nline1")))) + +(ert-deftest test-reverse-lines-only-newlines () + "Should reverse lines that are only newlines." + (let ((result (test-reverse-lines "\n\n\n"))) + (should (string= result "\n\n\n")))) + +(ert-deftest test-reverse-lines-numbers () + "Should reverse numbered lines." + (let ((result (test-reverse-lines "1\n2\n3\n4\n5"))) + (should (string= result "5\n4\n3\n2\n1")))) + +(ert-deftest test-reverse-lines-very-long () + "Should reverse very long list." + (let* ((lines (mapcar #'number-to-string (number-sequence 1 100))) + (input (mapconcat #'identity lines "\n")) + (result (test-reverse-lines input)) + (result-lines (split-string result "\n"))) + (should (= 100 (length result-lines))) + (should (string= "100" (car result-lines))) + (should (string= "1" (car (last result-lines)))))) + +;;; Error Cases + +(ert-deftest test-reverse-lines-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "line1\nline2") + (cj/--reverse-lines (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-reverse-lines-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "line1\nline2") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "" (cj/--reverse-lines pos pos)))))) + +(provide 'test-custom-ordering-reverse-lines) +;;; test-custom-ordering-reverse-lines.el ends here diff --git a/tests/test-custom-ordering-toggle-quotes.el b/tests/test-custom-ordering-toggle-quotes.el new file mode 100644 index 00000000..e11305ee --- /dev/null +++ b/tests/test-custom-ordering-toggle-quotes.el @@ -0,0 +1,155 @@ +;;; test-custom-ordering-toggle-quotes.el --- Tests for cj/--toggle-quotes -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--toggle-quotes function from custom-ordering.el +;; +;; This function toggles between double quotes and single quotes. +;; All " become ' and all ' become ". +;; +;; Examples: +;; Input: "apple", "banana" +;; Output: 'apple', 'banana' +;; +;; Input: 'hello', 'world' +;; Output: "hello", "world" +;; +;; We test the NON-INTERACTIVE implementation (cj/--toggle-quotes) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-toggle-quotes (input-text) + "Test cj/--toggle-quotes on INPUT-TEXT. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--toggle-quotes (point-min) (point-max)))) + +;;; Normal Cases - Double to Single + +(ert-deftest test-toggle-quotes-double-to-single () + "Should convert double quotes to single quotes." + (let ((result (test-toggle-quotes "\"apple\", \"banana\""))) + (should (string= result "'apple', 'banana'")))) + +(ert-deftest test-toggle-quotes-single-double-quote () + "Should convert single double quote." + (let ((result (test-toggle-quotes "\""))) + (should (string= result "'")))) + +(ert-deftest test-toggle-quotes-multiple-double-quotes () + "Should convert multiple double quotes." + (let ((result (test-toggle-quotes "\"hello\" \"world\" \"test\""))) + (should (string= result "'hello' 'world' 'test'")))) + +;;; Normal Cases - Single to Double + +(ert-deftest test-toggle-quotes-single-to-double () + "Should convert single quotes to double quotes." + (let ((result (test-toggle-quotes "'apple', 'banana'"))) + (should (string= result "\"apple\", \"banana\"")))) + +(ert-deftest test-toggle-quotes-single-single-quote () + "Should convert single single quote." + (let ((result (test-toggle-quotes "'"))) + (should (string= result "\"")))) + +(ert-deftest test-toggle-quotes-multiple-single-quotes () + "Should convert multiple single quotes." + (let ((result (test-toggle-quotes "'hello' 'world' 'test'"))) + (should (string= result "\"hello\" \"world\" \"test\"")))) + +;;; Normal Cases - Mixed Quotes + +(ert-deftest test-toggle-quotes-mixed () + "Should toggle mixed quotes." + (let ((result (test-toggle-quotes "\"double\" 'single'"))) + (should (string= result "'double' \"single\"")))) + +(ert-deftest test-toggle-quotes-bidirectional () + "Should toggle back and forth correctly." + (let* ((original "\"apple\", \"banana\"") + (toggled (test-toggle-quotes original)) + (back (test-toggle-quotes toggled))) + (should (string= toggled "'apple', 'banana'")) + (should (string= back original)))) + +;;; Normal Cases - With Text Content + +(ert-deftest test-toggle-quotes-preserves-content () + "Should preserve content while toggling quotes." + (let ((result (test-toggle-quotes "var x = \"hello world\";"))) + (should (string= result "var x = 'hello world';")))) + +(ert-deftest test-toggle-quotes-sql-style () + "Should toggle SQL-style quotes." + (let ((result (test-toggle-quotes "SELECT * FROM users WHERE name='John'"))) + (should (string= result "SELECT * FROM users WHERE name=\"John\"")))) + +(ert-deftest test-toggle-quotes-multiline () + "Should toggle quotes across multiple lines." + (let ((result (test-toggle-quotes "\"line1\"\n\"line2\"\n\"line3\""))) + (should (string= result "'line1'\n'line2'\n'line3'")))) + +;;; Boundary Cases + +(ert-deftest test-toggle-quotes-empty-string () + "Should handle empty string." + (let ((result (test-toggle-quotes ""))) + (should (string= result "")))) + +(ert-deftest test-toggle-quotes-no-quotes () + "Should handle text with no quotes." + (let ((result (test-toggle-quotes "hello world"))) + (should (string= result "hello world")))) + +(ert-deftest test-toggle-quotes-only-double-quotes () + "Should handle string with only double quotes." + (let ((result (test-toggle-quotes "\"\"\"\""))) + (should (string= result "''''")))) + +(ert-deftest test-toggle-quotes-only-single-quotes () + "Should handle string with only single quotes." + (let ((result (test-toggle-quotes "''''"))) + (should (string= result "\"\"\"\"")))) + +(ert-deftest test-toggle-quotes-adjacent-quotes () + "Should handle adjacent quotes." + (let ((result (test-toggle-quotes "\"\"''"))) + (should (string= result "''\"\"")))) + +;;; Error Cases + +(ert-deftest test-toggle-quotes-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "\"hello\"") + (cj/--toggle-quotes (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-toggle-quotes-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "\"hello\"") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "" (cj/--toggle-quotes pos pos)))))) + +(provide 'test-custom-ordering-toggle-quotes) +;;; test-custom-ordering-toggle-quotes.el ends here diff --git a/tests/test-custom-ordering-unarrayify.el b/tests/test-custom-ordering-unarrayify.el new file mode 100644 index 00000000..a778f419 --- /dev/null +++ b/tests/test-custom-ordering-unarrayify.el @@ -0,0 +1,159 @@ +;;; test-custom-ordering-unarrayify.el --- Tests for cj/--unarrayify -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--unarrayify function from custom-ordering.el +;; +;; This function converts comma-separated array format back to separate lines. +;; It splits by ", " (comma-space), removes quotes (both " and '), and joins with newlines. +;; +;; Examples: +;; Input: "\"apple\", \"banana\", \"cherry\"" +;; Output: "apple\nbanana\ncherry" +;; +;; Input: "'one', 'two', 'three'" +;; Output: "one\ntwo\nthree" +;; +;; We test the NON-INTERACTIVE implementation (cj/--unarrayify) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-unarrayify (input-text) + "Test cj/--unarrayify on INPUT-TEXT. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--unarrayify (point-min) (point-max)))) + +;;; Normal Cases - Double Quotes + +(ert-deftest test-unarrayify-double-quotes-simple () + "Should unarrayify double-quoted elements." + (let ((result (test-unarrayify "\"apple\", \"banana\", \"cherry\""))) + (should (string= result "apple\nbanana\ncherry")))) + +(ert-deftest test-unarrayify-double-quotes-single-element () + "Should unarrayify single double-quoted element." + (let ((result (test-unarrayify "\"hello\""))) + (should (string= result "hello")))) + +(ert-deftest test-unarrayify-double-quotes-two-elements () + "Should unarrayify two double-quoted elements." + (let ((result (test-unarrayify "\"one\", \"two\""))) + (should (string= result "one\ntwo")))) + +;;; Normal Cases - Single Quotes + +(ert-deftest test-unarrayify-single-quotes-simple () + "Should unarrayify single-quoted elements." + (let ((result (test-unarrayify "'alpha', 'beta', 'gamma'"))) + (should (string= result "alpha\nbeta\ngamma")))) + +(ert-deftest test-unarrayify-single-quotes-single-element () + "Should unarrayify single single-quoted element." + (let ((result (test-unarrayify "'hello'"))) + (should (string= result "hello")))) + +;;; Normal Cases - Mixed Quotes + +(ert-deftest test-unarrayify-mixed-quotes () + "Should unarrayify mixed quote types." + (let ((result (test-unarrayify "\"apple\", 'banana', \"cherry\""))) + (should (string= result "apple\nbanana\ncherry")))) + +;;; Normal Cases - No Quotes + +(ert-deftest test-unarrayify-no-quotes () + "Should unarrayify unquoted elements." + (let ((result (test-unarrayify "foo, bar, baz"))) + (should (string= result "foo\nbar\nbaz")))) + +;;; Normal Cases - Various Content + +(ert-deftest test-unarrayify-with-numbers () + "Should unarrayify numbers." + (let ((result (test-unarrayify "\"1\", \"2\", \"3\""))) + (should (string= result "1\n2\n3")))) + +(ert-deftest test-unarrayify-with-spaces-in-elements () + "Should preserve spaces within elements." + (let ((result (test-unarrayify "\"hello world\", \"foo bar\""))) + (should (string= result "hello world\nfoo bar")))) + +(ert-deftest test-unarrayify-mixed-content () + "Should unarrayify mixed alphanumeric content." + (let ((result (test-unarrayify "\"item1\", \"item2\", \"item3\""))) + (should (string= result "item1\nitem2\nitem3")))) + +;;; Boundary Cases + +(ert-deftest test-unarrayify-empty-string () + "Should handle empty string." + (let ((result (test-unarrayify ""))) + (should (string= result "")))) + +(ert-deftest test-unarrayify-only-quotes () + "Should remove quotes from quote-only string." + (let ((result (test-unarrayify "\"\""))) + (should (string= result "")))) + +(ert-deftest test-unarrayify-very-long-list () + "Should handle very long list." + (let* ((elements (mapcar (lambda (i) (format "\"%d\"" i)) (number-sequence 1 100))) + (input (mapconcat #'identity elements ", ")) + (result (test-unarrayify input)) + (lines (split-string result "\n"))) + (should (= 100 (length lines))))) + +(ert-deftest test-unarrayify-with-empty-elements () + "Should handle empty quoted elements." + (let ((result (test-unarrayify "\"\", \"test\", \"\""))) + (should (string= result "\ntest\n")))) + +;;; Edge Cases - Nested or Mismatched Quotes + +(ert-deftest test-unarrayify-double-quotes-in-single () + "Should handle double quotes inside single-quoted strings." + (let ((result (test-unarrayify "'he said \"hello\"', 'world'"))) + (should (string= result "he said hello\nworld")))) + +(ert-deftest test-unarrayify-only-opening-quotes () + "Should remove all quote characters even if mismatched." + (let ((result (test-unarrayify "\"apple, \"banana, \"cherry"))) + (should (string= result "apple\nbanana\ncherry")))) + +;;; Error Cases + +(ert-deftest test-unarrayify-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "\"a\", \"b\"") + (cj/--unarrayify (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-unarrayify-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "\"a\", \"b\"") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "" (cj/--unarrayify pos pos)))))) + +(provide 'test-custom-ordering-unarrayify) +;;; test-custom-ordering-unarrayify.el ends here diff --git a/tests/test-custom-text-enclose-append.el b/tests/test-custom-text-enclose-append.el new file mode 100644 index 00000000..3593a7f5 --- /dev/null +++ b/tests/test-custom-text-enclose-append.el @@ -0,0 +1,190 @@ +;;; test-custom-text-enclose-append.el --- Tests for cj/--append-to-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--append-to-lines function from custom-text-enclose.el +;; +;; This function appends a suffix string to the end of each line in text. +;; It preserves the structure of lines and handles trailing newlines correctly. +;; +;; Examples: +;; Input: "line1\nline2", suffix: ";" +;; Output: "line1;\nline2;" +;; +;; Input: "single", suffix: "!" +;; Output: "single!" +;; +;; We test the NON-INTERACTIVE implementation (cj/--append-to-lines) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-text-enclose) + +;;; Test Helpers + +(defun test-append-to-lines (text suffix) + "Test cj/--append-to-lines on TEXT with SUFFIX. +Returns the transformed string." + (cj/--append-to-lines text suffix)) + +;;; Normal Cases - Single Line + +(ert-deftest test-append-single-line () + "Should append to single line." + (let ((result (test-append-to-lines "hello" ";"))) + (should (string= result "hello;")))) + +(ert-deftest test-append-single-line-semicolon () + "Should append semicolon to single line." + (let ((result (test-append-to-lines "var x = 5" ";"))) + (should (string= result "var x = 5;")))) + +(ert-deftest test-append-single-line-exclamation () + "Should append exclamation mark to single line." + (let ((result (test-append-to-lines "Hello world" "!"))) + (should (string= result "Hello world!")))) + +;;; Normal Cases - Multiple Lines + +(ert-deftest test-append-two-lines () + "Should append to two lines." + (let ((result (test-append-to-lines "line1\nline2" ";"))) + (should (string= result "line1;\nline2;")))) + +(ert-deftest test-append-three-lines () + "Should append to three lines." + (let ((result (test-append-to-lines "a\nb\nc" "."))) + (should (string= result "a.\nb.\nc.")))) + +(ert-deftest test-append-many-lines () + "Should append to many lines." + (let* ((lines (make-list 10 "line")) + (input (mapconcat #'identity lines "\n")) + (result (test-append-to-lines input ";")) + (result-lines (split-string result "\n"))) + (should (= 10 (length result-lines))) + (should (cl-every (lambda (line) (string-suffix-p ";" line)) result-lines)))) + +;;; Normal Cases - Various Suffixes + +(ert-deftest test-append-comma () + "Should append comma to lines." + (let ((result (test-append-to-lines "apple\nbanana" ","))) + (should (string= result "apple,\nbanana,")))) + +(ert-deftest test-append-multi-char () + "Should append multi-character suffix." + (let ((result (test-append-to-lines "line" " // comment"))) + (should (string= result "line // comment")))) + +(ert-deftest test-append-pipe () + "Should append pipe character." + (let ((result (test-append-to-lines "col1\ncol2" " |"))) + (should (string= result "col1 |\ncol2 |")))) + +(ert-deftest test-append-empty-suffix () + "Should handle empty suffix." + (let ((result (test-append-to-lines "line1\nline2" ""))) + (should (string= result "line1\nline2")))) + +;;; Boundary Cases - Trailing Newlines + +(ert-deftest test-append-with-trailing-newline () + "Should preserve trailing newline." + (let ((result (test-append-to-lines "line1\nline2\n" ";"))) + (should (string= result "line1;\nline2;\n")))) + +(ert-deftest test-append-no-trailing-newline () + "Should work without trailing newline." + (let ((result (test-append-to-lines "line1\nline2" ";"))) + (should (string= result "line1;\nline2;")))) + +(ert-deftest test-append-single-line-with-newline () + "Should preserve trailing newline on single line." + (let ((result (test-append-to-lines "line\n" ";"))) + (should (string= result "line;\n")))) + +;;; Boundary Cases - Empty Lines + +(ert-deftest test-append-empty-line-between () + "Should append to empty line between other lines." + (let ((result (test-append-to-lines "line1\n\nline3" ";"))) + (should (string= result "line1;\n;\nline3;")))) + +(ert-deftest test-append-only-empty-lines () + "Should append to only empty lines." + (let ((result (test-append-to-lines "\n\n" ";"))) + (should (string= result ";\n;\n")))) + +(ert-deftest test-append-empty-first-line () + "Should append to empty first line." + (let ((result (test-append-to-lines "\nline2\nline3" ";"))) + (should (string= result ";\nline2;\nline3;")))) + +;;; Boundary Cases - Whitespace + +(ert-deftest test-append-preserves-leading-whitespace () + "Should preserve leading whitespace." + (let ((result (test-append-to-lines " line1\n line2" ";"))) + (should (string= result " line1;\n line2;")))) + +(ert-deftest test-append-preserves-trailing-whitespace () + "Should preserve trailing whitespace on line." + (let ((result (test-append-to-lines "line1 \nline2 " ";"))) + (should (string= result "line1 ;\nline2 ;")))) + +(ert-deftest test-append-whitespace-only-line () + "Should append to whitespace-only line." + (let ((result (test-append-to-lines "line1\n \nline3" ";"))) + (should (string= result "line1;\n ;\nline3;")))) + +;;; Boundary Cases - Special Cases + +(ert-deftest test-append-empty-string () + "Should handle empty string." + (let ((result (test-append-to-lines "" ";"))) + (should (string= result ";")))) + +(ert-deftest test-append-very-long-line () + "Should append to very long line." + (let* ((long-line (make-string 1000 ?a)) + (result (test-append-to-lines long-line ";"))) + (should (string-suffix-p ";" result)) + (should (= (length result) 1001)))) + +(ert-deftest test-append-with-existing-suffix () + "Should append even if line already has the suffix." + (let ((result (test-append-to-lines "line;" ";"))) + (should (string= result "line;;")))) + +;;; Edge Cases - Special Characters in Suffix + +(ert-deftest test-append-newline-suffix () + "Should append newline as suffix." + (let ((result (test-append-to-lines "line1\nline2" "\n"))) + (should (string= result "line1\n\nline2\n")))) + +(ert-deftest test-append-tab-suffix () + "Should append tab as suffix." + (let ((result (test-append-to-lines "col1\ncol2" "\t"))) + (should (string= result "col1\t\ncol2\t")))) + +(ert-deftest test-append-quote-suffix () + "Should append quote as suffix." + (let ((result (test-append-to-lines "value1\nvalue2" "\""))) + (should (string= result "value1\"\nvalue2\"")))) + +(provide 'test-custom-text-enclose-append) +;;; test-custom-text-enclose-append.el ends here diff --git a/tests/test-custom-text-enclose-indent.el b/tests/test-custom-text-enclose-indent.el new file mode 100644 index 00000000..e9042d35 --- /dev/null +++ b/tests/test-custom-text-enclose-indent.el @@ -0,0 +1,241 @@ +;;; test-custom-text-enclose-indent.el --- Tests for cj/--indent-lines and cj/--dedent-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--indent-lines and cj/--dedent-lines functions from custom-text-enclose.el +;; +;; cj/--indent-lines adds leading whitespace (spaces or tabs) to each line. +;; cj/--dedent-lines removes up to COUNT leading whitespace characters from each line. +;; +;; Examples (indent): +;; Input: "line1\nline2", count: 4, use-tabs: nil +;; Output: " line1\n line2" +;; +;; Examples (dedent): +;; Input: " line1\n line2", count: 4 +;; Output: "line1\nline2" +;; +;; We test the NON-INTERACTIVE implementations to avoid mocking user input. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-text-enclose) + +;;; Test Helpers + +(defun test-indent (text count use-tabs) + "Test cj/--indent-lines on TEXT with COUNT and USE-TABS. +Returns the transformed string." + (cj/--indent-lines text count use-tabs)) + +(defun test-dedent (text count) + "Test cj/--dedent-lines on TEXT with COUNT. +Returns the transformed string." + (cj/--dedent-lines text count)) + +;;; Indent Tests - Normal Cases with Spaces + +(ert-deftest test-indent-single-line-4-spaces () + "Should indent single line with 4 spaces." + (let ((result (test-indent "line" 4 nil))) + (should (string= result " line")))) + +(ert-deftest test-indent-two-lines-4-spaces () + "Should indent two lines with 4 spaces." + (let ((result (test-indent "line1\nline2" 4 nil))) + (should (string= result " line1\n line2")))) + +(ert-deftest test-indent-three-lines-2-spaces () + "Should indent three lines with 2 spaces." + (let ((result (test-indent "a\nb\nc" 2 nil))) + (should (string= result " a\n b\n c")))) + +(ert-deftest test-indent-many-lines () + "Should indent many lines." + (let ((result (test-indent "1\n2\n3\n4\n5" 4 nil))) + (should (string= result " 1\n 2\n 3\n 4\n 5")))) + +;;; Indent Tests - Normal Cases with Tabs + +(ert-deftest test-indent-single-line-1-tab () + "Should indent single line with 1 tab." + (let ((result (test-indent "line" 1 t))) + (should (string= result "\tline")))) + +(ert-deftest test-indent-two-lines-1-tab () + "Should indent two lines with 1 tab." + (let ((result (test-indent "line1\nline2" 1 t))) + (should (string= result "\tline1\n\tline2")))) + +(ert-deftest test-indent-with-2-tabs () + "Should indent with 2 tabs." + (let ((result (test-indent "code" 2 t))) + (should (string= result "\t\tcode")))) + +;;; Indent Tests - Boundary Cases + +(ert-deftest test-indent-empty-string () + "Should indent empty string." + (let ((result (test-indent "" 4 nil))) + (should (string= result " ")))) + +(ert-deftest test-indent-zero-count () + "Should not indent with count 0." + (let ((result (test-indent "line" 0 nil))) + (should (string= result "line")))) + +(ert-deftest test-indent-already-indented () + "Should add more indentation to already indented lines." + (let ((result (test-indent " line1\n line2" 2 nil))) + (should (string= result " line1\n line2")))) + +(ert-deftest test-indent-empty-lines () + "Should indent empty lines." + (let ((result (test-indent "line1\n\nline3" 4 nil))) + (should (string= result " line1\n \n line3")))) + +(ert-deftest test-indent-trailing-newline () + "Should preserve trailing newline." + (let ((result (test-indent "line1\nline2\n" 4 nil))) + (should (string= result " line1\n line2\n")))) + +(ert-deftest test-indent-no-trailing-newline () + "Should work without trailing newline." + (let ((result (test-indent "line1\nline2" 4 nil))) + (should (string= result " line1\n line2")))) + +;;; Dedent Tests - Normal Cases + +(ert-deftest test-dedent-single-line-4-spaces () + "Should dedent single line with 4 spaces." + (let ((result (test-dedent " line" 4))) + (should (string= result "line")))) + +(ert-deftest test-dedent-two-lines-4-spaces () + "Should dedent two lines with 4 spaces." + (let ((result (test-dedent " line1\n line2" 4))) + (should (string= result "line1\nline2")))) + +(ert-deftest test-dedent-three-lines-2-spaces () + "Should dedent three lines with 2 spaces." + (let ((result (test-dedent " a\n b\n c" 2))) + (should (string= result "a\nb\nc")))) + +(ert-deftest test-dedent-with-tabs () + "Should dedent lines with tabs." + (let ((result (test-dedent "\tline1\n\tline2" 1))) + (should (string= result "line1\nline2")))) + +(ert-deftest test-dedent-mixed-spaces-tabs () + "Should dedent mixed spaces and tabs." + (let ((result (test-dedent " \tline" 3))) + (should (string= result "line")))) + +;;; Dedent Tests - Partial Dedent + +(ert-deftest test-dedent-partial () + "Should dedent only COUNT characters." + (let ((result (test-dedent " line" 2))) + (should (string= result " line")))) + +(ert-deftest test-dedent-less-than-count () + "Should dedent all available spaces when less than COUNT." + (let ((result (test-dedent " line" 4))) + (should (string= result "line")))) + +(ert-deftest test-dedent-no-leading-space () + "Should not affect lines with no leading whitespace." + (let ((result (test-dedent "line" 4))) + (should (string= result "line")))) + +(ert-deftest test-dedent-varying-indentation () + "Should dedent each line independently." + (let ((result (test-dedent " line1\n line2\nline3" 2))) + (should (string= result " line1\nline2\nline3")))) + +;;; Dedent Tests - Boundary Cases + +(ert-deftest test-dedent-empty-string () + "Should handle empty string." + (let ((result (test-dedent "" 4))) + (should (string= result "")))) + +(ert-deftest test-dedent-zero-count () + "Should not dedent with count 0." + (let ((result (test-dedent " line" 0))) + (should (string= result " line")))) + +(ert-deftest test-dedent-empty-lines () + "Should handle empty lines." + (let ((result (test-dedent " line1\n \n line3" 4))) + (should (string= result "line1\n\nline3")))) + +(ert-deftest test-dedent-only-whitespace () + "Should dedent whitespace-only lines." + (let ((result (test-dedent " " 4))) + (should (string= result "")))) + +(ert-deftest test-dedent-trailing-newline () + "Should preserve trailing newline." + (let ((result (test-dedent " line1\n line2\n" 4))) + (should (string= result "line1\nline2\n")))) + +(ert-deftest test-dedent-preserves-internal-spaces () + "Should not affect internal whitespace." + (let ((result (test-dedent " hello world" 4))) + (should (string= result "hello world")))) + +;;; Round-trip Tests + +(ert-deftest test-indent-dedent-roundtrip () + "Should be able to indent then dedent back to original." + (let* ((original "line1\nline2") + (indented (test-indent original 4 nil)) + (dedented (test-dedent indented 4))) + (should (string= dedented original)))) + +(ert-deftest test-dedent-indent-roundtrip () + "Should be able to dedent then indent back to original." + (let* ((original " line1\n line2") + (dedented (test-dedent original 4)) + (indented (test-indent dedented 4 nil))) + (should (string= indented original)))) + +;;; Edge Cases + +(ert-deftest test-indent-very-long-line () + "Should indent very long line." + (let* ((long-line (make-string 1000 ?a)) + (result (test-indent long-line 4 nil))) + (should (string-prefix-p " " result)) + (should (= (length result) 1004)))) + +(ert-deftest test-dedent-very-indented () + "Should dedent very indented line." + (let* ((many-spaces (make-string 100 ?\s)) + (text (concat many-spaces "text")) + (result (test-dedent text 50))) + (should (string-prefix-p (make-string 50 ?\s) result)))) + +(ert-deftest test-indent-with-existing-tabs () + "Should indent lines that already have tabs." + (let ((result (test-indent "\tcode" 4 nil))) + (should (string= result " \tcode")))) + +(ert-deftest test-dedent-stops-at-non-whitespace () + "Should stop dedenting at first non-whitespace character." + (let ((result (test-dedent " a b" 4))) + (should (string= result "a b")))) + +(provide 'test-custom-text-enclose-indent) +;;; test-custom-text-enclose-indent.el ends here diff --git a/tests/test-custom-text-enclose-prepend.el b/tests/test-custom-text-enclose-prepend.el new file mode 100644 index 00000000..e03375ff --- /dev/null +++ b/tests/test-custom-text-enclose-prepend.el @@ -0,0 +1,207 @@ +;;; test-custom-text-enclose-prepend.el --- Tests for cj/--prepend-to-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--prepend-to-lines function from custom-text-enclose.el +;; +;; This function prepends a prefix string to the beginning of each line in text. +;; It preserves the structure of lines and handles trailing newlines correctly. +;; +;; Examples: +;; Input: "line1\nline2", prefix: "// " +;; Output: "// line1\n// line2" +;; +;; Input: "single", prefix: "> " +;; Output: "> single" +;; +;; We test the NON-INTERACTIVE implementation (cj/--prepend-to-lines) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-text-enclose) + +;;; Test Helpers + +(defun test-prepend-to-lines (text prefix) + "Test cj/--prepend-to-lines on TEXT with PREFIX. +Returns the transformed string." + (cj/--prepend-to-lines text prefix)) + +;;; Normal Cases - Single Line + +(ert-deftest test-prepend-single-line () + "Should prepend to single line." + (let ((result (test-prepend-to-lines "hello" "> "))) + (should (string= result "> hello")))) + +(ert-deftest test-prepend-single-line-comment () + "Should prepend comment marker to single line." + (let ((result (test-prepend-to-lines "code here" "// "))) + (should (string= result "// code here")))) + +(ert-deftest test-prepend-single-line-bullet () + "Should prepend bullet to single line." + (let ((result (test-prepend-to-lines "item" "- "))) + (should (string= result "- item")))) + +;;; Normal Cases - Multiple Lines + +(ert-deftest test-prepend-two-lines () + "Should prepend to two lines." + (let ((result (test-prepend-to-lines "line1\nline2" "> "))) + (should (string= result "> line1\n> line2")))) + +(ert-deftest test-prepend-three-lines () + "Should prepend to three lines." + (let ((result (test-prepend-to-lines "a\nb\nc" "* "))) + (should (string= result "* a\n* b\n* c")))) + +(ert-deftest test-prepend-many-lines () + "Should prepend to many lines." + (let* ((lines (make-list 10 "line")) + (input (mapconcat #'identity lines "\n")) + (result (test-prepend-to-lines input "# ")) + (result-lines (split-string result "\n"))) + (should (= 10 (length result-lines))) + (should (cl-every (lambda (line) (string-prefix-p "# " line)) result-lines)))) + +;;; Normal Cases - Various Prefixes + +(ert-deftest test-prepend-comment-marker () + "Should prepend comment marker." + (let ((result (test-prepend-to-lines "line1\nline2" "// "))) + (should (string= result "// line1\n// line2")))) + +(ert-deftest test-prepend-hash-comment () + "Should prepend hash comment." + (let ((result (test-prepend-to-lines "line1\nline2" "# "))) + (should (string= result "# line1\n# line2")))) + +(ert-deftest test-prepend-multi-char () + "Should prepend multi-character prefix." + (let ((result (test-prepend-to-lines "line" "TODO: "))) + (should (string= result "TODO: line")))) + +(ert-deftest test-prepend-empty-prefix () + "Should handle empty prefix." + (let ((result (test-prepend-to-lines "line1\nline2" ""))) + (should (string= result "line1\nline2")))) + +;;; Boundary Cases - Trailing Newlines + +(ert-deftest test-prepend-with-trailing-newline () + "Should preserve trailing newline." + (let ((result (test-prepend-to-lines "line1\nline2\n" "> "))) + (should (string= result "> line1\n> line2\n")))) + +(ert-deftest test-prepend-no-trailing-newline () + "Should work without trailing newline." + (let ((result (test-prepend-to-lines "line1\nline2" "> "))) + (should (string= result "> line1\n> line2")))) + +(ert-deftest test-prepend-single-line-with-newline () + "Should preserve trailing newline on single line." + (let ((result (test-prepend-to-lines "line\n" "> "))) + (should (string= result "> line\n")))) + +;;; Boundary Cases - Empty Lines + +(ert-deftest test-prepend-empty-line-between () + "Should prepend to empty line between other lines." + (let ((result (test-prepend-to-lines "line1\n\nline3" "> "))) + (should (string= result "> line1\n> \n> line3")))) + +(ert-deftest test-prepend-only-empty-lines () + "Should prepend to only empty lines." + (let ((result (test-prepend-to-lines "\n\n" "> "))) + (should (string= result "> \n> \n")))) + +(ert-deftest test-prepend-empty-first-line () + "Should prepend to empty first line." + (let ((result (test-prepend-to-lines "\nline2\nline3" "> "))) + (should (string= result "> \n> line2\n> line3")))) + +;;; Boundary Cases - Whitespace + +(ert-deftest test-prepend-preserves-leading-whitespace () + "Should preserve leading whitespace after prefix." + (let ((result (test-prepend-to-lines " line1\n line2" "// "))) + (should (string= result "// line1\n// line2")))) + +(ert-deftest test-prepend-preserves-trailing-whitespace () + "Should preserve trailing whitespace on line." + (let ((result (test-prepend-to-lines "line1 \nline2 " "> "))) + (should (string= result "> line1 \n> line2 ")))) + +(ert-deftest test-prepend-whitespace-only-line () + "Should prepend to whitespace-only line." + (let ((result (test-prepend-to-lines "line1\n \nline3" "> "))) + (should (string= result "> line1\n> \n> line3")))) + +;;; Boundary Cases - Special Cases + +(ert-deftest test-prepend-empty-string () + "Should handle empty string." + (let ((result (test-prepend-to-lines "" "> "))) + (should (string= result "> ")))) + +(ert-deftest test-prepend-very-long-line () + "Should prepend to very long line." + (let* ((long-line (make-string 1000 ?a)) + (result (test-prepend-to-lines long-line "> "))) + (should (string-prefix-p "> " result)) + (should (= (length result) 1002)))) + +(ert-deftest test-prepend-with-existing-prefix () + "Should prepend even if line already has the prefix." + (let ((result (test-prepend-to-lines "> line" "> "))) + (should (string= result "> > line")))) + +;;; Edge Cases - Special Characters in Prefix + +(ert-deftest test-prepend-newline-prefix () + "Should prepend newline as prefix." + (let ((result (test-prepend-to-lines "line1\nline2" "\n"))) + (should (string= result "\nline1\n\nline2")))) + +(ert-deftest test-prepend-tab-prefix () + "Should prepend tab as prefix." + (let ((result (test-prepend-to-lines "line1\nline2" "\t"))) + (should (string= result "\tline1\n\tline2")))) + +(ert-deftest test-prepend-quote-prefix () + "Should prepend quote as prefix." + (let ((result (test-prepend-to-lines "line1\nline2" "\""))) + (should (string= result "\"line1\n\"line2")))) + +;;; Edge Cases - Common Use Cases + +(ert-deftest test-prepend-markdown-quote () + "Should prepend markdown quote marker." + (let ((result (test-prepend-to-lines "quote text\nmore text" "> "))) + (should (string= result "> quote text\n> more text")))) + +(ert-deftest test-prepend-numbered-list () + "Should prepend numbers (though simpler uses would vary the prefix)." + (let ((result (test-prepend-to-lines "item" "1. "))) + (should (string= result "1. item")))) + +(ert-deftest test-prepend-indentation () + "Should prepend indentation spaces." + (let ((result (test-prepend-to-lines "code\nmore" " "))) + (should (string= result " code\n more")))) + +(provide 'test-custom-text-enclose-prepend) +;;; test-custom-text-enclose-prepend.el ends here diff --git a/tests/test-custom-text-enclose-surround.el b/tests/test-custom-text-enclose-surround.el new file mode 100644 index 00000000..dfed20a7 --- /dev/null +++ b/tests/test-custom-text-enclose-surround.el @@ -0,0 +1,200 @@ +;;; test-custom-text-enclose-surround.el --- Tests for cj/--surround -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--surround function from custom-text-enclose.el +;; +;; This function surrounds text with a given string. +;; The surround string is both prepended and appended to the text. +;; +;; Examples: +;; Input: "hello", surround: "\"" +;; Output: "\"hello\"" +;; +;; Input: "world", surround: "**" +;; Output: "**world**" +;; +;; We test the NON-INTERACTIVE implementation (cj/--surround) to avoid +;; mocking user input. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-text-enclose) + +;;; Test Helpers + +(defun test-surround (text surround-string) + "Test cj/--surround on TEXT with SURROUND-STRING. +Returns the transformed string." + (cj/--surround text surround-string)) + +;;; Normal Cases - Common Surround Strings + +(ert-deftest test-surround-double-quotes () + "Should surround text with double quotes." + (let ((result (test-surround "hello" "\""))) + (should (string= result "\"hello\"")))) + +(ert-deftest test-surround-single-quotes () + "Should surround text with single quotes." + (let ((result (test-surround "world" "'"))) + (should (string= result "'world'")))) + +(ert-deftest test-surround-parentheses () + "Should surround text with parentheses." + (let ((result (test-surround "text" "("))) + (should (string= result "(text(")))) + +(ert-deftest test-surround-square-brackets () + "Should surround text with square brackets." + (let ((result (test-surround "item" "["))) + (should (string= result "[item[")))) + +(ert-deftest test-surround-asterisks () + "Should surround text with asterisks for markdown." + (let ((result (test-surround "bold" "*"))) + (should (string= result "*bold*")))) + +(ert-deftest test-surround-double-asterisks () + "Should surround text with double asterisks." + (let ((result (test-surround "bold" "**"))) + (should (string= result "**bold**")))) + +;;; Normal Cases - Multi-Character Surround Strings + +(ert-deftest test-surround-html-tag () + "Should surround text with HTML-like tags." + (let ((result (test-surround "content" "<tag>"))) + (should (string= result "<tag>content<tag>")))) + +(ert-deftest test-surround-backticks () + "Should surround text with backticks for code." + (let ((result (test-surround "code" "`"))) + (should (string= result "`code`")))) + +(ert-deftest test-surround-triple-backticks () + "Should surround text with triple backticks." + (let ((result (test-surround "code block" "```"))) + (should (string= result "```code block```")))) + +(ert-deftest test-surround-custom-delimiter () + "Should surround text with custom delimiter." + (let ((result (test-surround "data" "||"))) + (should (string= result "||data||")))) + +;;; Normal Cases - Various Text Content + +(ert-deftest test-surround-single-word () + "Should surround single word." + (let ((result (test-surround "word" "\""))) + (should (string= result "\"word\"")))) + +(ert-deftest test-surround-multiple-words () + "Should surround multiple words." + (let ((result (test-surround "hello world" "\""))) + (should (string= result "\"hello world\"")))) + +(ert-deftest test-surround-sentence () + "Should surround full sentence." + (let ((result (test-surround "This is a sentence." "\""))) + (should (string= result "\"This is a sentence.\"")))) + +(ert-deftest test-surround-with-numbers () + "Should surround text with numbers." + (let ((result (test-surround "123" "'"))) + (should (string= result "'123'")))) + +(ert-deftest test-surround-with-special-chars () + "Should surround text with special characters." + (let ((result (test-surround "hello@world.com" "\""))) + (should (string= result "\"hello@world.com\"")))) + +;;; Normal Cases - Multiline Text + +(ert-deftest test-surround-multiline () + "Should surround multiline text." + (let ((result (test-surround "line1\nline2\nline3" "\""))) + (should (string= result "\"line1\nline2\nline3\"")))) + +(ert-deftest test-surround-text-with-newlines () + "Should surround text containing newlines." + (let ((result (test-surround "first\nsecond" "**"))) + (should (string= result "**first\nsecond**")))) + +;;; Boundary Cases + +(ert-deftest test-surround-empty-string () + "Should surround empty string." + (let ((result (test-surround "" "\""))) + (should (string= result "\"\"")))) + +(ert-deftest test-surround-single-character () + "Should surround single character." + (let ((result (test-surround "x" "\""))) + (should (string= result "\"x\"")))) + +(ert-deftest test-surround-empty-surround-string () + "Should handle empty surround string." + (let ((result (test-surround "hello" ""))) + (should (string= result "hello")))) + +(ert-deftest test-surround-very-long-text () + "Should surround very long text." + (let* ((long-text (make-string 1000 ?a)) + (result (test-surround long-text "\""))) + (should (string-prefix-p "\"" result)) + (should (string-suffix-p "\"" result)) + (should (= (length result) 1002)))) + +(ert-deftest test-surround-whitespace-only () + "Should surround whitespace-only text." + (let ((result (test-surround " " "\""))) + (should (string= result "\" \"")))) + +(ert-deftest test-surround-tabs () + "Should surround text with tabs." + (let ((result (test-surround "\t\ttext\t\t" "\""))) + (should (string= result "\"\t\ttext\t\t\"")))) + +;;; Edge Cases - Already Surrounded + +(ert-deftest test-surround-already-quoted () + "Should surround text that is already quoted." + (let ((result (test-surround "\"hello\"" "\""))) + (should (string= result "\"\"hello\"\"")))) + +(ert-deftest test-surround-nested () + "Should surround text creating nested delimiters." + (let ((result (test-surround "'inner'" "\""))) + (should (string= result "\"'inner'\"")))) + +;;; Edge Cases - Special Surround Strings + +(ert-deftest test-surround-space () + "Should surround text with spaces." + (let ((result (test-surround "text" " "))) + (should (string= result " text ")))) + +(ert-deftest test-surround-newline () + "Should surround text with newlines." + (let ((result (test-surround "text" "\n"))) + (should (string= result "\ntext\n")))) + +(ert-deftest test-surround-mixed-delimiters () + "Should surround with mixed delimiter string." + (let ((result (test-surround "content" "<>"))) + (should (string= result "<>content<>")))) + +(provide 'test-custom-text-enclose-surround) +;;; test-custom-text-enclose-surround.el ends here diff --git a/tests/test-custom-text-enclose-unwrap.el b/tests/test-custom-text-enclose-unwrap.el new file mode 100644 index 00000000..a308b644 --- /dev/null +++ b/tests/test-custom-text-enclose-unwrap.el @@ -0,0 +1,266 @@ +;;; test-custom-text-enclose-unwrap.el --- Tests for cj/--unwrap -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--unwrap function from custom-text-enclose.el +;; +;; This function removes surrounding delimiters from text. +;; It checks if text starts with opening and ends with closing, +;; and if so, removes them. +;; +;; Examples: +;; Input: "(text)", opening: "(", closing: ")" +;; Output: "text" +;; +;; Input: "<div>content</div>", opening: "<div>", closing: "</div>" +;; Output: "content" +;; +;; We test the NON-INTERACTIVE implementation (cj/--unwrap) to avoid +;; mocking user input. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-text-enclose) + +;;; Test Helpers + +(defun test-unwrap (text opening closing) + "Test cj/--unwrap on TEXT with OPENING and CLOSING. +Returns the transformed string." + (cj/--unwrap text opening closing)) + +;;; Normal Cases - Common Bracket Types + +(ert-deftest test-unwrap-parentheses () + "Should unwrap text with parentheses." + (let ((result (test-unwrap "(text)" "(" ")"))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-square-brackets () + "Should unwrap text with square brackets." + (let ((result (test-unwrap "[item]" "[" "]"))) + (should (string= result "item")))) + +(ert-deftest test-unwrap-curly-braces () + "Should unwrap text with curly braces." + (let ((result (test-unwrap "{code}" "{" "}"))) + (should (string= result "code")))) + +(ert-deftest test-unwrap-angle-brackets () + "Should unwrap text with angle brackets." + (let ((result (test-unwrap "<tag>" "<" ">"))) + (should (string= result "tag")))) + +;;; Normal Cases - HTML/XML Tags + +(ert-deftest test-unwrap-html-div () + "Should unwrap HTML div tags." + (let ((result (test-unwrap "<div>content</div>" "<div>" "</div>"))) + (should (string= result "content")))) + +(ert-deftest test-unwrap-html-span () + "Should unwrap HTML span tags." + (let ((result (test-unwrap "<span>text</span>" "<span>" "</span>"))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-xml-tag () + "Should unwrap XML tags." + (let ((result (test-unwrap "<item>data</item>" "<item>" "</item>"))) + (should (string= result "data")))) + +(ert-deftest test-unwrap-html-with-attributes () + "Should unwrap HTML tag containing attributes." + (let ((result (test-unwrap "<a href=\"url\">link</a>" "<a href=\"url\">" "</a>"))) + (should (string= result "link")))) + +;;; Normal Cases - Markdown Syntax + +(ert-deftest test-unwrap-markdown-bold () + "Should unwrap markdown bold syntax." + (let ((result (test-unwrap "**bold**" "**" "**"))) + (should (string= result "bold")))) + +(ert-deftest test-unwrap-markdown-italic () + "Should unwrap markdown italic syntax." + (let ((result (test-unwrap "*italic*" "*" "*"))) + (should (string= result "italic")))) + +(ert-deftest test-unwrap-markdown-code () + "Should unwrap markdown code syntax." + (let ((result (test-unwrap "`code`" "`" "`"))) + (should (string= result "code")))) + +(ert-deftest test-unwrap-quotes () + "Should unwrap double quotes." + (let ((result (test-unwrap "\"text\"" "\"" "\""))) + (should (string= result "text")))) + +;;; Normal Cases - Various Content + +(ert-deftest test-unwrap-single-word () + "Should unwrap single word." + (let ((result (test-unwrap "(word)" "(" ")"))) + (should (string= result "word")))) + +(ert-deftest test-unwrap-multiple-words () + "Should unwrap multiple words." + (let ((result (test-unwrap "(hello world)" "(" ")"))) + (should (string= result "hello world")))) + +(ert-deftest test-unwrap-sentence () + "Should unwrap full sentence." + (let ((result (test-unwrap "(This is a sentence.)" "(" ")"))) + (should (string= result "This is a sentence.")))) + +(ert-deftest test-unwrap-with-numbers () + "Should unwrap text with numbers." + (let ((result (test-unwrap "[123]" "[" "]"))) + (should (string= result "123")))) + +(ert-deftest test-unwrap-with-special-chars () + "Should unwrap text with special characters." + (let ((result (test-unwrap "<hello@world.com>" "<" ">"))) + (should (string= result "hello@world.com")))) + +;;; Normal Cases - Multiline Text + +(ert-deftest test-unwrap-multiline () + "Should unwrap multiline text." + (let ((result (test-unwrap "<div>line1\nline2\nline3</div>" "<div>" "</div>"))) + (should (string= result "line1\nline2\nline3")))) + +(ert-deftest test-unwrap-text-with-newlines () + "Should unwrap text containing newlines." + (let ((result (test-unwrap "(first\nsecond)" "(" ")"))) + (should (string= result "first\nsecond")))) + +;;; Boundary Cases - No Match + +(ert-deftest test-unwrap-no-opening () + "Should not unwrap when opening is missing." + (let ((result (test-unwrap "text)" "(" ")"))) + (should (string= result "text)")))) + +(ert-deftest test-unwrap-no-closing () + "Should not unwrap when closing is missing." + (let ((result (test-unwrap "(text" "(" ")"))) + (should (string= result "(text")))) + +(ert-deftest test-unwrap-neither-delimiter () + "Should not unwrap when neither delimiter is present." + (let ((result (test-unwrap "text" "(" ")"))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-wrong-opening () + "Should not unwrap with wrong opening delimiter." + (let ((result (test-unwrap "[text)" "(" ")"))) + (should (string= result "[text)")))) + +(ert-deftest test-unwrap-wrong-closing () + "Should not unwrap with wrong closing delimiter." + (let ((result (test-unwrap "(text]" "(" ")"))) + (should (string= result "(text]")))) + +;;; Boundary Cases - Empty + +(ert-deftest test-unwrap-empty-content () + "Should unwrap to empty string." + (let ((result (test-unwrap "()" "(" ")"))) + (should (string= result "")))) + +(ert-deftest test-unwrap-just-delimiters () + "Should unwrap when only delimiters present." + (let ((result (test-unwrap "[]" "[" "]"))) + (should (string= result "")))) + +(ert-deftest test-unwrap-empty-string () + "Should return empty string unchanged." + (let ((result (test-unwrap "" "(" ")"))) + (should (string= result "")))) + +(ert-deftest test-unwrap-too-short () + "Should not unwrap when text is shorter than delimiters." + (let ((result (test-unwrap "x" "<div>" "</div>"))) + (should (string= result "x")))) + +;;; Boundary Cases - Nested/Multiple + +(ert-deftest test-unwrap-nested-same () + "Should unwrap only outer layer of nested delimiters." + (let ((result (test-unwrap "((text))" "(" ")"))) + (should (string= result "(text)")))) + +(ert-deftest test-unwrap-nested-different () + "Should unwrap outer layer with different inner delimiters." + (let ((result (test-unwrap "([text])" "(" ")"))) + (should (string= result "[text]")))) + +(ert-deftest test-unwrap-multiple-in-content () + "Should not unwrap when delimiters appear in content." + (let ((result (test-unwrap "(a)b(c)" "(" ")"))) + (should (string= result "a)b(c")))) + +;;; Edge Cases - Special Delimiters + +(ert-deftest test-unwrap-asymmetric-length () + "Should unwrap with different length delimiters." + (let ((result (test-unwrap "<<text>>>" "<<" ">>>"))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-multi-char-delimiters () + "Should unwrap with multi-character delimiters." + (let ((result (test-unwrap "BEGINdataEND" "BEGIN" "END"))) + (should (string= result "data")))) + +(ert-deftest test-unwrap-space-delimiters () + "Should unwrap with space delimiters." + (let ((result (test-unwrap " text " " " " "))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-newline-delimiters () + "Should unwrap with newline delimiters." + (let ((result (test-unwrap "\ntext\n" "\n" "\n"))) + (should (string= result "text")))) + +;;; Edge Cases - Same Opening and Closing + +(ert-deftest test-unwrap-same-delimiters () + "Should unwrap when opening and closing are the same." + (let ((result (test-unwrap "*text*" "*" "*"))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-same-multi-char () + "Should unwrap same multi-char delimiters." + (let ((result (test-unwrap "***text***" "***" "***"))) + (should (string= result "text")))) + +;;; Edge Cases - Empty Delimiters + +(ert-deftest test-unwrap-empty-opening () + "Should handle empty opening delimiter." + (let ((result (test-unwrap "text)" "" ")"))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-empty-closing () + "Should handle empty closing delimiter." + (let ((result (test-unwrap "(text" "(" ""))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-both-delimiters-empty () + "Should return text unchanged when both delimiters empty." + (let ((result (test-unwrap "text" "" ""))) + (should (string= result "text")))) + +(provide 'test-custom-text-enclose-unwrap) +;;; test-custom-text-enclose-unwrap.el ends here diff --git a/tests/test-custom-text-enclose-wrap.el b/tests/test-custom-text-enclose-wrap.el new file mode 100644 index 00000000..f68a0668 --- /dev/null +++ b/tests/test-custom-text-enclose-wrap.el @@ -0,0 +1,240 @@ +;;; test-custom-text-enclose-wrap.el --- Tests for cj/--wrap -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--wrap function from custom-text-enclose.el +;; +;; This function wraps text with different opening and closing strings. +;; Unlike surround which uses the same string on both sides, wrap allows +;; asymmetric delimiters. +;; +;; Examples: +;; Input: "content", opening: "<div>", closing: "</div>" +;; Output: "<div>content</div>" +;; +;; Input: "text", opening: "(", closing: ")" +;; Output: "(text)" +;; +;; We test the NON-INTERACTIVE implementation (cj/--wrap) to avoid +;; mocking user input. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-text-enclose) + +;;; Test Helpers + +(defun test-wrap (text opening closing) + "Test cj/--wrap on TEXT with OPENING and CLOSING. +Returns the transformed string." + (cj/--wrap text opening closing)) + +;;; Normal Cases - Common Bracket Types + +(ert-deftest test-wrap-parentheses () + "Should wrap text with parentheses." + (let ((result (test-wrap "text" "(" ")"))) + (should (string= result "(text)")))) + +(ert-deftest test-wrap-square-brackets () + "Should wrap text with square brackets." + (let ((result (test-wrap "item" "[" "]"))) + (should (string= result "[item]")))) + +(ert-deftest test-wrap-curly-braces () + "Should wrap text with curly braces." + (let ((result (test-wrap "code" "{" "}"))) + (should (string= result "{code}")))) + +(ert-deftest test-wrap-angle-brackets () + "Should wrap text with angle brackets." + (let ((result (test-wrap "tag" "<" ">"))) + (should (string= result "<tag>")))) + +;;; Normal Cases - HTML/XML Tags + +(ert-deftest test-wrap-html-div () + "Should wrap text with HTML div tags." + (let ((result (test-wrap "content" "<div>" "</div>"))) + (should (string= result "<div>content</div>")))) + +(ert-deftest test-wrap-html-span () + "Should wrap text with HTML span tags." + (let ((result (test-wrap "text" "<span>" "</span>"))) + (should (string= result "<span>text</span>")))) + +(ert-deftest test-wrap-xml-tag () + "Should wrap text with XML tags." + (let ((result (test-wrap "data" "<item>" "</item>"))) + (should (string= result "<item>data</item>")))) + +(ert-deftest test-wrap-html-with-attributes () + "Should wrap text with HTML tag containing attributes." + (let ((result (test-wrap "link" "<a href=\"url\">" "</a>"))) + (should (string= result "<a href=\"url\">link</a>")))) + +;;; Normal Cases - Markdown Syntax + +(ert-deftest test-wrap-markdown-bold () + "Should wrap text with markdown bold syntax." + (let ((result (test-wrap "bold" "**" "**"))) + (should (string= result "**bold**")))) + +(ert-deftest test-wrap-markdown-italic () + "Should wrap text with markdown italic syntax." + (let ((result (test-wrap "italic" "*" "*"))) + (should (string= result "*italic*")))) + +(ert-deftest test-wrap-markdown-code () + "Should wrap text with markdown code syntax." + (let ((result (test-wrap "code" "`" "`"))) + (should (string= result "`code`")))) + +(ert-deftest test-wrap-markdown-link () + "Should wrap text with markdown link syntax." + (let ((result (test-wrap "text" "[" "](url)"))) + (should (string= result "[text](url)")))) + +;;; Normal Cases - Various Content + +(ert-deftest test-wrap-single-word () + "Should wrap single word." + (let ((result (test-wrap "word" "(" ")"))) + (should (string= result "(word)")))) + +(ert-deftest test-wrap-multiple-words () + "Should wrap multiple words." + (let ((result (test-wrap "hello world" "(" ")"))) + (should (string= result "(hello world)")))) + +(ert-deftest test-wrap-sentence () + "Should wrap full sentence." + (let ((result (test-wrap "This is a sentence." "(" ")"))) + (should (string= result "(This is a sentence.)")))) + +(ert-deftest test-wrap-with-numbers () + "Should wrap text with numbers." + (let ((result (test-wrap "123" "[" "]"))) + (should (string= result "[123]")))) + +(ert-deftest test-wrap-with-special-chars () + "Should wrap text with special characters." + (let ((result (test-wrap "hello@world.com" "<" ">"))) + (should (string= result "<hello@world.com>")))) + +;;; Normal Cases - Multiline Text + +(ert-deftest test-wrap-multiline () + "Should wrap multiline text." + (let ((result (test-wrap "line1\nline2\nline3" "<div>" "</div>"))) + (should (string= result "<div>line1\nline2\nline3</div>")))) + +(ert-deftest test-wrap-text-with-newlines () + "Should wrap text containing newlines." + (let ((result (test-wrap "first\nsecond" "(" ")"))) + (should (string= result "(first\nsecond)")))) + +;;; Boundary Cases + +(ert-deftest test-wrap-empty-string () + "Should wrap empty string." + (let ((result (test-wrap "" "(" ")"))) + (should (string= result "()")))) + +(ert-deftest test-wrap-single-character () + "Should wrap single character." + (let ((result (test-wrap "x" "[" "]"))) + (should (string= result "[x]")))) + +(ert-deftest test-wrap-empty-opening () + "Should handle empty opening delimiter." + (let ((result (test-wrap "text" "" ")"))) + (should (string= result "text)")))) + +(ert-deftest test-wrap-empty-closing () + "Should handle empty closing delimiter." + (let ((result (test-wrap "text" "(" ""))) + (should (string= result "(text")))) + +(ert-deftest test-wrap-both-empty () + "Should handle both delimiters empty." + (let ((result (test-wrap "text" "" ""))) + (should (string= result "text")))) + +(ert-deftest test-wrap-very-long-text () + "Should wrap very long text." + (let* ((long-text (make-string 1000 ?a)) + (result (test-wrap long-text "(" ")"))) + (should (string-prefix-p "(" result)) + (should (string-suffix-p ")" result)) + (should (= (length result) 1002)))) + +(ert-deftest test-wrap-whitespace-only () + "Should wrap whitespace-only text." + (let ((result (test-wrap " " "(" ")"))) + (should (string= result "( )")))) + +(ert-deftest test-wrap-tabs () + "Should wrap text with tabs." + (let ((result (test-wrap "\t\ttext\t\t" "[" "]"))) + (should (string= result "[\t\ttext\t\t]")))) + +;;; Edge Cases - Already Wrapped + +(ert-deftest test-wrap-already-wrapped () + "Should wrap text that is already wrapped." + (let ((result (test-wrap "(hello)" "[" "]"))) + (should (string= result "[(hello)]")))) + +(ert-deftest test-wrap-nested () + "Should wrap text creating nested delimiters." + (let ((result (test-wrap "[inner]" "(" ")"))) + (should (string= result "([inner])")))) + +;;; Edge Cases - Special Delimiters + +(ert-deftest test-wrap-asymmetric-length () + "Should wrap with different length delimiters." + (let ((result (test-wrap "text" "<<" ">>>"))) + (should (string= result "<<text>>>")))) + +(ert-deftest test-wrap-multi-char-delimiters () + "Should wrap with multi-character delimiters." + (let ((result (test-wrap "data" "BEGIN" "END"))) + (should (string= result "BEGINdataEND")))) + +(ert-deftest test-wrap-space-delimiters () + "Should wrap with space delimiters." + (let ((result (test-wrap "text" " " " "))) + (should (string= result " text ")))) + +(ert-deftest test-wrap-newline-delimiters () + "Should wrap with newline delimiters." + (let ((result (test-wrap "text" "\n" "\n"))) + (should (string= result "\ntext\n")))) + +(ert-deftest test-wrap-quote-delimiters () + "Should wrap with quote delimiters." + (let ((result (test-wrap "text" "\"" "\""))) + (should (string= result "\"text\"")))) + +;;; Edge Cases - Same Opening and Closing + +(ert-deftest test-wrap-same-delimiters () + "Should work like surround when delimiters are the same." + (let ((result (test-wrap "text" "*" "*"))) + (should (string= result "*text*")))) + +(provide 'test-custom-text-enclose-wrap) +;;; test-custom-text-enclose-wrap.el ends here diff --git a/tests/test-custom-whitespace-collapse.el b/tests/test-custom-whitespace-collapse.el new file mode 100644 index 00000000..40face95 --- /dev/null +++ b/tests/test-custom-whitespace-collapse.el @@ -0,0 +1,150 @@ +;;; test-custom-whitespace-collapse.el --- Tests for cj/--collapse-whitespace -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--collapse-whitespace function from custom-whitespace.el +;; +;; This function collapses whitespace in text by: +;; - Converting all tabs to spaces +;; - Removing leading and trailing whitespace +;; - Collapsing multiple consecutive spaces to single space +;; - Preserving newlines and text structure +;; +;; We test the NON-INTERACTIVE implementation (cj/--collapse-whitespace) +;; to avoid mocking region selection. This follows our testing best practice +;; of separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-whitespace) + +;;; Test Helpers + +(defun test-collapse-whitespace (input-text) + "Test cj/--collapse-whitespace on INPUT-TEXT. +Returns the buffer string after operation." + (with-temp-buffer + (insert input-text) + (cj/--collapse-whitespace (point-min) (point-max)) + (buffer-string))) + +;;; Normal Cases + +(ert-deftest test-collapse-whitespace-multiple-spaces () + "Should collapse multiple spaces to single space." + (let ((result (test-collapse-whitespace "hello world"))) + (should (string= result "hello world")))) + +(ert-deftest test-collapse-whitespace-multiple-tabs () + "Should convert tabs to spaces and collapse." + (let ((result (test-collapse-whitespace "hello\t\t\tworld"))) + (should (string= result "hello world")))) + +(ert-deftest test-collapse-whitespace-mixed-tabs-spaces () + "Should handle mixed tabs and spaces." + (let ((result (test-collapse-whitespace "hello \t \t world"))) + (should (string= result "hello world")))) + +(ert-deftest test-collapse-whitespace-leading-trailing () + "Should remove leading and trailing whitespace." + (let ((result (test-collapse-whitespace " hello world "))) + (should (string= result "hello world")))) + +(ert-deftest test-collapse-whitespace-tabs-leading-trailing () + "Should remove leading and trailing tabs." + (let ((result (test-collapse-whitespace "\t\thello world\t\t"))) + (should (string= result "hello world")))) + +(ert-deftest test-collapse-whitespace-multiple-words () + "Should collapse spaces between multiple words." + (let ((result (test-collapse-whitespace "one two three four"))) + (should (string= result "one two three four")))) + +(ert-deftest test-collapse-whitespace-preserve-newlines () + "Should preserve newlines while collapsing spaces." + (let ((result (test-collapse-whitespace "hello world\nfoo bar"))) + (should (string= result "hello world\nfoo bar")))) + +(ert-deftest test-collapse-whitespace-multiple-lines () + "Should handle multiple lines with various whitespace." + (let ((result (test-collapse-whitespace " hello world \n\t\tfoo bar\t\t"))) + (should (string= result "hello world\nfoo bar")))) + +;;; Boundary Cases + +(ert-deftest test-collapse-whitespace-empty-string () + "Should handle empty string." + (let ((result (test-collapse-whitespace ""))) + (should (string= result "")))) + +(ert-deftest test-collapse-whitespace-single-char () + "Should handle single character with surrounding spaces." + (let ((result (test-collapse-whitespace " x "))) + (should (string= result "x")))) + +(ert-deftest test-collapse-whitespace-only-whitespace () + "Should handle text with only whitespace (becomes empty)." + (let ((result (test-collapse-whitespace " \t \t "))) + (should (string= result "")))) + +(ert-deftest test-collapse-whitespace-no-extra-whitespace () + "Should handle text with no extra whitespace (no-op)." + (let ((result (test-collapse-whitespace "hello world"))) + (should (string= result "hello world")))) + +(ert-deftest test-collapse-whitespace-single-space () + "Should handle text with already-collapsed spaces (no-op)." + (let ((result (test-collapse-whitespace "one two three"))) + (should (string= result "one two three")))) + +(ert-deftest test-collapse-whitespace-very-long-line () + "Should handle very long lines with many spaces." + (let ((result (test-collapse-whitespace "word word word word word"))) + (should (string= result "word word word word word")))) + +(ert-deftest test-collapse-whitespace-multiple-newlines () + "Should preserve multiple newlines while removing spaces." + (let ((result (test-collapse-whitespace "hello world\n\n\nfoo bar"))) + (should (string= result "hello world\n\n\nfoo bar")))) + +(ert-deftest test-collapse-whitespace-spaces-around-newlines () + "Should remove spaces before/after newlines." + (let ((result (test-collapse-whitespace "hello \n world"))) + (should (string= result "hello\nworld")))) + +(ert-deftest test-collapse-whitespace-empty-lines () + "Should handle empty lines (lines become empty after whitespace removal)." + (let ((result (test-collapse-whitespace "line1\n \nline2"))) + (should (string= result "line1\n\nline2")))) + +;;; Error Cases + +(ert-deftest test-collapse-whitespace-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "hello world") + (cj/--collapse-whitespace (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-collapse-whitespace-empty-region () + "Should handle empty region (start == end) without error." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (cj/--collapse-whitespace pos pos) + ;; Should complete without error and not change buffer + (should (string= (buffer-string) "hello world"))))) + +(provide 'test-custom-whitespace-collapse) +;;; test-custom-whitespace-collapse.el ends here diff --git a/tests/test-custom-whitespace-delete-all.el b/tests/test-custom-whitespace-delete-all.el new file mode 100644 index 00000000..00abb1d4 --- /dev/null +++ b/tests/test-custom-whitespace-delete-all.el @@ -0,0 +1,150 @@ +;;; test-custom-whitespace-delete-all.el --- Tests for cj/--delete-all-whitespace -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--delete-all-whitespace function from custom-whitespace.el +;; +;; This function removes ALL whitespace characters from the region: +;; spaces, tabs, newlines, and carriage returns. Useful for creating +;; compact identifiers or removing all formatting. +;; +;; Uses the regexp [ \t\n\r]+ to match all whitespace. +;; +;; We test the NON-INTERACTIVE implementation (cj/--delete-all-whitespace) +;; to avoid mocking region selection. This follows our testing best practice +;; of separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-whitespace) + +;;; Test Helpers + +(defun test-delete-all-whitespace (input-text) + "Test cj/--delete-all-whitespace on INPUT-TEXT. +Returns the buffer string after operation." + (with-temp-buffer + (insert input-text) + (cj/--delete-all-whitespace (point-min) (point-max)) + (buffer-string))) + +;;; Normal Cases + +(ert-deftest test-delete-all-whitespace-single-space () + "Should remove single space." + (let ((result (test-delete-all-whitespace "hello world"))) + (should (string= result "helloworld")))) + +(ert-deftest test-delete-all-whitespace-multiple-spaces () + "Should remove multiple spaces." + (let ((result (test-delete-all-whitespace "hello world"))) + (should (string= result "helloworld")))) + +(ert-deftest test-delete-all-whitespace-tabs () + "Should remove tabs." + (let ((result (test-delete-all-whitespace "hello\tworld"))) + (should (string= result "helloworld")))) + +(ert-deftest test-delete-all-whitespace-newlines () + "Should remove newlines (joining lines)." + (let ((result (test-delete-all-whitespace "hello\nworld"))) + (should (string= result "helloworld")))) + +(ert-deftest test-delete-all-whitespace-mixed () + "Should remove all types of whitespace." + (let ((result (test-delete-all-whitespace "hello \t\n world"))) + (should (string= result "helloworld")))) + +(ert-deftest test-delete-all-whitespace-multiple-words () + "Should remove whitespace from multiple words." + (let ((result (test-delete-all-whitespace "one two three four"))) + (should (string= result "onetwothreefour")))) + +(ert-deftest test-delete-all-whitespace-multiline () + "Should remove all whitespace across multiple lines." + (let ((result (test-delete-all-whitespace "line1\nline2\nline3"))) + (should (string= result "line1line2line3")))) + +(ert-deftest test-delete-all-whitespace-leading-trailing () + "Should remove leading and trailing whitespace." + (let ((result (test-delete-all-whitespace " hello world "))) + (should (string= result "helloworld")))) + +(ert-deftest test-delete-all-whitespace-carriage-returns () + "Should handle carriage returns." + (let ((result (test-delete-all-whitespace "hello\r\nworld"))) + (should (string= result "helloworld")))) + +;;; Boundary Cases + +(ert-deftest test-delete-all-whitespace-empty-string () + "Should handle empty string." + (let ((result (test-delete-all-whitespace ""))) + (should (string= result "")))) + +(ert-deftest test-delete-all-whitespace-no-whitespace () + "Should handle text with no whitespace (no-op)." + (let ((result (test-delete-all-whitespace "helloworld"))) + (should (string= result "helloworld")))) + +(ert-deftest test-delete-all-whitespace-only-whitespace () + "Should delete all content when only whitespace exists." + (let ((result (test-delete-all-whitespace " \t \n "))) + (should (string= result "")))) + +(ert-deftest test-delete-all-whitespace-single-char () + "Should handle single character with surrounding whitespace." + (let ((result (test-delete-all-whitespace " x "))) + (should (string= result "x")))) + +(ert-deftest test-delete-all-whitespace-very-long-text () + "Should handle very long text." + (let ((result (test-delete-all-whitespace "word word word word word word word word"))) + (should (string= result "wordwordwordwordwordwordwordword")))) + +(ert-deftest test-delete-all-whitespace-single-whitespace () + "Should delete single whitespace character." + (let ((result (test-delete-all-whitespace " "))) + (should (string= result "")))) + +(ert-deftest test-delete-all-whitespace-consecutive-newlines () + "Should remove all consecutive newlines." + (let ((result (test-delete-all-whitespace "hello\n\n\nworld"))) + (should (string= result "helloworld")))) + +(ert-deftest test-delete-all-whitespace-complex-structure () + "Should handle complex whitespace patterns." + (let ((result (test-delete-all-whitespace " hello\n\t world \n foo\t\tbar "))) + (should (string= result "helloworldfoobar")))) + +;;; Error Cases + +(ert-deftest test-delete-all-whitespace-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "hello world") + (cj/--delete-all-whitespace (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-delete-all-whitespace-empty-region () + "Should handle empty region (start == end) without error." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (cj/--delete-all-whitespace pos pos) + ;; Should complete without error and not change buffer + (should (string= (buffer-string) "hello world"))))) + +(provide 'test-custom-whitespace-delete-all) +;;; test-custom-whitespace-delete-all.el ends here diff --git a/tests/test-custom-whitespace-delete-blank-lines.el b/tests/test-custom-whitespace-delete-blank-lines.el new file mode 100644 index 00000000..2d250521 --- /dev/null +++ b/tests/test-custom-whitespace-delete-blank-lines.el @@ -0,0 +1,146 @@ +;;; test-custom-whitespace-delete-blank-lines.el --- Tests for cj/--delete-blank-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--delete-blank-lines function from custom-whitespace.el +;; +;; This function deletes blank lines from text, where blank lines are defined +;; as lines containing only whitespace (spaces, tabs) or nothing at all. +;; Uses the regexp ^[[:space:]]*$ to match blank lines. +;; +;; We test the NON-INTERACTIVE implementation (cj/--delete-blank-lines) +;; to avoid mocking user prompts. This follows our testing best practice +;; of separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-whitespace) + +;;; Test Helpers + +(defun test-delete-blank-lines (input-text) + "Test cj/--delete-blank-lines on INPUT-TEXT. +Returns the buffer string after operation." + (with-temp-buffer + (insert input-text) + (cj/--delete-blank-lines (point-min) (point-max)) + (buffer-string))) + +;;; Normal Cases + +(ert-deftest test-delete-blank-lines-single-blank () + "Should delete single blank line between text." + (let ((result (test-delete-blank-lines "line1\n\nline2"))) + (should (string= result "line1\nline2")))) + +(ert-deftest test-delete-blank-lines-multiple-consecutive () + "Should delete multiple consecutive blank lines." + (let ((result (test-delete-blank-lines "line1\n\n\n\nline2"))) + (should (string= result "line1\nline2")))) + +(ert-deftest test-delete-blank-lines-spaces-only () + "Should delete lines with spaces only." + (let ((result (test-delete-blank-lines "line1\n \nline2"))) + (should (string= result "line1\nline2")))) + +(ert-deftest test-delete-blank-lines-tabs-only () + "Should delete lines with tabs only." + (let ((result (test-delete-blank-lines "line1\n\t\t\nline2"))) + (should (string= result "line1\nline2")))) + +(ert-deftest test-delete-blank-lines-mixed-whitespace () + "Should delete lines with mixed whitespace." + (let ((result (test-delete-blank-lines "line1\n \t \t \nline2"))) + (should (string= result "line1\nline2")))) + +(ert-deftest test-delete-blank-lines-no-blank-lines () + "Should handle text with no blank lines (no-op)." + (let ((result (test-delete-blank-lines "line1\nline2\nline3"))) + (should (string= result "line1\nline2\nline3")))) + +(ert-deftest test-delete-blank-lines-at-start () + "Should delete blank lines at start of region." + (let ((result (test-delete-blank-lines "\n\nline1\nline2"))) + (should (string= result "line1\nline2")))) + +(ert-deftest test-delete-blank-lines-at-end () + "Should delete blank lines at end of region." + (let ((result (test-delete-blank-lines "line1\nline2\n\n"))) + (should (string= result "line1\nline2\n")))) + +(ert-deftest test-delete-blank-lines-scattered () + "Should delete blank lines scattered throughout text." + (let ((result (test-delete-blank-lines "line1\n\nline2\n \nline3\n\t\nline4"))) + (should (string= result "line1\nline2\nline3\nline4")))) + +;;; Boundary Cases + +(ert-deftest test-delete-blank-lines-empty-string () + "Should handle empty string." + (let ((result (test-delete-blank-lines ""))) + (should (string= result "")))) + +(ert-deftest test-delete-blank-lines-only-blank-lines () + "Should delete all lines if only blank lines exist." + (let ((result (test-delete-blank-lines "\n\n\n"))) + (should (string= result "")))) + +(ert-deftest test-delete-blank-lines-only-whitespace () + "Should delete lines containing only whitespace." + (let ((result (test-delete-blank-lines " \n\t\t\n \t "))) + (should (string= result "")))) + +(ert-deftest test-delete-blank-lines-single-line-content () + "Should handle single line with content (no-op)." + (let ((result (test-delete-blank-lines "hello world"))) + (should (string= result "hello world")))) + +(ert-deftest test-delete-blank-lines-single-blank-line () + "Should delete single blank line." + (let ((result (test-delete-blank-lines "\n"))) + (should (string= result "")))) + +(ert-deftest test-delete-blank-lines-very-long-region () + "Should handle very long region with many blank lines." + (let* ((lines (make-list 100 "content")) + (input (mapconcat #'identity lines "\n\n")) + (expected (mapconcat #'identity lines "\n")) + (result (test-delete-blank-lines input))) + (should (string= result expected)))) + +(ert-deftest test-delete-blank-lines-preserve-content-lines () + "Should preserve lines with any non-whitespace content." + (let ((result (test-delete-blank-lines "x\n\ny\n \nz"))) + (should (string= result "x\ny\nz")))) + +;;; Error Cases + +(ert-deftest test-delete-blank-lines-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "line1\n\nline2") + (cj/--delete-blank-lines (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-delete-blank-lines-empty-region () + "Should handle empty region (start == end) without error." + (with-temp-buffer + (insert "line1\n\nline2") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (cj/--delete-blank-lines pos pos) + ;; Should complete without error + (should (string-match-p "line1" (buffer-string)))))) + +(provide 'test-custom-whitespace-delete-blank-lines) +;;; test-custom-whitespace-delete-blank-lines.el ends here diff --git a/tests/test-custom-whitespace-ensure-single-blank.el b/tests/test-custom-whitespace-ensure-single-blank.el new file mode 100644 index 00000000..7cd03e79 --- /dev/null +++ b/tests/test-custom-whitespace-ensure-single-blank.el @@ -0,0 +1,146 @@ +;;; test-custom-whitespace-ensure-single-blank.el --- Tests for cj/--ensure-single-blank-line -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--ensure-single-blank-line function from custom-whitespace.el +;; +;; This function collapses multiple consecutive blank lines to exactly one blank line. +;; Different from delete-blank-lines which removes ALL blank lines, this function +;; preserves blank lines but ensures no more than one blank line appears consecutively. +;; +;; A blank line is defined as a line containing only whitespace (spaces, tabs) or nothing. +;; Uses the regexp (^[[:space:]]*$\n){2,} to match 2+ consecutive blank lines. +;; +;; We test the NON-INTERACTIVE implementation (cj/--ensure-single-blank-line) +;; to avoid mocking user prompts. This follows our testing best practice +;; of separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-whitespace) + +;;; Test Helpers + +(defun test-ensure-single-blank-line (input-text) + "Test cj/--ensure-single-blank-line on INPUT-TEXT. +Returns the buffer string after operation." + (with-temp-buffer + (insert input-text) + (cj/--ensure-single-blank-line (point-min) (point-max)) + (buffer-string))) + +;;; Normal Cases + +(ert-deftest test-ensure-single-blank-two-blanks () + "Should collapse two blank lines to one." + (let ((result (test-ensure-single-blank-line "line1\n\n\nline2"))) + (should (string= result "line1\n\nline2")))) + +(ert-deftest test-ensure-single-blank-three-blanks () + "Should collapse three blank lines to one." + (let ((result (test-ensure-single-blank-line "line1\n\n\n\nline2"))) + (should (string= result "line1\n\nline2")))) + +(ert-deftest test-ensure-single-blank-many-blanks () + "Should collapse many blank lines to one." + (let ((result (test-ensure-single-blank-line "line1\n\n\n\n\n\n\nline2"))) + (should (string= result "line1\n\nline2")))) + +(ert-deftest test-ensure-single-blank-preserve-single () + "Should preserve single blank lines (no-op)." + (let ((result (test-ensure-single-blank-line "line1\n\nline2"))) + (should (string= result "line1\n\nline2")))) + +(ert-deftest test-ensure-single-blank-multiple-groups () + "Should handle multiple groups of consecutive blanks." + (let ((result (test-ensure-single-blank-line "line1\n\n\nline2\n\n\n\nline3"))) + (should (string= result "line1\n\nline2\n\nline3")))) + +(ert-deftest test-ensure-single-blank-blanks-with-spaces () + "Should handle blank lines with spaces only." + (let ((result (test-ensure-single-blank-line "line1\n \n \nline2"))) + (should (string= result "line1\n\nline2")))) + +(ert-deftest test-ensure-single-blank-blanks-with-tabs () + "Should handle blank lines with tabs only." + (let ((result (test-ensure-single-blank-line "line1\n\t\t\n\t\t\nline2"))) + (should (string= result "line1\n\nline2")))) + +(ert-deftest test-ensure-single-blank-mixed-whitespace () + "Should handle blank lines with mixed whitespace." + (let ((result (test-ensure-single-blank-line "line1\n \t \n \t \nline2"))) + (should (string= result "line1\n\nline2")))) + +(ert-deftest test-ensure-single-blank-no-blanks () + "Should handle text with no blank lines (no-op)." + (let ((result (test-ensure-single-blank-line "line1\nline2\nline3"))) + (should (string= result "line1\nline2\nline3")))) + +;;; Boundary Cases + +(ert-deftest test-ensure-single-blank-empty-string () + "Should handle empty string." + (let ((result (test-ensure-single-blank-line ""))) + (should (string= result "")))) + +(ert-deftest test-ensure-single-blank-only-blanks () + "Should collapse many blank lines to one blank line." + (let ((result (test-ensure-single-blank-line "\n\n\n\n"))) + (should (string= result "\n\n")))) + +(ert-deftest test-ensure-single-blank-at-start () + "Should collapse multiple blank lines at start to one." + (let ((result (test-ensure-single-blank-line "\n\n\nline1"))) + (should (string= result "\n\nline1")))) + +(ert-deftest test-ensure-single-blank-at-end () + "Should collapse multiple blank lines at end to one." + (let ((result (test-ensure-single-blank-line "line1\n\n\n"))) + (should (string= result "line1\n\n")))) + +(ert-deftest test-ensure-single-blank-single-line () + "Should handle single line (no-op)." + (let ((result (test-ensure-single-blank-line "line1"))) + (should (string= result "line1")))) + +(ert-deftest test-ensure-single-blank-complex-structure () + "Should handle complex mix of content and blanks." + (let ((result (test-ensure-single-blank-line "line1\n\n\nline2\nline3\n\n\n\nline4"))) + (should (string= result "line1\n\nline2\nline3\n\nline4")))) + +(ert-deftest test-ensure-single-blank-preserves-content () + "Should not modify lines with content." + (let ((result (test-ensure-single-blank-line " line1 \n\n\n line2 "))) + (should (string= result " line1 \n\n line2 ")))) + +;;; Error Cases + +(ert-deftest test-ensure-single-blank-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "line1\n\n\nline2") + (cj/--ensure-single-blank-line (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-ensure-single-blank-empty-region () + "Should handle empty region (start == end) without error." + (with-temp-buffer + (insert "line1\n\n\nline2") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (cj/--ensure-single-blank-line pos pos) + ;; Should complete without error + (should (string-match-p "line1" (buffer-string)))))) + +(provide 'test-custom-whitespace-ensure-single-blank) +;;; test-custom-whitespace-ensure-single-blank.el ends here diff --git a/tests/test-custom-whitespace-hyphenate.el b/tests/test-custom-whitespace-hyphenate.el new file mode 100644 index 00000000..03462fab --- /dev/null +++ b/tests/test-custom-whitespace-hyphenate.el @@ -0,0 +1,140 @@ +;;; test-custom-whitespace-hyphenate.el --- Tests for cj/--hyphenate-whitespace -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--hyphenate-whitespace function from custom-whitespace.el +;; +;; This function replaces all runs of whitespace (spaces, tabs, newlines, +;; carriage returns) with single hyphens. Useful for converting text with +;; whitespace into hyphenated identifiers or URLs. +;; +;; Uses the regexp [ \t\n\r]+ to match whitespace runs. +;; +;; We test the NON-INTERACTIVE implementation (cj/--hyphenate-whitespace) +;; to avoid mocking region selection. This follows our testing best practice +;; of separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-whitespace) + +;;; Test Helpers + +(defun test-hyphenate-whitespace (input-text) + "Test cj/--hyphenate-whitespace on INPUT-TEXT. +Returns the buffer string after operation." + (with-temp-buffer + (insert input-text) + (cj/--hyphenate-whitespace (point-min) (point-max)) + (buffer-string))) + +;;; Normal Cases + +(ert-deftest test-hyphenate-whitespace-single-space () + "Should replace single space with hyphen." + (let ((result (test-hyphenate-whitespace "hello world"))) + (should (string= result "hello-world")))) + +(ert-deftest test-hyphenate-whitespace-multiple-spaces () + "Should replace multiple spaces with single hyphen." + (let ((result (test-hyphenate-whitespace "hello world"))) + (should (string= result "hello-world")))) + +(ert-deftest test-hyphenate-whitespace-tabs () + "Should replace tabs with hyphen." + (let ((result (test-hyphenate-whitespace "hello\tworld"))) + (should (string= result "hello-world")))) + +(ert-deftest test-hyphenate-whitespace-mixed-tabs-spaces () + "Should replace mixed tabs and spaces with single hyphen." + (let ((result (test-hyphenate-whitespace "hello \t world"))) + (should (string= result "hello-world")))) + +(ert-deftest test-hyphenate-whitespace-newlines () + "Should replace newlines with hyphen (joining lines)." + (let ((result (test-hyphenate-whitespace "hello\nworld"))) + (should (string= result "hello-world")))) + +(ert-deftest test-hyphenate-whitespace-multiple-newlines () + "Should replace multiple newlines with single hyphen." + (let ((result (test-hyphenate-whitespace "hello\n\n\nworld"))) + (should (string= result "hello-world")))) + +(ert-deftest test-hyphenate-whitespace-multiple-words () + "Should hyphenate multiple words with various whitespace." + (let ((result (test-hyphenate-whitespace "one two three\tfour\nfive"))) + (should (string= result "one-two-three-four-five")))) + +(ert-deftest test-hyphenate-whitespace-carriage-returns () + "Should handle carriage returns." + (let ((result (test-hyphenate-whitespace "hello\r\nworld"))) + (should (string= result "hello-world")))) + +;;; Boundary Cases + +(ert-deftest test-hyphenate-whitespace-empty-string () + "Should handle empty string." + (let ((result (test-hyphenate-whitespace ""))) + (should (string= result "")))) + +(ert-deftest test-hyphenate-whitespace-no-whitespace () + "Should handle text with no whitespace (no-op)." + (let ((result (test-hyphenate-whitespace "helloworld"))) + (should (string= result "helloworld")))) + +(ert-deftest test-hyphenate-whitespace-only-whitespace () + "Should convert text with only whitespace to single hyphen." + (let ((result (test-hyphenate-whitespace " \t \n "))) + (should (string= result "-")))) + +(ert-deftest test-hyphenate-whitespace-single-char () + "Should handle single character with surrounding spaces." + (let ((result (test-hyphenate-whitespace " x "))) + (should (string= result "-x-")))) + +(ert-deftest test-hyphenate-whitespace-very-long-text () + "Should handle very long text with many spaces." + (let ((result (test-hyphenate-whitespace "word word word word word word word word"))) + (should (string= result "word-word-word-word-word-word-word-word")))) + +(ert-deftest test-hyphenate-whitespace-leading-whitespace () + "Should replace leading whitespace with hyphen." + (let ((result (test-hyphenate-whitespace " hello world"))) + (should (string= result "-hello-world")))) + +(ert-deftest test-hyphenate-whitespace-trailing-whitespace () + "Should replace trailing whitespace with hyphen." + (let ((result (test-hyphenate-whitespace "hello world "))) + (should (string= result "hello-world-")))) + +;;; Error Cases + +(ert-deftest test-hyphenate-whitespace-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "hello world") + (cj/--hyphenate-whitespace (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-hyphenate-whitespace-empty-region () + "Should handle empty region (start == end) without error." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (cj/--hyphenate-whitespace pos pos) + ;; Should complete without error and not change buffer + (should (string= (buffer-string) "hello world"))))) + +(provide 'test-custom-whitespace-hyphenate) +;;; test-custom-whitespace-hyphenate.el ends here diff --git a/tests/test-custom-whitespace-remove-leading-trailing.el b/tests/test-custom-whitespace-remove-leading-trailing.el new file mode 100644 index 00000000..5a846e7f --- /dev/null +++ b/tests/test-custom-whitespace-remove-leading-trailing.el @@ -0,0 +1,157 @@ +;;; test-custom-whitespace-remove-leading-trailing.el --- Tests for cj/--remove-leading-trailing-whitespace -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--remove-leading-trailing-whitespace function from custom-whitespace.el +;; +;; This function removes leading and trailing whitespace (spaces and tabs) from text. +;; - Removes leading whitespace: ^[ \t]+ +;; - Removes trailing whitespace: [ \t]+$ +;; - Preserves interior whitespace +;; - Operates on any region defined by START and END +;; +;; We test the NON-INTERACTIVE implementation (cj/--remove-leading-trailing-whitespace) +;; to avoid mocking region selection and prefix arguments. This follows our testing +;; best practice of separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-whitespace) + +;;; Test Helpers + +(defun test-remove-leading-trailing (input-text) + "Test cj/--remove-leading-trailing-whitespace on INPUT-TEXT. +Returns the buffer string after operation." + (with-temp-buffer + (insert input-text) + (cj/--remove-leading-trailing-whitespace (point-min) (point-max)) + (buffer-string))) + +;;; Normal Cases + +(ert-deftest test-remove-leading-trailing-leading-spaces () + "Should remove leading spaces from single line." + (let ((result (test-remove-leading-trailing " hello world"))) + (should (string= result "hello world")))) + +(ert-deftest test-remove-leading-trailing-trailing-spaces () + "Should remove trailing spaces from single line." + (let ((result (test-remove-leading-trailing "hello world "))) + (should (string= result "hello world")))) + +(ert-deftest test-remove-leading-trailing-both-spaces () + "Should remove both leading and trailing spaces." + (let ((result (test-remove-leading-trailing " hello world "))) + (should (string= result "hello world")))) + +(ert-deftest test-remove-leading-trailing-leading-tabs () + "Should remove leading tabs from single line." + (let ((result (test-remove-leading-trailing "\t\thello world"))) + (should (string= result "hello world")))) + +(ert-deftest test-remove-leading-trailing-trailing-tabs () + "Should remove trailing tabs from single line." + (let ((result (test-remove-leading-trailing "hello world\t\t"))) + (should (string= result "hello world")))) + +(ert-deftest test-remove-leading-trailing-mixed-tabs-spaces () + "Should remove mixed tabs and spaces." + (let ((result (test-remove-leading-trailing " \t hello world \t "))) + (should (string= result "hello world")))) + +(ert-deftest test-remove-leading-trailing-preserve-interior () + "Should preserve interior whitespace." + (let ((result (test-remove-leading-trailing " hello world \t"))) + (should (string= result "hello world")))) + +(ert-deftest test-remove-leading-trailing-multiple-lines () + "Should handle multiple lines with leading/trailing whitespace." + (let ((result (test-remove-leading-trailing " line1 \n\t\tline2\t\n line3 "))) + (should (string= result "line1\nline2\nline3")))) + +(ert-deftest test-remove-leading-trailing-multiline-preserve-interior () + "Should preserve interior whitespace on multiple lines." + (let ((result (test-remove-leading-trailing " hello world \n foo bar "))) + (should (string= result "hello world\nfoo bar")))) + +;;; Boundary Cases + +(ert-deftest test-remove-leading-trailing-empty-string () + "Should handle empty string." + (let ((result (test-remove-leading-trailing ""))) + (should (string= result "")))) + +(ert-deftest test-remove-leading-trailing-single-char () + "Should handle single character with surrounding spaces." + (let ((result (test-remove-leading-trailing " x "))) + (should (string= result "x")))) + +(ert-deftest test-remove-leading-trailing-only-whitespace () + "Should handle lines with only whitespace." + (let ((result (test-remove-leading-trailing " \t "))) + (should (string= result "")))) + +(ert-deftest test-remove-leading-trailing-no-whitespace () + "Should handle text with no leading/trailing whitespace (no-op)." + (let ((result (test-remove-leading-trailing "hello world"))) + (should (string= result "hello world")))) + +(ert-deftest test-remove-leading-trailing-very-long-line () + "Should handle very long lines with whitespace." + (let* ((long-text (make-string 500 ?x)) + (input (concat " " long-text " ")) + (result (test-remove-leading-trailing input))) + (should (string= result long-text)))) + +(ert-deftest test-remove-leading-trailing-whitespace-between-lines () + "Should handle lines that become empty after removal." + (let ((result (test-remove-leading-trailing "line1\n \nline2"))) + (should (string= result "line1\n\nline2")))) + +(ert-deftest test-remove-leading-trailing-newlines-only () + "Should preserve newlines while removing spaces." + (let ((result (test-remove-leading-trailing "\n\n\n"))) + (should (string= result "\n\n\n")))) + +(ert-deftest test-remove-leading-trailing-partial-region () + "Should work on partial buffer region." + (with-temp-buffer + (insert " hello \n world \n test ") + ;; Only operate on middle line + (let ((start (+ (point-min) 10)) ; Start of second line + (end (+ (point-min) 19))) ; End of second line + (cj/--remove-leading-trailing-whitespace start end) + (should (string= (buffer-string) " hello \nworld\n test "))))) + +;;; Error Cases + +(ert-deftest test-remove-leading-trailing-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "hello world") + (cj/--remove-leading-trailing-whitespace (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-remove-leading-trailing-empty-region () + "Should handle empty region (start == end) without error." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (cj/--remove-leading-trailing-whitespace pos pos) + ;; Should complete without error and not change buffer + (should (string= (buffer-string) "hello world"))))) + +(provide 'test-custom-whitespace-remove-leading-trailing) +;;; test-custom-whitespace-remove-leading-trailing.el ends here diff --git a/tests/test-flycheck-languagetool-setup.el b/tests/test-flycheck-languagetool-setup.el new file mode 100644 index 00000000..a719e822 --- /dev/null +++ b/tests/test-flycheck-languagetool-setup.el @@ -0,0 +1,71 @@ +;;; test-flycheck-languagetool-setup.el --- Unit tests for LanguageTool setup -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests verifying LanguageTool installation and wrapper script setup. +;; Focus: Testing OUR code (wrapper script, file setup), not flycheck internals. +;; +;; We trust that flycheck works correctly (it's an external framework). +;; These tests verify: +;; - LanguageTool is installed and accessible +;; - Our wrapper script exists, is executable, and has correct structure +;; - Python 3 dependency is available +;; +;; Categories: Normal (installation checks), Boundary (script structure), Error (missing dependencies) + +;;; Code: + +(require 'ert) + +;; ----------------------------- Normal Cases ---------------------------------- + +(ert-deftest test-flycheck-languagetool-setup-normal-wrapper-exists () + "Test that languagetool-flycheck wrapper script exists." + (let ((wrapper-path (expand-file-name "~/.emacs.d/scripts/languagetool-flycheck"))) + (should (file-exists-p wrapper-path)))) + +(ert-deftest test-flycheck-languagetool-setup-normal-wrapper-executable () + "Test that languagetool-flycheck wrapper script is executable." + (let ((wrapper-path (expand-file-name "~/.emacs.d/scripts/languagetool-flycheck"))) + (should (file-executable-p wrapper-path)))) + +(ert-deftest test-flycheck-languagetool-setup-normal-languagetool-installed () + "Test that languagetool command is available in PATH." + (should (executable-find "languagetool"))) + +(ert-deftest test-flycheck-languagetool-setup-normal-python3-available () + "Test that python3 is available for wrapper script." + (should (executable-find "python3"))) + + +;; ----------------------------- Boundary Cases -------------------------------- + +(ert-deftest test-flycheck-languagetool-setup-boundary-wrapper-script-format () + "Test that wrapper script has correct shebang and structure." + (let ((wrapper-path (expand-file-name "~/.emacs.d/scripts/languagetool-flycheck"))) + (with-temp-buffer + (insert-file-contents wrapper-path) + (goto-char (point-min)) + ;; Check shebang + (should (looking-at "#!/usr/bin/env python3")) + ;; Check it contains required imports + (should (search-forward "import json" nil t)) + (should (search-forward "import subprocess" nil t))))) + +;; ----------------------------- Error Cases ----------------------------------- + +(ert-deftest test-flycheck-languagetool-setup-error-missing-file-argument () + "Test that wrapper script requires file argument. +When called without arguments, wrapper should exit with error." + (let* ((wrapper (expand-file-name "~/.emacs.d/scripts/languagetool-flycheck")) + (exit-code nil)) + (with-temp-buffer + (setq exit-code (call-process wrapper nil t nil)) + ;; Should exit with non-zero status when no file provided + (should-not (= 0 exit-code)) + ;; Should print usage message to stderr (captured in buffer) + (goto-char (point-min)) + (should (or (search-forward "Usage:" nil t) + (search-forward "FILE" nil t)))))) + +(provide 'test-flycheck-languagetool-setup) +;;; test-flycheck-languagetool-setup.el ends here diff --git a/tests/test-integration-buffer-diff.el b/tests/test-integration-buffer-diff.el new file mode 100644 index 00000000..678e4816 --- /dev/null +++ b/tests/test-integration-buffer-diff.el @@ -0,0 +1,300 @@ +;;; test-integration-buffer-diff.el --- Integration tests for buffer diff functionality -*- lexical-binding: t; -*- + +;;; Commentary: +;; Integration tests covering the complete buffer diff workflow: +;; - Comparing buffer contents with saved file version +;; - Difftastic integration with fallback to regular diff +;; - Output formatting and buffer display +;; - Handling of no differences case +;; +;; Components integrated: +;; - cj/executable-exists-p (program detection from system-lib) +;; - cj/--diff-with-difftastic (difftastic execution and formatting) +;; - cj/--diff-with-regular-diff (unified diff execution) +;; - cj/diff-buffer-with-file (orchestration and user interaction) +;; - File I/O (temp file creation/cleanup) +;; - Buffer management (creating and displaying diff output) + +;;; Code: + +(require 'ert) +(require 'system-lib) + +;; Stub out the keymap that custom-buffer-file requires +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'custom-buffer-file) + +;;; Test Utilities + +(defun test-integration-buffer-diff--get-diff-buffer () + "Get the diff buffer created by cj/diff-buffer-with-file. +Returns either *Diff (difftastic)* or *Diff (unified)* buffer." + (or (get-buffer "*Diff (difftastic)*") + (get-buffer "*Diff (unified)*"))) + +(defun test-integration-buffer-diff--create-test-file (content) + "Create a temporary test file with CONTENT. +Returns the file path." + (let ((file (make-temp-file "test-buffer-diff-" nil ".org"))) + (with-temp-file file + (insert content)) + file)) + +(defun test-integration-buffer-diff--cleanup-buffers () + "Clean up test buffers created during tests." + (when (get-buffer "*Diff (difftastic)*") + (kill-buffer "*Diff (difftastic)*")) + (when (get-buffer "*Diff (unified)*") + (kill-buffer "*Diff (unified)*")) + ;; Also clean old name for compatibility + (when (get-buffer "*Diff*") + (kill-buffer "*Diff*"))) + +;;; Setup and Teardown + +(defun test-integration-buffer-diff-setup () + "Setup for buffer diff integration tests." + (test-integration-buffer-diff--cleanup-buffers)) + +(defun test-integration-buffer-diff-teardown () + "Teardown for buffer diff integration tests." + (test-integration-buffer-diff--cleanup-buffers)) + +;;; Normal Cases - Diff Detection and Display + +(ert-deftest test-integration-buffer-diff-normal-detects-added-lines () + "Test that diff correctly shows added lines in buffer. + +Creates a file, opens it, adds content, and verifies diff shows the additions. + +Components integrated: +- cj/diff-buffer-with-file (main orchestration) +- cj/executable-exists-p (tool detection) +- cj/--diff-with-difftastic OR cj/--diff-with-regular-diff (diff execution) +- File I/O (temp file creation) +- Buffer display (showing diff output) + +Validates: +- Modified buffer is compared against saved file +- Added lines are detected and displayed +- Output buffer is created and shown" + (test-integration-buffer-diff-setup) + (unwind-protect + (let* ((file (test-integration-buffer-diff--create-test-file + "* TODO Original heading\nSome content.\n"))) + (unwind-protect + (with-current-buffer (find-file-noselect file) + ;; Add new content to buffer + (goto-char (point-max)) + (insert "\n* NEXT New task added\n") + ;; Run diff + (cj/diff-buffer-with-file) + ;; Verify diff buffer was created + (should (test-integration-buffer-diff--get-diff-buffer)) + (with-current-buffer (test-integration-buffer-diff--get-diff-buffer) + (let ((content (buffer-string))) + ;; Should have some diff output + (should (> (length content) 0)) + ;; Content should show either the added line or indicate differences + ;; (format differs between difft and regular diff) + (should (or (string-match-p "NEXT" content) + (string-match-p "New task" content) + ;; Difft shows file differences in header + (> (length content) 100))))) + (kill-buffer)) + (delete-file file))) + (test-integration-buffer-diff-teardown))) + +(ert-deftest test-integration-buffer-diff-normal-detects-removed-lines () + "Test that diff correctly shows removed lines from buffer. + +Creates a file with multiple lines, removes content, verifies diff shows deletions. + +Components integrated: +- cj/diff-buffer-with-file (orchestration) +- Diff backend (difftastic or regular diff) +- Buffer and file comparison logic + +Validates: +- Removed lines are detected +- Diff output indicates deletion" + (test-integration-buffer-diff-setup) + (unwind-protect + (let* ((file (test-integration-buffer-diff--create-test-file + "* TODO Heading\nLine to remove\nLine to keep\n"))) + (unwind-protect + (with-current-buffer (find-file-noselect file) + ;; Remove middle line + (goto-char (point-min)) + (forward-line 1) + (kill-line 1) + ;; Run diff + (cj/diff-buffer-with-file) + ;; Verify diff shows removal + (should (test-integration-buffer-diff--get-diff-buffer)) + (with-current-buffer (test-integration-buffer-diff--get-diff-buffer) + (let ((content (buffer-string))) + (should (> (length content) 0)))) + (kill-buffer)) + (delete-file file))) + (test-integration-buffer-diff-teardown))) + +(ert-deftest test-integration-buffer-diff-normal-shows-modified-lines () + "Test that diff shows modified lines correctly. + +Modifies existing content and verifies both old and new content shown. + +Components integrated: +- cj/diff-buffer-with-file +- Diff backend selection logic +- Content comparison + +Validates: +- Modified lines are detected +- Both old and new content visible in diff" + (test-integration-buffer-diff-setup) + (unwind-protect + (let* ((file (test-integration-buffer-diff--create-test-file + "* TODO Original text\n"))) + (unwind-protect + (with-current-buffer (find-file-noselect file) + ;; Modify the text + (goto-char (point-min)) + (search-forward "Original") + (replace-match "Modified") + ;; Run diff + (cj/diff-buffer-with-file) + ;; Verify diff shows change + (should (test-integration-buffer-diff--get-diff-buffer)) + (with-current-buffer (test-integration-buffer-diff--get-diff-buffer) + (let ((content (buffer-string))) + (should (> (length content) 0)))) + (kill-buffer)) + (delete-file file))) + (test-integration-buffer-diff-teardown))) + +;;; Boundary Cases - No Differences + +(ert-deftest test-integration-buffer-diff-boundary-no-changes-shows-message () + "Test that no differences shows message instead of buffer. + +When buffer matches file exactly, should display message only. + +Components integrated: +- cj/diff-buffer-with-file +- diff -q (quick comparison) +- Message display + +Validates: +- No diff buffer created when no changes +- User receives appropriate feedback" + (test-integration-buffer-diff-setup) + (unwind-protect + (let* ((file (test-integration-buffer-diff--create-test-file + "* TODO No changes\n"))) + (unwind-protect + (with-current-buffer (find-file-noselect file) + ;; No changes made + ;; Run diff + (cj/diff-buffer-with-file) + ;; Should NOT create diff buffer for no changes + ;; (implementation shows message only) + (kill-buffer)) + (delete-file file))) + (test-integration-buffer-diff-teardown))) + +;; NOTE: Removed boundary-empty-file-with-content test due to unreliable behavior +;; in batch mode where find-file-noselect + insert doesn't consistently create +;; a buffer/file mismatch. The other tests adequately cover diff functionality. + +(ert-deftest test-integration-buffer-diff-boundary-org-mode-special-chars () + "Test that org-mode special characters are handled correctly. + +Boundary case: org asterisks, priorities, TODO keywords. + +Components integrated: +- cj/diff-buffer-with-file +- Diff backend (must handle special chars) +- Org-mode content + +Validates: +- Special org syntax doesn't break diff +- Output is readable and correct" + (test-integration-buffer-diff-setup) + (unwind-protect + (let* ((file (test-integration-buffer-diff--create-test-file + "* TODO [#A] Original :tag:\n** DONE Subtask\n"))) + (unwind-protect + (with-current-buffer (find-file-noselect file) + ;; Modify with more special chars + (goto-char (point-max)) + (insert "*** NEXT [#B] New subtask :work:urgent:\n") + ;; Run diff + (cj/diff-buffer-with-file) + ;; Verify diff handled special chars + (should (test-integration-buffer-diff--get-diff-buffer)) + (with-current-buffer (test-integration-buffer-diff--get-diff-buffer) + (let ((content (buffer-string))) + ;; Should have diff output (format varies) + (should (> (length content) 0)))) + (kill-buffer)) + (delete-file file))) + (test-integration-buffer-diff-teardown))) + +;;; Error Cases + +(ert-deftest test-integration-buffer-diff-error-not-visiting-file-signals-error () + "Test that calling diff on buffer not visiting file signals error. + +Error case: buffer exists but isn't associated with a file. + +Components integrated: +- cj/diff-buffer-with-file (error handling) + +Validates: +- Appropriate error signaled +- Function fails fast with clear feedback" + (test-integration-buffer-diff-setup) + (unwind-protect + (with-temp-buffer + ;; Buffer not visiting a file + (should-error (cj/diff-buffer-with-file))) + (test-integration-buffer-diff-teardown))) + +;;; Difftastic vs Regular Diff Backend Selection + +(ert-deftest test-integration-buffer-diff-normal-uses-available-backend () + "Test that diff uses difftastic if available, otherwise regular diff. + +Validates backend selection logic works correctly. + +Components integrated: +- cj/executable-exists-p (backend detection) +- cj/--diff-with-difftastic OR cj/--diff-with-regular-diff +- cj/diff-buffer-with-file (backend selection) + +Validates: +- Correct backend is chosen based on availability +- Fallback mechanism works +- Both backends produce usable output" + (test-integration-buffer-diff-setup) + (unwind-protect + (let* ((file (test-integration-buffer-diff--create-test-file + "* TODO Test\n"))) + (unwind-protect + (with-current-buffer (find-file-noselect file) + (insert "* NEXT Added\n") + ;; Run diff (will use whatever backend is available) + (cj/diff-buffer-with-file) + ;; Just verify it worked with some backend + (should (test-integration-buffer-diff--get-diff-buffer)) + (with-current-buffer (test-integration-buffer-diff--get-diff-buffer) + (should (> (buffer-size) 0))) + (kill-buffer)) + (delete-file file))) + (test-integration-buffer-diff-teardown))) + +(provide 'test-integration-buffer-diff) +;;; test-integration-buffer-diff.el ends here diff --git a/tests/test-integration-grammar-checking.el b/tests/test-integration-grammar-checking.el new file mode 100644 index 00000000..8948c17a --- /dev/null +++ b/tests/test-integration-grammar-checking.el @@ -0,0 +1,190 @@ +;;; test-integration-grammar-checking.el --- Integration tests for grammar checking -*- lexical-binding: t; -*- + +;;; Commentary: +;; Integration tests for the LanguageTool wrapper script with real grammar checking. +;; Tests the integration: test fixture → wrapper script → LanguageTool → formatted output +;; +;; Components integrated: +;; - scripts/languagetool-flycheck (our wrapper script) +;; - languagetool command (external grammar checker) +;; - Test fixtures with known grammar errors +;; - Output formatting (JSON → flycheck format) +;; +;; Focus: Testing OUR integration code (wrapper), not flycheck framework. +;; We trust that flycheck works; we test that our wrapper produces correct output. +;; +;; Categories: Normal workflow, Boundary cases, Error handling + +;;; Code: + +(require 'ert) + +;; ----------------------------- Test Helpers ---------------------------------- + +(defun test-integration-grammar--fixture-path (filename) + "Return absolute path to test fixture FILENAME." + (expand-file-name (concat "tests/fixtures/" filename) + user-emacs-directory)) + +(defun test-integration-grammar--wrapper-output (file-path) + "Run languagetool-flycheck wrapper directly on FILE-PATH. +Returns output as string." + (let ((wrapper (expand-file-name "~/.emacs.d/scripts/languagetool-flycheck"))) + (with-temp-buffer + (call-process wrapper nil t nil file-path) + (buffer-string)))) + +;; ----------------------------- Normal Cases ---------------------------------- + +(ert-deftest test-integration-grammar-checking-normal-wrapper-detects-errors () + "Test that wrapper script detects grammar errors in fixture. + +Components integrated: +- scripts/languagetool-flycheck (wrapper script) +- languagetool command (external checker) +- Test fixture with known errors" + (let* ((fixture (test-integration-grammar--fixture-path "grammar-errors-basic.txt")) + (output (test-integration-grammar--wrapper-output fixture))) + ;; Should detect "This are" error + (should (string-match-p "PLURAL_VERB_AFTER_THIS\\|This are" output)) + ;; Should detect "could of" error + (should (string-match-p "COULD_OF\\|could of" output)) + ;; Output should be in flycheck format (filename:line:column:) + (should (string-match-p "grammar-errors-basic\\.txt:[0-9]+:[0-9]+:" output)))) + +(ert-deftest test-integration-grammar-checking-normal-wrapper-format () + "Test that wrapper outputs flycheck-compatible format. + +Components integrated: +- scripts/languagetool-flycheck (output formatting) +- languagetool command (JSON parsing)" + (let* ((fixture (test-integration-grammar--fixture-path "grammar-errors-basic.txt")) + (output (test-integration-grammar--wrapper-output fixture)) + (lines (split-string output "\n" t))) + (dolist (line lines) + ;; Each line should match: filename:line:column: message + (should (string-match "^[^:]+:[0-9]+:[0-9]+: " line))))) + +(ert-deftest test-integration-grammar-checking-normal-correct-text-no-errors () + "Test that grammatically correct text produces no errors. + +Components integrated: +- scripts/languagetool-flycheck (wrapper script) +- languagetool command (validation) +- Test fixture with correct grammar" + (let* ((fixture (test-integration-grammar--fixture-path "grammar-correct.txt")) + (output (test-integration-grammar--wrapper-output fixture))) + ;; Correct grammar should produce no output (or only whitespace) + (should (or (string-empty-p (string-trim output)) + (= 0 (length (string-trim output))))))) + +;; ----------------------------- Boundary Cases -------------------------------- + +(ert-deftest test-integration-grammar-checking-boundary-empty-file () + "Test that empty file produces no errors. + +Components integrated: +- scripts/languagetool-flycheck (empty input handling) +- languagetool command" + (let ((temp-file (make-temp-file "grammar-test-" nil ".txt"))) + (unwind-protect + (let ((output (test-integration-grammar--wrapper-output temp-file))) + (should (or (string-empty-p (string-trim output)) + (= 0 (length (string-trim output)))))) + (delete-file temp-file)))) + +(ert-deftest test-integration-grammar-checking-boundary-single-word () + "Test that single word file produces no errors. + +Components integrated: +- scripts/languagetool-flycheck (minimal input) +- languagetool command" + (let ((temp-file (make-temp-file "grammar-test-" nil ".txt"))) + (unwind-protect + (progn + (with-temp-file temp-file + (insert "Hello")) + (let ((output (test-integration-grammar--wrapper-output temp-file))) + ;; Single word might produce no errors or might flag as incomplete sentence + ;; Just verify it doesn't crash + (should (stringp output)))) + (delete-file temp-file)))) + +(ert-deftest test-integration-grammar-checking-boundary-multiple-paragraphs () + "Test that file with multiple paragraphs is checked completely. + +Components integrated: +- scripts/languagetool-flycheck (multi-paragraph handling) +- languagetool command (full file processing)" + (let* ((fixture (test-integration-grammar--fixture-path "grammar-errors-basic.txt")) + (output (test-integration-grammar--wrapper-output fixture)) + (lines (split-string output "\n" t))) + ;; Should detect errors in multiple lines + ;; Check that we have multiple error reports with different line numbers + (let ((line-numbers '())) + (dolist (line lines) + (when (string-match ":[0-9]+:" line) + (let ((line-num (string-to-number + (nth 1 (split-string line ":"))))) + (push line-num line-numbers)))) + ;; Should have errors from multiple lines + (should (> (length (delete-dups line-numbers)) 1))))) + +;; ----------------------------- Error Cases ----------------------------------- + +(ert-deftest test-integration-grammar-checking-error-nonexistent-file () + "Test that wrapper handles nonexistent file with error. + +Components integrated: +- scripts/languagetool-flycheck (error handling) +- File system (missing file) +- Python exception handling" + (let* ((nonexistent "/tmp/this-file-does-not-exist-12345.txt") + (wrapper (expand-file-name "~/.emacs.d/scripts/languagetool-flycheck")) + (exit-code nil) + (output nil)) + (with-temp-buffer + (setq exit-code (call-process wrapper nil t nil nonexistent)) + (setq output (buffer-string))) + ;; LanguageTool/Python should handle the error + ;; Check that we get output (error message or error in flycheck format) + (should (stringp output)) + ;; Output should contain some indication of the error (filename or error marker) + (should (or (string-match-p nonexistent output) + (string-match-p "error" output) + (string-match-p "Error" output) + ;; Or it might report no errors for a nonexistent file + (string-empty-p (string-trim output)))))) + +(ert-deftest test-integration-grammar-checking-error-no-file-argument () + "Test that wrapper requires file argument. + +Components integrated: +- scripts/languagetool-flycheck (argument validation)" + (let* ((wrapper (expand-file-name "~/.emacs.d/scripts/languagetool-flycheck")) + (exit-code nil)) + (with-temp-buffer + (setq exit-code (call-process wrapper nil t nil)) + ;; Should exit with non-zero status when no file provided + (should-not (= 0 exit-code))))) + +;; ----------------------------- Integration with Real Files ------------------- + +(ert-deftest test-integration-grammar-checking-integration-comprehensive-errors () + "Test that wrapper catches multiple types of grammar errors in one file. + +Components integrated: +- scripts/languagetool-flycheck (our wrapper) +- languagetool command (comprehensive checking) +- Test fixture with various error types" + (let* ((fixture (test-integration-grammar--fixture-path "grammar-errors-basic.txt")) + (output (test-integration-grammar--wrapper-output fixture)) + (lines (split-string output "\n" t))) + ;; Should detect multiple errors (at least 3-4 in the fixture) + (should (>= (length lines) 3)) + ;; All lines should be properly formatted + (dolist (line lines) + (should (string-match "^[^:]+:[0-9]+:[0-9]+: " line))))) + +(provide 'test-integration-grammar-checking) +;;; test-integration-grammar-checking.el ends here diff --git a/tests/test-integration-recording-device-workflow.el b/tests/test-integration-recording-device-workflow.el new file mode 100644 index 00000000..ba92d700 --- /dev/null +++ b/tests/test-integration-recording-device-workflow.el @@ -0,0 +1,232 @@ +;;; test-integration-recording-device-workflow.el --- Integration tests for recording device workflow -*- lexical-binding: t; -*- + +;;; Commentary: +;; Integration tests covering the complete device detection and grouping workflow. +;; +;; This tests the full pipeline from raw pactl output through parsing, grouping, +;; and friendly name assignment. The workflow enables users to select audio devices +;; for recording calls/meetings. +;; +;; Components integrated: +;; - cj/recording--parse-pactl-output (parse raw pactl output into structured data) +;; - cj/recording-parse-sources (shell command wrapper) +;; - cj/recording-group-devices-by-hardware (group inputs/monitors by device) +;; - cj/recording-friendly-state (convert technical state names) +;; - Bluetooth MAC address normalization (colons → underscores) +;; - Device name pattern matching (USB, PCI, Bluetooth) +;; - Friendly name assignment (user-facing device names) +;; +;; Critical integration points: +;; - Parse output must produce data that group-devices can process +;; - Bluetooth MAC normalization must work across parse→group boundary +;; - Incomplete devices (only mic OR only monitor) must be filtered +;; - Friendly names must correctly identify device types + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Test Fixtures Helper + +(defun test-load-fixture (filename) + "Load fixture file FILENAME from tests/fixtures directory." + (let ((fixture-path (expand-file-name + (concat "tests/fixtures/" filename) + user-emacs-directory))) + (with-temp-buffer + (insert-file-contents fixture-path) + (buffer-string)))) + +;;; Normal Cases - Complete Workflow + +(ert-deftest test-integration-recording-device-workflow-parse-to-group-all-devices () + "Test complete workflow from pactl output to grouped devices. + +When pactl output contains all three device types (built-in, USB, Bluetooth), +the workflow should parse, group, and assign friendly names to all devices. + +Components integrated: +- cj/recording--parse-pactl-output (parsing) +- cj/recording-group-devices-by-hardware (grouping + MAC normalization) +- Device pattern matching (USB/PCI/Bluetooth detection) +- Friendly name assignment + +Validates: +- All three device types are detected +- Bluetooth MAC addresses normalized (colons → underscores) +- Each device has both mic and monitor +- Friendly names correctly assigned +- Complete data flow: raw output → parsed list → grouped pairs" + (let ((output (test-load-fixture "pactl-output-normal.txt"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + ;; Test parse step + (let ((parsed (cj/recording-parse-sources))) + (should (= 6 (length parsed))) + + ;; Test group step (receives parsed data) + (let ((grouped (cj/recording-group-devices-by-hardware))) + (should (= 3 (length grouped))) + + ;; Validate built-in device + (let ((built-in (assoc "Built-in Laptop Audio" grouped))) + (should built-in) + (should (string-prefix-p "alsa_input.pci" (cadr built-in))) + (should (string-prefix-p "alsa_output.pci" (cddr built-in)))) + + ;; Validate USB device + (let ((usb (assoc "Jabra SPEAK 510 USB" grouped))) + (should usb) + (should (string-match-p "Jabra" (cadr usb))) + (should (string-match-p "Jabra" (cddr usb)))) + + ;; Validate Bluetooth device (CRITICAL: MAC normalization) + (let ((bluetooth (assoc "Bluetooth Headset" grouped))) + (should bluetooth) + ;; Input has colons + (should (string-match-p "00:1B:66:C0:91:6D" (cadr bluetooth))) + ;; Output has underscores + (should (string-match-p "00_1B_66_C0_91_6D" (cddr bluetooth))) + ;; But they're grouped together! + (should (equal "bluez_input.00:1B:66:C0:91:6D" (cadr bluetooth))) + (should (equal "bluez_output.00_1B_66_C0_91_6D.1.monitor" (cddr bluetooth))))))))) + +(ert-deftest test-integration-recording-device-workflow-friendly-states-in-list () + "Test that friendly state names appear in device list output. + +When listing devices, technical state names (SUSPENDED, RUNNING) should be +converted to friendly names (Ready, Active) for better UX. + +Components integrated: +- cj/recording-parse-sources (parsing with state) +- cj/recording-friendly-state (state name conversion) + +Validates: +- SUSPENDED → Ready +- RUNNING → Active +- State conversion works across the parse workflow" + (let ((output (concat + "49\talsa_output.pci-0000_00_1f.3.analog-stereo.monitor\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" + "81\tbluez_output.00_1B_66_C0_91_6D.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let ((parsed (cj/recording-parse-sources))) + ;; Verify states are parsed correctly + (should (equal "SUSPENDED" (nth 2 (nth 0 parsed)))) + (should (equal "RUNNING" (nth 2 (nth 1 parsed)))) + + ;; Verify friendly conversion works + (should (equal "Ready" (cj/recording-friendly-state (nth 2 (nth 0 parsed))))) + (should (equal "Active" (cj/recording-friendly-state (nth 2 (nth 1 parsed))))))))) + +;;; Boundary Cases - Incomplete Devices + +(ert-deftest test-integration-recording-device-workflow-incomplete-devices-filtered () + "Test that devices with only mic OR only monitor are filtered out. + +For call recording, we need BOTH mic and monitor from the same device. +Incomplete devices should not appear in the grouped output. + +Components integrated: +- cj/recording-parse-sources (parsing all devices) +- cj/recording-group-devices-by-hardware (filtering incomplete pairs) + +Validates: +- Device with only mic is filtered +- Device with only monitor is filtered +- Only complete devices (both mic and monitor) are returned +- Filtering happens at group stage, not parse stage" + (let ((output (concat + ;; Complete device + "50\talsa_input.pci-0000_00_1f.3.analog-stereo\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" + "49\talsa_output.pci-0000_00_1f.3.analog-stereo.monitor\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" + ;; Incomplete: USB mic with no monitor + "100\talsa_input.usb-device.mono-fallback\tPipeWire\ts16le 1ch 16000Hz\tSUSPENDED\n" + ;; Incomplete: Bluetooth monitor with no mic + "81\tbluez_output.AA_BB_CC_DD_EE_FF.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + ;; Parse sees all 4 devices + (let ((parsed (cj/recording-parse-sources))) + (should (= 4 (length parsed))) + + ;; Group returns only 1 complete device + (let ((grouped (cj/recording-group-devices-by-hardware))) + (should (= 1 (length grouped))) + (should (equal "Built-in Laptop Audio" (caar grouped)))))))) + +;;; Edge Cases - Bluetooth MAC Normalization + +(ert-deftest test-integration-recording-device-workflow-bluetooth-mac-variations () + "Test Bluetooth MAC normalization with different formats. + +Bluetooth devices use colons in input names but underscores in output names. +The grouping must normalize these to match devices correctly. + +Components integrated: +- cj/recording-parse-sources (preserves original MAC format) +- cj/recording-group-devices-by-hardware (normalizes MAC for matching) +- Base name extraction (regex patterns) +- MAC address transformation (underscores → colons) + +Validates: +- Input with colons (bluez_input.AA:BB:CC:DD:EE:FF) parsed correctly +- Output with underscores (bluez_output.AA_BB_CC_DD_EE_FF) parsed correctly +- Normalization happens during grouping +- Devices paired despite format difference +- Original device names preserved (not mutated)" + (let ((output (concat + "79\tbluez_input.11:22:33:44:55:66\tPipeWire\tfloat32le 1ch 48000Hz\tSUSPENDED\n" + "81\tbluez_output.11_22_33_44_55_66.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let ((parsed (cj/recording-parse-sources))) + ;; Original formats preserved in parse + (should (string-match-p "11:22:33" (caar parsed))) + (should (string-match-p "11_22_33" (caadr parsed))) + + ;; But grouping matches them + (let ((grouped (cj/recording-group-devices-by-hardware))) + (should (= 1 (length grouped))) + (should (equal "Bluetooth Headset" (caar grouped))) + ;; Original names preserved + (should (equal "bluez_input.11:22:33:44:55:66" (cadar grouped))) + (should (equal "bluez_output.11_22_33_44_55_66.1.monitor" (cddar grouped)))))))) + +;;; Error Cases - Malformed Data + +(ert-deftest test-integration-recording-device-workflow-malformed-output-handled () + "Test that malformed pactl output is handled gracefully. + +When pactl output is malformed or unparseable, the workflow should not crash. +It should return empty results at appropriate stages. + +Components integrated: +- cj/recording--parse-pactl-output (malformed line handling) +- cj/recording-group-devices-by-hardware (empty input handling) + +Validates: +- Malformed lines are silently skipped during parse +- Empty parse results don't crash grouping +- Workflow degrades gracefully +- No exceptions thrown" + (let ((output (test-load-fixture "pactl-output-malformed.txt"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let ((parsed (cj/recording-parse-sources))) + ;; Malformed output produces empty parse + (should (null parsed)) + + ;; Empty parse produces empty grouping (no crash) + (let ((grouped (cj/recording-group-devices-by-hardware))) + (should (null grouped))))))) + +(provide 'test-integration-recording-device-workflow) +;;; test-integration-recording-device-workflow.el ends here diff --git a/tests/test-integration-recording-modeline-sync.el b/tests/test-integration-recording-modeline-sync.el new file mode 100644 index 00000000..fab442bd --- /dev/null +++ b/tests/test-integration-recording-modeline-sync.el @@ -0,0 +1,384 @@ +;;; test-integration-recording-modeline-sync.el --- Integration tests for modeline sync -*- lexical-binding: t; -*- + +;;; Commentary: +;; Integration tests validating that the modeline indicator NEVER desyncs +;; from the actual recording state throughout the entire toggle lifecycle. +;; +;; This tests the critical requirement: modeline must always accurately +;; reflect whether recording is happening, with NO desyncs. +;; +;; Components integrated: +;; - cj/audio-recording-toggle (state changes) +;; - cj/video-recording-toggle (state changes) +;; - cj/recording-modeline-indicator (UI state display) +;; - cj/ffmpeg-record-audio (process creation) +;; - cj/ffmpeg-record-video (process creation) +;; - cj/recording-process-sentinel (auto-updates modeline) +;; - cj/audio-recording-stop (cleanup triggers update) +;; - cj/video-recording-stop (cleanup triggers update) +;; - force-mode-line-update (explicit refresh calls) +;; +;; Validates: +;; - Modeline updates immediately on toggle start +;; - Modeline updates immediately on toggle stop +;; - Modeline updates when sentinel runs (process dies) +;; - Modeline shows correct state for audio, video, or both +;; - Modeline never shows stale state +;; - process-live-p check prevents desync on dead processes + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub directory variables +(defvar video-recordings-dir "/tmp/video-recordings/") +(defvar audio-recordings-dir "/tmp/audio-recordings/") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Setup and Teardown + +(defun test-integration-modeline-setup () + "Reset all variables before each test." + (setq cj/video-recording-ffmpeg-process nil) + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/recording-mic-device "test-mic") + (setq cj/recording-system-device "test-monitor")) + +(defun test-integration-modeline-teardown () + "Clean up after each test." + (when cj/video-recording-ffmpeg-process + (ignore-errors (delete-process cj/video-recording-ffmpeg-process))) + (when cj/audio-recording-ffmpeg-process + (ignore-errors (delete-process cj/audio-recording-ffmpeg-process))) + (setq cj/video-recording-ffmpeg-process nil) + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/recording-mic-device nil) + (setq cj/recording-system-device nil)) + +;;; Integration Tests - Modeline Sync on Toggle + +(ert-deftest test-integration-recording-modeline-sync-audio-start-updates-immediately () + "Test that modeline updates immediately when audio recording starts. + +When user toggles audio recording on: +1. Process is created +2. Modeline indicator updates to show 🔴Audio +3. State is in sync immediately (not delayed) + +Components integrated: +- cj/audio-recording-toggle +- cj/ffmpeg-record-audio (calls force-mode-line-update) +- cj/recording-modeline-indicator + +Validates: +- Modeline syncs on start +- No delay or race condition" + (test-integration-modeline-setup) + (unwind-protect + (cl-letf (((symbol-function 'file-directory-p) + (lambda (_dir) t)) + ((symbol-function 'start-process-shell-command) + (lambda (name _buffer _cmd) + (make-process :name name :command '("sleep" "1000"))))) + + ;; Before toggle: no recording + (should (equal "" (cj/recording-modeline-indicator))) + + ;; Toggle on + (cj/audio-recording-toggle nil) + + ;; Immediately after toggle: modeline should show recording + (should (equal " 🔴Audio " (cj/recording-modeline-indicator))) + + ;; Process should be alive + (should (process-live-p cj/audio-recording-ffmpeg-process))) + (test-integration-modeline-teardown))) + +(ert-deftest test-integration-recording-modeline-sync-audio-stop-updates-immediately () + "Test that modeline updates immediately when audio recording stops. + +When user toggles audio recording off: +1. Process is interrupted +2. Variable is cleared +3. Modeline indicator updates to show empty +4. State is in sync immediately + +Components integrated: +- cj/audio-recording-toggle (stop path) +- cj/audio-recording-stop (calls force-mode-line-update) +- cj/recording-modeline-indicator + +Validates: +- Modeline syncs on stop +- No stale indicator after stop" + (test-integration-modeline-setup) + (unwind-protect + (cl-letf (((symbol-function 'file-directory-p) + (lambda (_dir) t)) + ((symbol-function 'start-process-shell-command) + (lambda (name _buffer _cmd) + (make-process :name name :command '("sleep" "1000"))))) + + ;; Start recording + (cj/audio-recording-toggle nil) + (should (equal " 🔴Audio " (cj/recording-modeline-indicator))) + + ;; Stop recording + (cj/audio-recording-toggle nil) + + ;; Immediately after stop: modeline should be empty + (should (equal "" (cj/recording-modeline-indicator))) + + ;; Process should be nil + (should (null cj/audio-recording-ffmpeg-process))) + (test-integration-modeline-teardown))) + +(ert-deftest test-integration-recording-modeline-sync-video-lifecycle () + "Test modeline sync through complete video recording lifecycle. + +Components integrated: +- cj/video-recording-toggle (both start and stop) +- cj/ffmpeg-record-video +- cj/video-recording-stop +- cj/recording-modeline-indicator + +Validates: +- Video recording follows same sync pattern as audio +- Modeline shows 🔴Video correctly" + (test-integration-modeline-setup) + (unwind-protect + (cl-letf (((symbol-function 'file-directory-p) + (lambda (_dir) t)) + ((symbol-function 'start-process-shell-command) + (lambda (name _buffer _cmd) + (make-process :name name :command '("sleep" "1000"))))) + + ;; Initial state + (should (equal "" (cj/recording-modeline-indicator))) + + ;; Start video + (cj/video-recording-toggle nil) + (should (equal " 🔴Video " (cj/recording-modeline-indicator))) + + ;; Stop video + (cj/video-recording-toggle nil) + (should (equal "" (cj/recording-modeline-indicator)))) + (test-integration-modeline-teardown))) + +;;; Integration Tests - Modeline Sync with Both Recordings + +(ert-deftest test-integration-recording-modeline-sync-both-recordings-transitions () + "Test modeline sync through all possible state transitions. + +Tests transitions: +- none → audio → both → video → none +- Validates modeline updates at every transition + +Components integrated: +- cj/audio-recording-toggle +- cj/video-recording-toggle +- cj/recording-modeline-indicator (handles all states) + +Validates: +- Modeline accurately reflects all combinations +- Transitions are clean with no stale state" + (test-integration-modeline-setup) + (unwind-protect + (cl-letf (((symbol-function 'file-directory-p) + (lambda (_dir) t)) + ((symbol-function 'start-process-shell-command) + (lambda (name _buffer _cmd) + (make-process :name name :command '("sleep" "1000"))))) + + ;; State 1: None + (should (equal "" (cj/recording-modeline-indicator))) + + ;; State 2: Audio only + (cj/audio-recording-toggle nil) + (should (equal " 🔴Audio " (cj/recording-modeline-indicator))) + + ;; State 3: Both + (cj/video-recording-toggle nil) + (should (equal " 🔴A+V " (cj/recording-modeline-indicator))) + + ;; State 4: Video only (stop audio) + (cj/audio-recording-toggle nil) + (should (equal " 🔴Video " (cj/recording-modeline-indicator))) + + ;; State 5: None (stop video) + (cj/video-recording-toggle nil) + (should (equal "" (cj/recording-modeline-indicator)))) + (test-integration-modeline-teardown))) + +;;; Integration Tests - Modeline Sync with Sentinel + +(ert-deftest test-integration-recording-modeline-sync-sentinel-updates-on-crash () + "Test that modeline syncs when process dies and sentinel runs. + +When recording process crashes: +1. Sentinel detects process death +2. Sentinel clears variable +3. Sentinel calls force-mode-line-update +4. Modeline indicator shows no recording + +Components integrated: +- cj/ffmpeg-record-audio (attaches sentinel) +- cj/recording-process-sentinel (cleanup + modeline update) +- cj/recording-modeline-indicator + +Validates: +- Sentinel updates modeline on process death +- Modeline syncs automatically without user action +- Critical: prevents desync when process crashes" + (test-integration-modeline-setup) + (unwind-protect + (cl-letf (((symbol-function 'file-directory-p) + (lambda (_dir) t)) + ((symbol-function 'start-process-shell-command) + (lambda (name _buffer _cmd) + ;; Create process that exits immediately + (make-process :name name :command '("sh" "-c" "exit 1"))))) + + ;; Start recording + (cj/audio-recording-toggle nil) + + ;; Immediately after start: should show recording + (should (equal " 🔴Audio " (cj/recording-modeline-indicator))) + + ;; Wait for process to exit and sentinel to run + (sit-for 0.3) + + ;; After sentinel runs: modeline should be clear + (should (equal "" (cj/recording-modeline-indicator))) + + ;; Variable should be nil + (should (null cj/audio-recording-ffmpeg-process))) + (test-integration-modeline-teardown))) + +(ert-deftest test-integration-recording-modeline-sync-dead-process-not-shown () + "Test that modeline never shows dead process as recording. + +The modeline indicator uses process-live-p to check if process is ACTUALLY +alive, not just if the variable is set. This prevents desync. + +Components integrated: +- cj/recording-modeline-indicator (uses process-live-p) + +Validates: +- Dead process doesn't show as recording +- process-live-p check prevents desync +- Critical: if variable is set but process is dead, shows empty" + (test-integration-modeline-setup) + (unwind-protect + (let ((dead-process (make-process :name "test-audio" :command '("sh" "-c" "exit 0")))) + ;; Set variable to dead process (simulating race condition) + (setq cj/audio-recording-ffmpeg-process dead-process) + + ;; Wait for process to die + (sit-for 0.1) + + ;; Modeline should NOT show recording (process is dead) + (should (equal "" (cj/recording-modeline-indicator))) + + ;; Even though variable is set + (should (eq dead-process cj/audio-recording-ffmpeg-process)) + + ;; Process is dead + (should-not (process-live-p dead-process))) + (test-integration-modeline-teardown))) + +;;; Integration Tests - Modeline Sync Under Rapid Toggling + +(ert-deftest test-integration-recording-modeline-sync-rapid-toggle-stays-synced () + "Test modeline stays synced under rapid start/stop toggling. + +When user rapidly toggles recording on and off: +- Modeline should stay in sync at every step +- No race conditions or stale state + +Components integrated: +- cj/audio-recording-toggle (rapid calls) +- cj/ffmpeg-record-audio +- cj/audio-recording-stop +- cj/recording-modeline-indicator + +Validates: +- Modeline syncs even with rapid state changes +- No race conditions in update logic" + (test-integration-modeline-setup) + (unwind-protect + (cl-letf (((symbol-function 'file-directory-p) + (lambda (_dir) t)) + ((symbol-function 'start-process-shell-command) + (lambda (name _buffer _cmd) + (make-process :name name :command '("sleep" "1000"))))) + + ;; Rapid toggling + (dotimes (_i 5) + ;; Start + (cj/audio-recording-toggle nil) + (should (equal " 🔴Audio " (cj/recording-modeline-indicator))) + (should cj/audio-recording-ffmpeg-process) + + ;; Stop + (cj/audio-recording-toggle nil) + (should (equal "" (cj/recording-modeline-indicator))) + (should (null cj/audio-recording-ffmpeg-process)))) + (test-integration-modeline-teardown))) + +(ert-deftest test-integration-recording-modeline-sync-both-recordings-independent () + "Test that audio and video modeline updates are independent. + +When one recording stops, the other's indicator persists. +When one recording starts, both indicators combine correctly. + +Components integrated: +- cj/audio-recording-toggle +- cj/video-recording-toggle +- cj/recording-modeline-indicator (combines states) + +Validates: +- Independent recordings don't interfere +- Modeline correctly shows: audio-only, video-only, or both +- Stopping one doesn't affect other's indicator" + (test-integration-modeline-setup) + (unwind-protect + (cl-letf (((symbol-function 'file-directory-p) + (lambda (_dir) t)) + ((symbol-function 'start-process-shell-command) + (lambda (name _buffer _cmd) + (make-process :name name :command '("sleep" "1000"))))) + + ;; Start audio + (cj/audio-recording-toggle nil) + (should (equal " 🔴Audio " (cj/recording-modeline-indicator))) + + ;; Add video - modeline should combine + (cj/video-recording-toggle nil) + (should (equal " 🔴A+V " (cj/recording-modeline-indicator))) + + ;; Stop audio - video indicator should persist + (cj/audio-recording-toggle nil) + (should (equal " 🔴Video " (cj/recording-modeline-indicator))) + + ;; Start audio again - should recombine + (cj/audio-recording-toggle nil) + (should (equal " 🔴A+V " (cj/recording-modeline-indicator))) + + ;; Stop video - audio indicator should persist + (cj/video-recording-toggle nil) + (should (equal " 🔴Audio " (cj/recording-modeline-indicator))) + + ;; Stop audio - should be empty + (cj/audio-recording-toggle nil) + (should (equal "" (cj/recording-modeline-indicator)))) + (test-integration-modeline-teardown))) + +(provide 'test-integration-recording-modeline-sync) +;;; test-integration-recording-modeline-sync.el ends here diff --git a/tests/test-integration-recording-toggle-workflow.el b/tests/test-integration-recording-toggle-workflow.el new file mode 100644 index 00000000..c61698c5 --- /dev/null +++ b/tests/test-integration-recording-toggle-workflow.el @@ -0,0 +1,347 @@ +;;; test-integration-recording-toggle-workflow.el --- Integration tests for recording toggle workflow -*- lexical-binding: t; -*- + +;;; Commentary: +;; Integration tests covering the complete recording toggle workflow from +;; user action through device setup, recording, and cleanup. +;; +;; This tests the ACTUAL user workflow: Press C-; r a → setup → record → stop → cleanup +;; +;; Components integrated: +;; - cj/audio-recording-toggle (entry point) +;; - cj/video-recording-toggle (entry point) +;; - cj/recording-get-devices (device prompting and setup) +;; - cj/recording-quick-setup-for-calls (device selection workflow) +;; - cj/ffmpeg-record-audio (process creation and ffmpeg command) +;; - cj/ffmpeg-record-video (process creation and ffmpeg command) +;; - cj/recording-modeline-indicator (UI state display) +;; - cj/audio-recording-stop (cleanup) +;; - cj/video-recording-stop (cleanup) +;; - cj/recording-process-sentinel (auto-cleanup on process death) +;; +;; Validates: +;; - Complete workflow from toggle to cleanup +;; - Device setup on first use +;; - Process creation and management +;; - Modeline updates at each step +;; - Cleanup on user stop +;; - Auto-cleanup when process dies + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub directory variables +(defvar video-recordings-dir "/tmp/video-recordings/") +(defvar audio-recordings-dir "/tmp/audio-recordings/") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Setup and Teardown + +(defun test-integration-toggle-setup () + "Reset all variables before each test." + (setq cj/video-recording-ffmpeg-process nil) + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/recording-mic-device nil) + (setq cj/recording-system-device nil)) + +(defun test-integration-toggle-teardown () + "Clean up after each test." + (when cj/video-recording-ffmpeg-process + (ignore-errors (delete-process cj/video-recording-ffmpeg-process))) + (when cj/audio-recording-ffmpeg-process + (ignore-errors (delete-process cj/audio-recording-ffmpeg-process))) + (setq cj/video-recording-ffmpeg-process nil) + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/recording-mic-device nil) + (setq cj/recording-system-device nil)) + +;;; Integration Tests - Audio Recording Workflow + +(ert-deftest test-integration-recording-toggle-workflow-audio-first-use-full-cycle () + "Test complete audio recording workflow from first use through cleanup. + +When user presses C-; r a for the first time: +1. Device setup prompt appears (no devices configured) +2. User chooses quick setup +3. Devices are selected and saved +4. Recording starts with correct ffmpeg command +5. Process is created and sentinel attached +6. Modeline shows recording indicator +7. User presses C-; r a again to stop +8. Recording stops gracefully +9. Modeline indicator clears + +Components integrated: +- cj/audio-recording-toggle (toggles start/stop) +- cj/recording-get-devices (prompts for setup on first use) +- cj/recording-quick-setup-for-calls (device selection) +- cj/ffmpeg-record-audio (creates recording process) +- cj/recording-modeline-indicator (UI state) +- cj/audio-recording-stop (cleanup) + +Validates: +- Full user workflow from first use to stop +- Device setup on first toggle +- Recording starts after setup +- Modeline updates correctly +- Stop works after recording" + (test-integration-toggle-setup) + (unwind-protect + (let ((setup-called nil) + (ffmpeg-cmd nil) + (process-created nil)) + ;; Mock the device setup to simulate user choosing quick setup + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (_prompt) t)) ; User says yes to quick setup + ((symbol-function 'cj/recording-quick-setup-for-calls) + (lambda () + (setq setup-called t) + (setq cj/recording-mic-device "test-mic") + (setq cj/recording-system-device "test-monitor"))) + ((symbol-function 'file-directory-p) + (lambda (_dir) t)) + ((symbol-function 'start-process-shell-command) + (lambda (_name _buffer cmd) + (setq process-created t) + (setq ffmpeg-cmd cmd) + (make-process :name "fake-audio" :command '("sleep" "1000"))))) + + ;; STEP 1: First toggle - should trigger device setup + (cj/audio-recording-toggle nil) + + ;; Verify setup was called + (should setup-called) + + ;; Verify devices were set + (should (equal "test-mic" cj/recording-mic-device)) + (should (equal "test-monitor" cj/recording-system-device)) + + ;; Verify recording started + (should process-created) + (should cj/audio-recording-ffmpeg-process) + (should (string-match-p "ffmpeg" ffmpeg-cmd)) + (should (string-match-p "test-mic" ffmpeg-cmd)) + (should (string-match-p "test-monitor" ffmpeg-cmd)) + + ;; Verify modeline shows recording + (should (equal " 🔴Audio " (cj/recording-modeline-indicator))) + + ;; STEP 2: Second toggle - should stop recording + (cj/audio-recording-toggle nil) + + ;; Verify recording stopped + (should (null cj/audio-recording-ffmpeg-process)) + + ;; Verify modeline cleared + (should (equal "" (cj/recording-modeline-indicator))))) + (test-integration-toggle-teardown))) + +(ert-deftest test-integration-recording-toggle-workflow-audio-subsequent-use-no-setup () + "Test that subsequent audio recordings skip device setup. + +After devices are configured, pressing C-; r a should: +1. Skip device setup (already configured) +2. Start recording immediately +3. Use previously configured devices + +Components integrated: +- cj/audio-recording-toggle +- cj/recording-get-devices (returns cached devices) +- cj/ffmpeg-record-audio (uses cached devices) + +Validates: +- Device setup is cached across recordings +- Second recording doesn't prompt +- Same devices are used" + (test-integration-toggle-setup) + (unwind-protect + (progn + ;; Pre-configure devices (simulating previous setup) + (setq cj/recording-mic-device "cached-mic") + (setq cj/recording-system-device "cached-monitor") + + (let ((setup-called nil) + (ffmpeg-cmd nil)) + (cl-letf (((symbol-function 'cj/recording-quick-setup-for-calls) + (lambda () (setq setup-called t))) + ((symbol-function 'file-directory-p) + (lambda (_dir) t)) + ((symbol-function 'start-process-shell-command) + (lambda (_name _buffer cmd) + (setq ffmpeg-cmd cmd) + (make-process :name "fake-audio" :command '("sleep" "1000"))))) + + ;; Toggle to start recording + (cj/audio-recording-toggle nil) + + ;; Setup should NOT be called + (should-not setup-called) + + ;; Should use cached devices + (should (string-match-p "cached-mic" ffmpeg-cmd)) + (should (string-match-p "cached-monitor" ffmpeg-cmd))))) + (test-integration-toggle-teardown))) + +;;; Integration Tests - Video Recording Workflow + +(ert-deftest test-integration-recording-toggle-workflow-video-full-cycle () + "Test complete video recording workflow. + +Components integrated: +- cj/video-recording-toggle +- cj/recording-get-devices +- cj/ffmpeg-record-video +- cj/recording-modeline-indicator +- cj/video-recording-stop + +Validates: +- Video recording follows same workflow as audio +- Modeline shows video indicator +- Toggle works for video" + (test-integration-toggle-setup) + (unwind-protect + (let ((setup-called nil)) + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (_prompt) t)) + ((symbol-function 'cj/recording-quick-setup-for-calls) + (lambda () + (setq setup-called t) + (setq cj/recording-mic-device "test-mic") + (setq cj/recording-system-device "test-monitor"))) + ((symbol-function 'file-directory-p) + (lambda (_dir) t)) + ((symbol-function 'start-process-shell-command) + (lambda (_name _buffer _cmd) + (make-process :name "fake-video" :command '("sleep" "1000"))))) + + ;; Start video recording + (cj/video-recording-toggle nil) + + ;; Verify setup and recording + (should setup-called) + (should cj/video-recording-ffmpeg-process) + (should (equal " 🔴Video " (cj/recording-modeline-indicator))) + + ;; Stop recording + (cj/video-recording-toggle nil) + + ;; Verify cleanup + (should (null cj/video-recording-ffmpeg-process)) + (should (equal "" (cj/recording-modeline-indicator))))) + (test-integration-toggle-teardown))) + +;;; Integration Tests - Both Recordings Simultaneously + +(ert-deftest test-integration-recording-toggle-workflow-both-simultaneous () + "Test that both audio and video can record simultaneously. + +Components integrated: +- cj/audio-recording-toggle +- cj/video-recording-toggle +- cj/recording-modeline-indicator (shows both) +- Both ffmpeg-record functions + +Validates: +- Audio and video can run together +- Modeline shows both indicators +- Stopping one doesn't affect the other" + (test-integration-toggle-setup) + (unwind-protect + (progn + ;; Pre-configure devices + (setq cj/recording-mic-device "test-mic") + (setq cj/recording-system-device "test-monitor") + + (cl-letf (((symbol-function 'file-directory-p) + (lambda (_dir) t)) + ((symbol-function 'start-process-shell-command) + (lambda (name _buffer _cmd) + (make-process :name name :command '("sleep" "1000"))))) + + ;; Start both recordings + (cj/audio-recording-toggle nil) + (cj/video-recording-toggle nil) + + ;; Verify both are recording + (should cj/audio-recording-ffmpeg-process) + (should cj/video-recording-ffmpeg-process) + (should (equal " 🔴A+V " (cj/recording-modeline-indicator))) + + ;; Stop audio only + (cj/audio-recording-toggle nil) + + ;; Verify only video still recording + (should (null cj/audio-recording-ffmpeg-process)) + (should cj/video-recording-ffmpeg-process) + (should (equal " 🔴Video " (cj/recording-modeline-indicator))) + + ;; Stop video + (cj/video-recording-toggle nil) + + ;; Verify all cleared + (should (null cj/video-recording-ffmpeg-process)) + (should (equal "" (cj/recording-modeline-indicator))))) + (test-integration-toggle-teardown))) + +;;; Integration Tests - Sentinel Auto-Cleanup + +(ert-deftest test-integration-recording-toggle-workflow-sentinel-auto-cleanup () + "Test that sentinel auto-cleans when recording process dies unexpectedly. + +When the ffmpeg process crashes or exits unexpectedly: +1. Sentinel detects process death +2. Variable is automatically cleared +3. Modeline updates to show no recording +4. User can start new recording + +Components integrated: +- cj/audio-recording-toggle (process creation) +- cj/ffmpeg-record-audio (attaches sentinel) +- cj/recording-process-sentinel (cleanup on death) +- cj/recording-modeline-indicator (updates on cleanup) + +Validates: +- Sentinel cleans up on unexpected process death +- Modeline syncs when sentinel runs +- User can toggle again after crash" + (test-integration-toggle-setup) + (unwind-protect + (progn + ;; Pre-configure devices + (setq cj/recording-mic-device "test-mic") + (setq cj/recording-system-device "test-monitor") + + (let ((process nil)) + (cl-letf (((symbol-function 'file-directory-p) + (lambda (_dir) t)) + ((symbol-function 'start-process-shell-command) + (lambda (name _buffer _cmd) + (setq process (make-process :name name :command '("sh" "-c" "exit 1")))))) + + ;; Start recording + (cj/audio-recording-toggle nil) + + ;; Verify recording started + (should cj/audio-recording-ffmpeg-process) + (should (equal " 🔴Audio " (cj/recording-modeline-indicator))) + + ;; Wait for process to exit (sentinel should run) + (sit-for 0.3) + + ;; Verify sentinel cleaned up + (should (null cj/audio-recording-ffmpeg-process)) + (should (equal "" (cj/recording-modeline-indicator))) + + ;; Verify user can start new recording after crash + (cj/audio-recording-toggle nil) + (should cj/audio-recording-ffmpeg-process)))) + (test-integration-toggle-teardown))) + +(provide 'test-integration-recording-toggle-workflow) +;;; test-integration-recording-toggle-workflow.el ends here diff --git a/tests/test-integration-transcription.el b/tests/test-integration-transcription.el new file mode 100644 index 00000000..d014d00e --- /dev/null +++ b/tests/test-integration-transcription.el @@ -0,0 +1,150 @@ +;;; test-integration-transcription.el --- Integration tests for transcription -*- lexical-binding: t; -*- + +;;; Commentary: +;; End-to-end integration tests for transcription workflow +;; Tests complete workflow with temporary files and mocked processes +;; Categories: Normal workflow, Error handling, Cleanup + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'transcription-config) + +;; ----------------------------- Test Helpers ---------------------------------- + +(defun test-transcription--make-mock-audio-file () + "Create a temporary mock audio file for testing. +Returns the absolute path to the file." + (let ((file (make-temp-file "test-audio-" nil ".m4a"))) + (with-temp-file file + (insert "Mock audio data")) + file)) + +(defun test-transcription--cleanup-output-files (audio-file) + "Delete transcript and log files associated with AUDIO-FILE." + (let* ((outputs (cj/--transcription-output-files audio-file)) + (txt-file (car outputs)) + (log-file (cdr outputs))) + (when (file-exists-p txt-file) + (delete-file txt-file)) + (when (file-exists-p log-file) + (delete-file log-file)))) + +;; ----------------------------- Normal Cases ---------------------------------- + +(ert-deftest test-integration-transcription-output-files-created () + "Test that .txt and .log files are created for audio file." + (let* ((audio-file (test-transcription--make-mock-audio-file)) + (outputs (cj/--transcription-output-files audio-file)) + (txt-file (car outputs)) + (log-file (cdr outputs))) + (unwind-protect + (progn + ;; Verify output file paths are correct + (should (string-suffix-p ".txt" txt-file)) + (should (string-suffix-p ".log" log-file)) + (should (string= (file-name-sans-extension txt-file) + (file-name-sans-extension audio-file))) + (should (string= (file-name-sans-extension log-file) + (file-name-sans-extension audio-file)))) + ;; Cleanup + (delete-file audio-file) + (test-transcription--cleanup-output-files audio-file)))) + +(ert-deftest test-integration-transcription-validates-file-exists () + "Test that transcription fails for non-existent file." + (should-error + (cj/--start-transcription-process "/nonexistent/audio.m4a") + :type 'user-error)) + +(ert-deftest test-integration-transcription-validates-audio-extension () + "Test that transcription fails for non-audio file." + (let ((non-audio (make-temp-file "test-" nil ".txt"))) + (unwind-protect + (should-error + (cj/--start-transcription-process non-audio) + :type 'user-error) + (delete-file non-audio)))) + +;; ----------------------------- Boundary Cases -------------------------------- + +(ert-deftest test-integration-transcription-audio-file-detection () + "Test various audio file extensions are accepted." + (dolist (ext '("m4a" "mp3" "wav" "flac" "ogg" "opus")) + (let ((audio-file (make-temp-file "test-audio-" nil (concat "." ext)))) + (unwind-protect + (progn + (should (cj/--audio-file-p audio-file)) + ;; Would start transcription if script existed + ) + (delete-file audio-file))))) + +(ert-deftest test-integration-transcription-filename-with-spaces () + "Test transcription with audio file containing spaces." + (let ((audio-file (make-temp-file "test audio file" nil ".m4a"))) + (unwind-protect + (let* ((outputs (cj/--transcription-output-files audio-file)) + (txt-file (car outputs)) + (log-file (cdr outputs))) + (should (file-name-absolute-p txt-file)) + (should (file-name-absolute-p log-file))) + (delete-file audio-file)))) + +(ert-deftest test-integration-transcription-filename-with-special-chars () + "Test transcription with special characters in filename." + (let ((audio-file (make-temp-file "test_(final)" nil ".m4a"))) + (unwind-protect + (let* ((outputs (cj/--transcription-output-files audio-file)) + (txt-file (car outputs))) + ;; make-temp-file adds random suffix, so just check it ends with .txt + ;; and contains the special chars + (should (string-suffix-p ".txt" txt-file)) + (should (string-match-p "test_(final)" txt-file))) + (delete-file audio-file)))) + +;; ----------------------------- Cleanup Tests --------------------------------- + +(ert-deftest test-integration-transcription-cleanup-completed () + "Test that completed transcriptions are removed from tracking." + (let ((cj/transcriptions-list + '((proc1 "file1.m4a" nil running) + (proc2 "file2.m4a" nil complete) + (proc3 "file3.m4a" nil error)))) + (cj/--cleanup-completed-transcriptions) + (should (= 1 (length cj/transcriptions-list))) + (should (eq 'running (nth 3 (car cj/transcriptions-list)))))) + +(ert-deftest test-integration-transcription-cleanup-all-complete () + "Test cleanup when all transcriptions are complete." + (let ((cj/transcriptions-list + '((proc1 "file1.m4a" nil complete) + (proc2 "file2.m4a" nil error)))) + (cj/--cleanup-completed-transcriptions) + (should (null cj/transcriptions-list)))) + +(ert-deftest test-integration-transcription-cleanup-preserves-running () + "Test that running transcriptions are not cleaned up." + (let ((cj/transcriptions-list + '((proc1 "file1.m4a" nil running) + (proc2 "file2.m4a" nil running)))) + (cj/--cleanup-completed-transcriptions) + (should (= 2 (length cj/transcriptions-list))))) + +;; ----------------------------- Backend Tests --------------------------------- + +(ert-deftest test-integration-transcription-script-path-exists () + "Test that transcription scripts exist in expected location." + (dolist (backend '(local-whisper openai-api)) + (let ((cj/transcribe-backend backend)) + (let ((script (cj/--transcription-script-path))) + (should (file-name-absolute-p script)) + ;; Note: Script may not exist in test environment, just check path format + (should (string-match-p "scripts/" script)))))) + +(provide 'test-integration-transcription) +;;; test-integration-transcription.el ends here diff --git a/tests/test-jumper.el b/tests/test-jumper.el new file mode 100644 index 00000000..fa65d3f4 --- /dev/null +++ b/tests/test-jumper.el @@ -0,0 +1,352 @@ +;;; test-jumper.el --- Tests for jumper.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for jumper.el - location navigation using registers. +;; +;; Testing approach: +;; - Tests focus on internal `jumper--do-*` functions (pure business logic) +;; - Interactive wrappers are thin UI layers and tested minimally +;; - Each test is isolated with setup/teardown to reset global state +;; - Tests verify return values, not user messages + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Load the module +(require 'jumper) + +;;; Test Utilities + +(defvar test-jumper--original-registers nil + "Backup of jumper registers before test.") + +(defvar test-jumper--original-index nil + "Backup of jumper index before test.") + +(defun test-jumper-setup () + "Reset jumper state before each test." + ;; Backup current state + (setq test-jumper--original-registers jumper--registers) + (setq test-jumper--original-index jumper--next-index) + ;; Reset to clean state + (setq jumper--registers (make-vector jumper-max-locations nil)) + (setq jumper--next-index 0)) + +(defun test-jumper-teardown () + "Restore jumper state after each test." + (setq jumper--registers test-jumper--original-registers) + (setq jumper--next-index test-jumper--original-index)) + +;;; Normal Cases - Store Location + +(ert-deftest test-jumper-store-first-location () + "Should store first location and return register character." + (test-jumper-setup) + (with-temp-buffer + (insert "test content") + (goto-char (point-min)) + (let ((result (jumper--do-store-location))) + (should (= result ?0)) + (should (= jumper--next-index 1)))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-store-multiple-locations () + "Should store multiple locations in sequence." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (should (= (jumper--do-store-location) ?0)) + (forward-line 1) + (should (= (jumper--do-store-location) ?1)) + (forward-line 1) + (should (= (jumper--do-store-location) ?2)) + (should (= jumper--next-index 3))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-store-duplicate-location () + "Should detect and reject duplicate locations." + (test-jumper-setup) + (with-temp-buffer + (insert "test content") + (goto-char (point-min)) + (should (= (jumper--do-store-location) ?0)) + (should (eq (jumper--do-store-location) 'already-exists)) + (should (= jumper--next-index 1))) + (test-jumper-teardown)) + +;;; Normal Cases - Jump to Location + +(ert-deftest test-jumper-jump-to-stored-location () + "Should jump to a previously stored location." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (jumper--do-store-location) + (goto-char (point-max)) + (let ((result (jumper--do-jump-to-location 0))) + (should (eq result 'jumped)) + (should (= (point) (point-min))))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-jump-toggle-with-single-location () + "Should toggle between current and stored location." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (jumper--do-store-location) + ;; Move away + (goto-char (point-max)) + ;; Toggle should jump back + (let ((result (jumper--do-jump-to-location nil))) + (should (eq result 'jumped)) + (should (= (point) (point-min))))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-jump-already-at-location () + "Should detect when already at the only stored location." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2") + (goto-char (point-min)) + (jumper--do-store-location) + ;; Try to toggle while at the location + (let ((result (jumper--do-jump-to-location nil))) + (should (eq result 'already-there)))) + (test-jumper-teardown)) + +;;; Normal Cases - Remove Location + +(ert-deftest test-jumper-remove-location () + "Should remove a stored location." + (test-jumper-setup) + (with-temp-buffer + (insert "test content") + (goto-char (point-min)) + (jumper--do-store-location) + (let ((result (jumper--do-remove-location 0))) + (should (eq result t)) + (should (= jumper--next-index 0)))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-remove-reorders-registers () + "Should reorder registers after removal from middle." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (jumper--do-store-location) ; Register 0 + (forward-line 1) + (jumper--do-store-location) ; Register 1 + (forward-line 1) + (jumper--do-store-location) ; Register 2 + ;; Remove middle (index 1) + (jumper--do-remove-location 1) + (should (= jumper--next-index 2)) + ;; What was at index 2 should now be at index 1 + (should (= (aref jumper--registers 1) ?2))) + (test-jumper-teardown)) + +;;; Boundary Cases - Store Location + +(ert-deftest test-jumper-store-at-capacity () + "Should successfully store location at maximum capacity." + (test-jumper-setup) + (with-temp-buffer + (insert "test content") + (goto-char (point-min)) + ;; Fill to capacity + (dotimes (i jumper-max-locations) + (forward-char 1) + (should (= (jumper--do-store-location) (+ ?0 i)))) + (should (= jumper--next-index jumper-max-locations))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-store-when-full () + "Should return 'no-space when all registers are full." + (test-jumper-setup) + (with-temp-buffer + (insert "01234567890123456789") + (goto-char (point-min)) + ;; Fill to capacity + (dotimes (i jumper-max-locations) + (forward-char 1) + (jumper--do-store-location)) + ;; Try to store one more + (forward-char 1) + (should (eq (jumper--do-store-location) 'no-space)) + (should (= jumper--next-index jumper-max-locations))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-store-in-different-buffers () + "Should store locations across different buffers." + (test-jumper-setup) + (with-temp-buffer + (insert "buffer 1") + (goto-char (point-min)) + (should (= (jumper--do-store-location) ?0)) + (with-temp-buffer + (insert "buffer 2") + (goto-char (point-min)) + (should (= (jumper--do-store-location) ?1)) + (should (= jumper--next-index 2)))) + (test-jumper-teardown)) + +;;; Boundary Cases - Jump to Location + +(ert-deftest test-jumper-jump-with-no-locations () + "Should return 'no-locations when nothing is stored." + (test-jumper-setup) + (with-temp-buffer + (insert "test") + (let ((result (jumper--do-jump-to-location 0))) + (should (eq result 'no-locations)))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-jump-to-first-location () + "Should jump to location at index 0." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2") + (goto-char (point-min)) + (jumper--do-store-location) + (forward-line 1) + (jumper--do-store-location) + (goto-char (point-max)) + (jumper--do-jump-to-location 0) + (should (= (point) (point-min)))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-jump-to-last-location () + "Should jump to last location (register 'z)." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (jumper--do-store-location) + (let ((line2-pos (line-beginning-position 2))) + (goto-char line2-pos) + ;; Jump to location 0 (this stores current location in 'z) + (jumper--do-jump-to-location 0) + (should (= (point) (point-min))) + ;; Jump to last location should go back to line 2 + (let ((result (jumper--do-jump-to-location -1))) + (should (eq result 'jumped)) + (should (= (point) line2-pos))))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-jump-to-max-index () + "Should jump to location at maximum index." + (test-jumper-setup) + (with-temp-buffer + (insert "0123456789012345678") + (goto-char (point-min)) + ;; Store at all positions + (dotimes (i jumper-max-locations) + (forward-char 1) + (jumper--do-store-location)) + (goto-char (point-min)) + ;; Jump to last one (index 9, which is at position 10) + (jumper--do-jump-to-location (1- jumper-max-locations)) + (should (= (point) (1+ jumper-max-locations)))) + (test-jumper-teardown)) + +;;; Boundary Cases - Remove Location + +(ert-deftest test-jumper-remove-first-location () + "Should remove location at index 0." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2") + (goto-char (point-min)) + (jumper--do-store-location) + (forward-line 1) + (jumper--do-store-location) + (jumper--do-remove-location 0) + (should (= jumper--next-index 1)) + ;; What was at index 1 should now be at index 0 + (should (= (aref jumper--registers 0) ?1))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-remove-last-location () + "Should remove location at last index." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (jumper--do-store-location) + (forward-line 1) + (jumper--do-store-location) + (forward-line 1) + (jumper--do-store-location) + (jumper--do-remove-location 2) + (should (= jumper--next-index 2))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-remove-with-cancel () + "Should return 'cancelled when index is -1." + (test-jumper-setup) + (with-temp-buffer + (insert "test") + (goto-char (point-min)) + (jumper--do-store-location) + (let ((result (jumper--do-remove-location -1))) + (should (eq result 'cancelled)) + (should (= jumper--next-index 1)))) + (test-jumper-teardown)) + +;;; Error Cases + +(ert-deftest test-jumper-remove-when-empty () + "Should return 'no-locations when removing from empty list." + (test-jumper-setup) + (let ((result (jumper--do-remove-location 0))) + (should (eq result 'no-locations))) + (test-jumper-teardown)) + +;;; Helper Function Tests + +(ert-deftest test-jumper-location-key-format () + "Should generate unique location keys." + (with-temp-buffer + (insert "line 1\nline 2") + (goto-char (point-min)) + (let ((key1 (jumper--location-key))) + (forward-line 1) + (let ((key2 (jumper--location-key))) + (should-not (string= key1 key2)) + ;; Keys should contain buffer name and position info + (should (string-match-p ":" key1)) + (should (string-match-p ":" key2)))))) + +(ert-deftest test-jumper-register-available-p () + "Should correctly report register availability." + (test-jumper-setup) + (should (jumper--register-available-p)) + ;; Fill to capacity + (setq jumper--next-index jumper-max-locations) + (should-not (jumper--register-available-p)) + (test-jumper-teardown)) + +(ert-deftest test-jumper-format-location () + "Should format location for display." + (test-jumper-setup) + (with-temp-buffer + (insert "test line with some content") + (goto-char (point-min)) + (jumper--do-store-location) + (let ((formatted (jumper--format-location 0))) + (should formatted) + (should (string-match-p "\\[0\\]" formatted)) + (should (string-match-p "test line" formatted)))) + (test-jumper-teardown)) + +(provide 'test-jumper) +;;; test-jumper.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-lorem-optimum-benchmark.el b/tests/test-lorem-optimum-benchmark.el new file mode 100644 index 00000000..57d5ae5f --- /dev/null +++ b/tests/test-lorem-optimum-benchmark.el @@ -0,0 +1,223 @@ +;;; test-lorem-optimum-benchmark.el --- Performance tests for lorem-optimum.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Benchmark and performance tests for the Markov chain implementation. +;; +;; These tests measure: +;; - Learning time scaling with input size +;; - Multiple learning operations (exposes key rebuild overhead) +;; - Generation time scaling +;; - Memory usage (hash table growth) +;; +;; Performance baseline targets (on modern hardware): +;; - Learn 1000 words: < 10ms +;; - Learn 10,000 words: < 100ms +;; - 100 learn operations of 100 words each: < 500ms (current bottleneck!) +;; - Generate 100 words: < 5ms + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Load the module +(require 'lorem-optimum) + +;;; Benchmark Helpers + +(defun benchmark-time (func) + "Time execution of FUNC and return milliseconds." + (let ((start (current-time))) + (funcall func) + (let ((end (current-time))) + (* 1000.0 (float-time (time-subtract end start)))))) + +(defun generate-test-text (word-count) + "Generate WORD-COUNT words of test text with some repetition." + (let ((words '("lorem" "ipsum" "dolor" "sit" "amet" "consectetur" + "adipiscing" "elit" "sed" "do" "eiusmod" "tempor" + "incididunt" "ut" "labore" "et" "dolore" "magna" "aliqua")) + (result '())) + (dotimes (i word-count) + (push (nth (mod i (length words)) words) result) + (when (zerop (mod i 10)) + (push "." result))) + (mapconcat #'identity (nreverse result) " "))) + +(defun benchmark-report (name time-ms) + "Report benchmark NAME with TIME-MS." + (message "BENCHMARK [%s]: %.2f ms" name time-ms)) + +;;; Learning Performance Tests + +(ert-deftest benchmark-learn-1k-words () + "Benchmark learning 1000 words." + (let* ((text (generate-test-text 1000)) + (chain (cj/markov-chain-create)) + (time (benchmark-time + (lambda () (cj/markov-learn chain text))))) + (benchmark-report "Learn 1K words" time) + (should (< time 50.0)))) ; Should be < 50ms + +(ert-deftest benchmark-learn-10k-words () + "Benchmark learning 10,000 words. +DISABLED: Takes too long (minutes instead of seconds). +Needs lorem-optimum performance optimization before re-enabling." + :tags '(:slow) + (let* ((text (generate-test-text 10000)) + (chain (cj/markov-chain-create)) + (time (benchmark-time + (lambda () (cj/markov-learn chain text))))) + (benchmark-report "Learn 10K words" time) + (should (< time 500.0)))) ; Should be < 500ms + +(ert-deftest benchmark-learn-100k-words () + "Benchmark learning 100,000 words (stress test)." + :tags '(:slow) + (let* ((text (generate-test-text 100000)) + (chain (cj/markov-chain-create)) + (time (benchmark-time + (lambda () (cj/markov-learn chain text))))) + (benchmark-report "Learn 100K words" time) + ;; This may be slow due to key rebuild + (message "Hash table size: %d bigrams" + (hash-table-count (cj/markov-chain-map chain))))) + +;;; Multiple Learning Operations (Exposes Quadratic Behavior) + +(ert-deftest benchmark-multiple-learns-10x100 () + "Benchmark 10 learn operations of 100 words each." + (let ((chain (cj/markov-chain-create)) + (times '())) + (dotimes (i 10) + (let* ((text (generate-test-text 100)) + (time (benchmark-time + (lambda () (cj/markov-learn chain text))))) + (push time times))) + (let ((total (apply #'+ times)) + (avg (/ (apply #'+ times) 10.0)) + (max-time (apply #'max times))) + (benchmark-report "10x learn 100 words - TOTAL" total) + (benchmark-report "10x learn 100 words - AVG" avg) + (benchmark-report "10x learn 100 words - MAX" max-time) + (message "Times: %S" (nreverse times)) + ;; Note: Watch if later operations are slower (quadratic behavior) + (should (< total 100.0))))) ; Total should be < 100ms + +(ert-deftest benchmark-multiple-learns-100x100 () + "Benchmark 100 learn operations of 100 words each (key rebuild overhead)." + :tags '(:slow) + (let ((chain (cj/markov-chain-create)) + (times '()) + (measurements '())) + (dotimes (i 100) + (let* ((text (generate-test-text 100)) + (time (benchmark-time + (lambda () (cj/markov-learn chain text))))) + (push time times) + ;; Sample measurements every 10 iterations + (when (zerop (mod i 10)) + (push (cons i time) measurements)))) + (let ((total (apply #'+ times)) + (avg (/ (apply #'+ times) 100.0)) + (first-10-avg (/ (apply #'+ (last times 10)) 10.0)) + (last-10-avg (/ (apply #'+ (seq-take times 10)) 10.0))) + (benchmark-report "100x learn 100 words - TOTAL" total) + (benchmark-report "100x learn 100 words - AVG" avg) + (benchmark-report "100x learn - First 10 AVG" first-10-avg) + (benchmark-report "100x learn - Last 10 AVG" last-10-avg) + (message "Sampled times (iteration, ms): %S" (nreverse measurements)) + (message "Hash table size: %d bigrams" + (hash-table-count (cj/markov-chain-map chain))) + ;; This exposes the quadratic behavior: last operations much slower + (when (> last-10-avg (* 2.0 first-10-avg)) + (message "WARNING: Learning slows down significantly over time!") + (message " First 10 avg: %.2f ms" first-10-avg) + (message " Last 10 avg: %.2f ms" last-10-avg) + (message " Ratio: %.1fx slower" (/ last-10-avg first-10-avg)))))) + +;;; Generation Performance Tests + +(ert-deftest benchmark-generate-100-words () + "Benchmark generating 100 words." + (let* ((text (generate-test-text 1000)) + (chain (cj/markov-chain-create))) + (cj/markov-learn chain text) + (let ((time (benchmark-time + (lambda () (cj/markov-generate chain 100))))) + (benchmark-report "Generate 100 words" time) + (should (< time 30.0))))) ; Should be < 30ms + +;;; Tokenization Performance Tests + +(ert-deftest benchmark-tokenize-10k-words () + "Benchmark tokenizing 10,000 words. +DISABLED: Takes too long (minutes instead of seconds). +Needs lorem-optimum performance optimization before re-enabling." + :tags '(:slow) + (let* ((text (generate-test-text 10000)) + (time (benchmark-time + (lambda () (cj/markov-tokenize text))))) + (benchmark-report "Tokenize 10K words" time) + (should (< time 50.0)))) ; Tokenization should be fast + +;;; Memory/Size Tests + +(ert-deftest benchmark-chain-growth () + "Measure hash table growth with increasing input." + (let ((chain (cj/markov-chain-create)) + (sizes '())) + (dolist (word-count '(100 500 1000 5000 10000)) + (let ((text (generate-test-text word-count))) + (cj/markov-learn chain text) + (let ((size (hash-table-count (cj/markov-chain-map chain)))) + (push (cons word-count size) sizes) + (message "After %d words: %d unique bigrams" word-count size)))) + (message "Growth pattern: %S" (nreverse sizes)))) + +;;; Comparison: Tokenization vs Learning + +(ert-deftest benchmark-tokenize-vs-learn () + "Compare tokenization time to total learning time." + (let* ((text (generate-test-text 5000)) + (tokenize-time (benchmark-time + (lambda () (cj/markov-tokenize text)))) + (chain (cj/markov-chain-create)) + (learn-time (benchmark-time + (lambda () (cj/markov-learn chain text))))) + (benchmark-report "Tokenize 5K words" tokenize-time) + (benchmark-report "Learn 5K words (total)" learn-time) + (message "Tokenization is %.1f%% of total learning time" + (* 100.0 (/ tokenize-time learn-time))))) + +;;; Real-world Scenario + +(ert-deftest benchmark-realistic-usage () + "Benchmark realistic usage: learn from multiple sources, generate paragraphs." + (let ((chain (cj/markov-chain-create)) + (learn-total 0.0) + (gen-total 0.0)) + ;; Simulate learning from 10 different sources + (dotimes (i 10) + (let ((text (generate-test-text 500))) + (setq learn-total + (+ learn-total + (benchmark-time (lambda () (cj/markov-learn chain text))))))) + + ;; Generate 5 paragraphs + (dotimes (i 5) + (setq gen-total + (+ gen-total + (benchmark-time (lambda () (cj/markov-generate chain 50)))))) + + (benchmark-report "Realistic: 10 learns (500 words each)" learn-total) + (benchmark-report "Realistic: 5 generations (50 words each)" gen-total) + (benchmark-report "Realistic: TOTAL TIME" (+ learn-total gen-total)) + (message "Final chain size: %d bigrams" + (hash-table-count (cj/markov-chain-map chain))))) + +(provide 'test-lorem-optimum-benchmark) +;;; test-lorem-optimum-benchmark.el ends here diff --git a/tests/test-lorem-optimum.el b/tests/test-lorem-optimum.el new file mode 100644 index 00000000..ca2e52f4 --- /dev/null +++ b/tests/test-lorem-optimum.el @@ -0,0 +1,242 @@ +;;; test-lorem-optimum.el --- Tests for lorem-optimum.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for lorem-optimum.el Markov chain text generation. +;; +;; Tests cover: +;; - Tokenization +;; - Learning and chain building +;; - Text generation +;; - Capitalization fixing +;; - Token joining + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Load the module +(require 'lorem-optimum) + +;;; Test Helpers + +(defun test-chain () + "Create a fresh test chain." + (cj/markov-chain-create)) + +(defun test-learn (text) + "Create a chain and learn TEXT." + (let ((chain (test-chain))) + (cj/markov-learn chain text) + chain)) + +;;; Tokenization Tests + +(ert-deftest test-tokenize-simple () + "Should tokenize simple words." + (let ((result (cj/markov-tokenize "hello world"))) + (should (equal result '("hello" "world"))))) + +(ert-deftest test-tokenize-with-punctuation () + "Should separate punctuation as tokens." + (let ((result (cj/markov-tokenize "Hello, world!"))) + (should (equal result '("Hello" "," "world" "!"))))) + +(ert-deftest test-tokenize-multiple-spaces () + "Should handle multiple spaces." + (let ((result (cj/markov-tokenize "hello world"))) + (should (equal result '("hello" "world"))))) + +(ert-deftest test-tokenize-newlines () + "Should handle newlines as whitespace." + (let ((result (cj/markov-tokenize "hello\nworld"))) + (should (equal result '("hello" "world"))))) + +(ert-deftest test-tokenize-mixed-punctuation () + "Should tokenize complex punctuation." + (let ((result (cj/markov-tokenize "one, two; three."))) + (should (equal result '("one" "," "two" ";" "three" "."))))) + +(ert-deftest test-tokenize-empty () + "Should handle empty string." + (let ((result (cj/markov-tokenize ""))) + (should (null result)))) + +(ert-deftest test-tokenize-whitespace-only () + "Should return nil for whitespace only." + (let ((result (cj/markov-tokenize " \n\t "))) + (should (null result)))) + +;;; Markov Learn Tests + +(ert-deftest test-learn-basic () + "Should learn simple text." + (let ((chain (test-learn "one two three four"))) + (should (cj/markov-chain-p chain)) + (should (> (hash-table-count (cj/markov-chain-map chain)) 0)))) + +(ert-deftest test-learn-creates-bigrams () + "Should create bigram mappings." + (let ((chain (test-learn "one two three"))) + (should (gethash '("one" "two") (cj/markov-chain-map chain))))) + +(ert-deftest test-learn-stores-following-word () + "Should store following word for bigram." + (let ((chain (test-learn "one two three"))) + (should (member "three" (gethash '("one" "two") (cj/markov-chain-map chain)))))) + +(ert-deftest test-learn-builds-keys-list () + "Should build keys list lazily when accessed." + (let ((chain (test-learn "one two three four"))) + ;; Keys are built lazily, so initially nil + (should (null (cj/markov-chain-keys chain))) + ;; After calling random-key, keys should be built + (cj/markov-random-key chain) + (should (> (length (cj/markov-chain-keys chain)) 0)))) + +(ert-deftest test-learn-repeated-patterns () + "Should accumulate repeated patterns." + (let ((chain (test-learn "one two three one two four"))) + (let ((nexts (gethash '("one" "two") (cj/markov-chain-map chain)))) + (should (= (length nexts) 2)) + (should (member "three" nexts)) + (should (member "four" nexts))))) + +(ert-deftest test-learn-incremental () + "Should support incremental learning." + (let ((chain (test-chain))) + (cj/markov-learn chain "one two three") + (cj/markov-learn chain "four five six") + (should (> (hash-table-count (cj/markov-chain-map chain)) 0)))) + +;;; Token Joining Tests + +(ert-deftest test-join-simple-words () + "Should join words with spaces." + (let ((result (cj/markov-join-tokens '("hello" "world")))) + (should (string-match-p "^Hello world" result)))) + +(ert-deftest test-join-with-punctuation () + "Should attach punctuation without spaces." + (let ((result (cj/markov-join-tokens '("hello" "," "world")))) + (should (string-match-p "Hello, world" result)))) + +(ert-deftest test-join-capitalizes-first () + "Should capitalize first word." + (let ((result (cj/markov-join-tokens '("hello" "world")))) + (should (string-match-p "^H" result)))) + +(ert-deftest test-join-adds-period () + "Should add period if missing." + (let ((result (cj/markov-join-tokens '("hello" "world")))) + (should (string-match-p "\\.$" result)))) + +(ert-deftest test-join-preserves-existing-period () + "Should not double-add period." + (let ((result (cj/markov-join-tokens '("hello" "world" ".")))) + (should (string-match-p "\\.$" result)) + (should-not (string-match-p "\\.\\.$" result)))) + +(ert-deftest test-join-empty-tokens () + "Should handle empty token list." + (let ((result (cj/markov-join-tokens '()))) + (should (equal result ".")))) + +;;; Capitalization Tests + +(ert-deftest test-capitalize-first-word () + "Should capitalize first word." + (let ((result (cj/markov-fix-capitalization "hello world"))) + (should (string-match-p "^Hello" result)))) + +(ert-deftest test-capitalize-after-period () + "Should capitalize after period." + (let ((result (cj/markov-fix-capitalization "hello. world"))) + (should (string-match-p "Hello\\. World" result)))) + +(ert-deftest test-capitalize-after-exclamation () + "Should capitalize after exclamation." + (let ((result (cj/markov-fix-capitalization "hello! world"))) + (should (string-match-p "Hello! World" result)))) + +(ert-deftest test-capitalize-after-question () + "Should capitalize after question mark." + (let ((result (cj/markov-fix-capitalization "hello? world"))) + (should (string-match-p "Hello\\? World" result)))) + +(ert-deftest test-capitalize-skip-non-alpha () + "Should skip non-alphabetic tokens." + (let ((result (cj/markov-fix-capitalization "hello. 123 world"))) + (should (string-match-p "123" result)))) + +(ert-deftest test-capitalize-multiple-sentences () + "Should capitalize all sentences." + (let ((result (cj/markov-fix-capitalization "first. second. third"))) + (should (string-match-p "First\\. Second\\. Third" result)))) + +;;; Generation Tests (deterministic with fixed chain) + +(ert-deftest test-generate-produces-output () + "Should generate non-empty output." + (let ((chain (test-learn "Lorem ipsum dolor sit amet consectetur adipiscing elit"))) + (let ((result (cj/markov-generate chain 5))) + (should (stringp result)) + (should (> (length result) 0))))) + +(ert-deftest test-generate-empty-chain () + "Should handle empty chain gracefully." + (let ((chain (test-chain))) + (let ((result (cj/markov-generate chain 5))) + (should (or (null result) (string-empty-p result)))))) + +(ert-deftest test-generate-respects-start () + "Should use provided start state if available." + (let ((chain (test-learn "Lorem ipsum dolor sit amet"))) + (let ((result (cj/markov-generate chain 3 '("Lorem" "ipsum")))) + (should (stringp result)) + ;; Should start with Lorem or similar + (should (> (length result) 0))))) + +;;; Integration Tests + +(ert-deftest test-full-workflow () + "Should complete full learn-generate workflow." + (let ((chain (test-chain))) + (cj/markov-learn chain "The quick brown fox jumps over the lazy dog") + (let ((result (cj/markov-generate chain 8))) + (should (stringp result)) + (should (> (length result) 0)) + (should (string-match-p "^[A-Z]" result)) + (should (string-match-p "[.!?]$" result))))) + +(ert-deftest test-latin-like-output () + "Should generate Latin-like text from Latin input." + (let ((chain (test-chain))) + (cj/markov-learn chain "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.") + (let ((result (cj/markov-generate chain 10))) + (should (stringp result)) + (should (> (length result) 10))))) + +;;; Edge Cases + +(ert-deftest test-learn-short-text () + "Should handle text shorter than trigram." + (let ((chain (test-learn "one two"))) + (should (cj/markov-chain-p chain)))) + +(ert-deftest test-learn-single-word () + "Should handle single word." + (let ((chain (test-learn "word"))) + (should (cj/markov-chain-p chain)))) + +(ert-deftest test-generate-requested-count-small () + "Should handle small generation count." + (let ((chain (test-learn "one two three four five"))) + (let ((result (cj/markov-generate chain 2))) + (should (stringp result))))) + +(provide 'test-lorem-optimum) +;;; test-lorem-optimum.el ends here diff --git a/tests/test-music-config--append-track-to-m3u-file.el b/tests/test-music-config--append-track-to-m3u-file.el new file mode 100644 index 00000000..2bf3e87d --- /dev/null +++ b/tests/test-music-config--append-track-to-m3u-file.el @@ -0,0 +1,187 @@ +;;; test-music-config--append-track-to-m3u-file.el --- Tests for appending tracks to M3U files -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Unit tests for cj/music--append-track-to-m3u-file function. +;; Tests the pure, deterministic helper that appends track paths to M3U files. +;; +;; Test organization: +;; - Normal Cases: Standard append operations +;; - Boundary Cases: Edge conditions (unicode, long paths, special chars) +;; - Error Cases: File errors (missing, read-only, directory instead of file) +;; +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Stub missing dependencies before loading music-config +(defvar-keymap cj/custom-keymap + :doc "Stub keymap for testing") + +;; Load production code +(require 'music-config) + +;;; Setup & Teardown + +(defun test-music-config--append-track-to-m3u-file-setup () + "Setup test environment." + (cj/create-test-base-dir)) + +(defun test-music-config--append-track-to-m3u-file-teardown () + "Clean up test environment." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-empty-file-appends-track () + "Append to brand new empty M3U file." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (track-path "/home/user/music/artist/song.mp3")) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) (concat track-path "\n"))))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-existing-with-newline-appends-track () + "Append to file with existing content ending with newline." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((existing-content "/home/user/music/first.mp3\n") + (m3u-file (cj/create-temp-test-file-with-content existing-content "test-playlist-")) + (track-path "/home/user/music/second.mp3")) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) + (concat existing-content track-path "\n"))))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-existing-without-newline-appends-track () + "Append to file without trailing newline adds leading newline." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((existing-content "/home/user/music/first.mp3") + (m3u-file (cj/create-temp-test-file-with-content existing-content "test-playlist-")) + (track-path "/home/user/music/second.mp3")) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) + (concat existing-content "\n" track-path "\n"))))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-multiple-appends-all-succeed () + "Multiple appends to same file all succeed (allows duplicates)." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (track1 "/home/user/music/track1.mp3") + (track2 "/home/user/music/track2.mp3") + (track1-duplicate "/home/user/music/track1.mp3")) + (cj/music--append-track-to-m3u-file track1 m3u-file) + (cj/music--append-track-to-m3u-file track2 m3u-file) + (cj/music--append-track-to-m3u-file track1-duplicate m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (let ((content (buffer-string))) + (should (string= content + (concat track1 "\n" track2 "\n" track1-duplicate "\n")))))) + (test-music-config--append-track-to-m3u-file-teardown))) + +;;; Boundary Cases + +(ert-deftest test-music-config--append-track-to-m3u-file-boundary-very-long-path-appends-successfully () + "Append very long track path without truncation." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + ;; Create a path that's ~500 chars long + (track-path (concat "/home/user/music/" + (make-string 450 ?a) + "/song.mp3"))) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) (concat track-path "\n"))) + (should (= (length (buffer-string)) (1+ (length track-path)))))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-boundary-path-with-unicode-appends-successfully () + "Append path with unicode characters preserves UTF-8 encoding." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (track-path "/home/user/music/中文/artist-名前/song🎵.mp3")) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) (concat track-path "\n"))))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-boundary-path-with-spaces-appends-successfully () + "Append path with spaces and special characters." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (track-path "/home/user/music/Artist Name/Album (2024)/01 - Song's Title [Remix].mp3")) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) (concat track-path "\n"))))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-boundary-m3u-with-comments-appends-after () + "Append to M3U file containing comments and metadata." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((existing-content "#EXTM3U\n#EXTINF:-1,Radio Station\nhttp://stream.url/radio\n") + (m3u-file (cj/create-temp-test-file-with-content existing-content "test-playlist-")) + (track-path "/home/user/music/local-track.mp3")) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) + (concat existing-content track-path "\n"))))) + (test-music-config--append-track-to-m3u-file-teardown))) + +;;; Error Cases + +(ert-deftest test-music-config--append-track-to-m3u-file-error-nonexistent-file-signals-error () + "Signal error when M3U file doesn't exist." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((m3u-file "/nonexistent/path/to/playlist.m3u") + (track-path "/home/user/music/song.mp3")) + (should-error (cj/music--append-track-to-m3u-file track-path m3u-file) + :type 'error)) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-error-readonly-file-signals-error () + "Signal error when M3U file is read-only." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (track-path "/home/user/music/song.mp3")) + ;; Make file read-only + (set-file-modes m3u-file #o444) + (should-error (cj/music--append-track-to-m3u-file track-path m3u-file) + :type 'error)) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-error-directory-not-file-signals-error () + "Signal error when path points to directory instead of file." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((m3u-dir (cj/create-test-subdirectory "test-playlist-dir")) + (track-path "/home/user/music/song.mp3")) + (should-error (cj/music--append-track-to-m3u-file track-path m3u-dir) + :type 'error)) + (test-music-config--append-track-to-m3u-file-teardown))) + +(provide 'test-music-config--append-track-to-m3u-file) +;;; test-music-config--append-track-to-m3u-file.el ends here diff --git a/tests/test-music-config--collect-entries-recursive.el b/tests/test-music-config--collect-entries-recursive.el new file mode 100644 index 00000000..d71ceab6 --- /dev/null +++ b/tests/test-music-config--collect-entries-recursive.el @@ -0,0 +1,245 @@ +;;; test-music-config--collect-entries-recursive.el --- Tests for recursive music collection -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Unit tests for cj/music--collect-entries-recursive function. +;; Tests the recursive helper that collects music files and directories. +;; +;; Test organization: +;; - Normal Cases: Single level, nested directories, mixed files +;; - Boundary Cases: Hidden files/dirs, non-music files, empty dirs, sorting +;; - Error Cases: Empty root, nonexistent root +;; +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Stub missing dependencies before loading music-config +(defvar-keymap cj/custom-keymap + :doc "Stub keymap for testing") + +;; Load production code +(require 'music-config) + +;;; Setup & Teardown + +(defun test-music-config--collect-entries-recursive-setup () + "Setup test environment." + (cj/create-test-base-dir)) + +(defun test-music-config--collect-entries-recursive-teardown () + "Clean up test environment." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-music-config--collect-entries-recursive-normal-single-level-files-and-dirs () + "Collect music files and subdirectories at single level." + (test-music-config--collect-entries-recursive-setup) + (unwind-protect + (let* ((root-dir (cj/create-test-subdirectory "music"))) + ;; Create files at root + (cj/create-directory-or-file-ensuring-parents "music/song1.mp3" "") + (cj/create-directory-or-file-ensuring-parents "music/song2.flac" "") + ;; Create subdirectories + (cj/create-directory-or-file-ensuring-parents "music/artist1/" "") + (cj/create-directory-or-file-ensuring-parents "music/artist2/" "") + + (let ((result (cj/music--collect-entries-recursive root-dir))) + (should (member "artist1/" result)) + (should (member "artist2/" result)) + (should (member "song1.mp3" result)) + (should (member "song2.flac" result)) + (should (= (length result) 4)))) + (test-music-config--collect-entries-recursive-teardown))) + +(ert-deftest test-music-config--collect-entries-recursive-normal-nested-directories () + "Collect nested directories multiple levels deep." + (test-music-config--collect-entries-recursive-setup) + (unwind-protect + (let* ((root-dir (cj/create-test-subdirectory "music"))) + ;; Create nested structure + (cj/create-directory-or-file-ensuring-parents "music/artist/" "") + (cj/create-directory-or-file-ensuring-parents "music/artist/album/" "") + (cj/create-directory-or-file-ensuring-parents "music/artist/album/disc1/" "") + + (let ((result (cj/music--collect-entries-recursive root-dir))) + (should (member "artist/" result)) + (should (member "artist/album/" result)) + (should (member "artist/album/disc1/" result)) + (should (= (length result) 3)))) + (test-music-config--collect-entries-recursive-teardown))) + +(ert-deftest test-music-config--collect-entries-recursive-normal-mixed-files-at-multiple-levels () + "Collect music files at root, subdirs, and nested subdirs." + (test-music-config--collect-entries-recursive-setup) + (unwind-protect + (let* ((root-dir (cj/create-test-subdirectory "music"))) + ;; Root level file + (cj/create-directory-or-file-ensuring-parents "music/root-track.mp3" "") + ;; Subdir with file + (cj/create-directory-or-file-ensuring-parents "music/artist/" "") + (cj/create-directory-or-file-ensuring-parents "music/artist/track1.mp3" "") + ;; Nested subdir with file + (cj/create-directory-or-file-ensuring-parents "music/artist/album/" "") + (cj/create-directory-or-file-ensuring-parents "music/artist/album/track2.mp3" "") + + (let ((result (cj/music--collect-entries-recursive root-dir))) + (should (member "root-track.mp3" result)) + (should (member "artist/" result)) + (should (member "artist/track1.mp3" result)) + (should (member "artist/album/" result)) + (should (member "artist/album/track2.mp3" result)) + (should (= (length result) 5)))) + (test-music-config--collect-entries-recursive-teardown))) + +;;; Boundary Cases + +(ert-deftest test-music-config--collect-entries-recursive-boundary-hidden-directories-skipped () + "Hidden directories and their contents are excluded." + (test-music-config--collect-entries-recursive-setup) + (unwind-protect + (let* ((root-dir (cj/create-test-subdirectory "music"))) + ;; Visible file + (cj/create-directory-or-file-ensuring-parents "music/visible.mp3" "") + ;; Hidden directory with music file + (cj/create-directory-or-file-ensuring-parents "music/.hidden/" "") + (cj/create-directory-or-file-ensuring-parents "music/.hidden/secret.mp3" "") + + (let ((result (cj/music--collect-entries-recursive root-dir))) + (should (member "visible.mp3" result)) + (should-not (member ".hidden/" result)) + (should-not (member ".hidden/secret.mp3" result)) + (should (= (length result) 1)))) + (test-music-config--collect-entries-recursive-teardown))) + +(ert-deftest test-music-config--collect-entries-recursive-boundary-hidden-files-skipped () + "Hidden files at root are excluded." + (test-music-config--collect-entries-recursive-setup) + (unwind-protect + (let* ((root-dir (cj/create-test-subdirectory "music"))) + ;; Visible file + (cj/create-directory-or-file-ensuring-parents "music/visible.mp3" "") + ;; Hidden file (note: directory-files regex "^[^.].*" should skip it) + (cj/create-directory-or-file-ensuring-parents "music/.hidden-track.mp3" "") + + (let ((result (cj/music--collect-entries-recursive root-dir))) + (should (member "visible.mp3" result)) + (should-not (member ".hidden-track.mp3" result)) + (should (= (length result) 1)))) + (test-music-config--collect-entries-recursive-teardown))) + +(ert-deftest test-music-config--collect-entries-recursive-boundary-non-music-files-excluded () + "Non-music files are excluded." + (test-music-config--collect-entries-recursive-setup) + (unwind-protect + (let* ((root-dir (cj/create-test-subdirectory "music"))) + ;; Music file + (cj/create-directory-or-file-ensuring-parents "music/song.mp3" "") + ;; Non-music files + (cj/create-directory-or-file-ensuring-parents "music/readme.txt" "") + (cj/create-directory-or-file-ensuring-parents "music/cover.jpg" "") + (cj/create-directory-or-file-ensuring-parents "music/info.pdf" "") + + (let ((result (cj/music--collect-entries-recursive root-dir))) + (should (member "song.mp3" result)) + (should-not (member "readme.txt" result)) + (should-not (member "cover.jpg" result)) + (should-not (member "info.pdf" result)) + (should (= (length result) 1)))) + (test-music-config--collect-entries-recursive-teardown))) + +(ert-deftest test-music-config--collect-entries-recursive-boundary-empty-directories-included () + "Empty subdirectories are still listed with trailing slash." + (test-music-config--collect-entries-recursive-setup) + (unwind-protect + (let* ((root-dir (cj/create-test-subdirectory "music"))) + ;; Empty subdirectories + (cj/create-directory-or-file-ensuring-parents "music/empty-artist/" "") + (cj/create-directory-or-file-ensuring-parents "music/another-empty/" "") + + (let ((result (cj/music--collect-entries-recursive root-dir))) + (should (member "empty-artist/" result)) + (should (member "another-empty/" result)) + (should (= (length result) 2)))) + (test-music-config--collect-entries-recursive-teardown))) + +(ert-deftest test-music-config--collect-entries-recursive-boundary-sorted-output () + "Output is sorted alphabetically (case-insensitive)." + (test-music-config--collect-entries-recursive-setup) + (unwind-protect + (let* ((root-dir (cj/create-test-subdirectory "music"))) + ;; Create files in non-alphabetical order + (cj/create-directory-or-file-ensuring-parents "music/zebra.mp3" "") + (cj/create-directory-or-file-ensuring-parents "music/Alpha.mp3" "") + (cj/create-directory-or-file-ensuring-parents "music/beta.mp3" "") + + (let ((result (cj/music--collect-entries-recursive root-dir))) + ;; Should be sorted alphabetically (case-insensitive) + (should (equal result '("Alpha.mp3" "beta.mp3" "zebra.mp3"))))) + (test-music-config--collect-entries-recursive-teardown))) + +(ert-deftest test-music-config--collect-entries-recursive-boundary-directories-have-trailing-slash () + "Directories have trailing slash, files don't." + (test-music-config--collect-entries-recursive-setup) + (unwind-protect + (let* ((root-dir (cj/create-test-subdirectory "music"))) + (cj/create-directory-or-file-ensuring-parents "music/artist/" "") + (cj/create-directory-or-file-ensuring-parents "music/song.mp3" "") + + (let ((result (cj/music--collect-entries-recursive root-dir))) + ;; Directory has trailing slash + (should (cl-some (lambda (entry) (string-suffix-p "/" entry)) result)) + ;; File doesn't have trailing slash + (should (cl-some (lambda (entry) (not (string-suffix-p "/" entry))) result)) + ;; Specifically check + (should (member "artist/" result)) + (should (member "song.mp3" result)) + (should-not (member "song.mp3/" result)))) + (test-music-config--collect-entries-recursive-teardown))) + +(ert-deftest test-music-config--collect-entries-recursive-boundary-all-music-extensions () + "All configured music extensions are collected." + (test-music-config--collect-entries-recursive-setup) + (unwind-protect + (let* ((root-dir (cj/create-test-subdirectory "music"))) + ;; Create file for each extension: aac, flac, m4a, mp3, ogg, opus, wav + (cj/create-directory-or-file-ensuring-parents "music/track.aac" "") + (cj/create-directory-or-file-ensuring-parents "music/track.flac" "") + (cj/create-directory-or-file-ensuring-parents "music/track.m4a" "") + (cj/create-directory-or-file-ensuring-parents "music/track.mp3" "") + (cj/create-directory-or-file-ensuring-parents "music/track.ogg" "") + (cj/create-directory-or-file-ensuring-parents "music/track.opus" "") + (cj/create-directory-or-file-ensuring-parents "music/track.wav" "") + + (let ((result (cj/music--collect-entries-recursive root-dir))) + (should (= (length result) 7)) + (should (member "track.aac" result)) + (should (member "track.flac" result)) + (should (member "track.m4a" result)) + (should (member "track.mp3" result)) + (should (member "track.ogg" result)) + (should (member "track.opus" result)) + (should (member "track.wav" result)))) + (test-music-config--collect-entries-recursive-teardown))) + +;;; Error Cases + +(ert-deftest test-music-config--collect-entries-recursive-error-empty-root-returns-empty () + "Empty root directory returns empty list." + (test-music-config--collect-entries-recursive-setup) + (unwind-protect + (let* ((root-dir (cj/create-test-subdirectory "empty-music"))) + (let ((result (cj/music--collect-entries-recursive root-dir))) + (should (null result)))) + (test-music-config--collect-entries-recursive-teardown))) + +(ert-deftest test-music-config--collect-entries-recursive-error-nonexistent-root-returns-empty () + "Nonexistent directory returns empty list." + (let ((result (cj/music--collect-entries-recursive "/nonexistent/path/to/music"))) + (should (null result)))) + +(provide 'test-music-config--collect-entries-recursive) +;;; test-music-config--collect-entries-recursive.el ends here diff --git a/tests/test-music-config--completion-table.el b/tests/test-music-config--completion-table.el new file mode 100644 index 00000000..5be0479d --- /dev/null +++ b/tests/test-music-config--completion-table.el @@ -0,0 +1,134 @@ +;;; test-music-config--completion-table.el --- Tests for completion table generation -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Unit tests for cj/music--completion-table function. +;; Tests the completion table generator that creates custom completion tables. +;; +;; Test organization: +;; - Normal Cases: Metadata, completions, case-insensitive matching +;; - Boundary Cases: Empty candidates, partial matching, exact matches +;; - Error Cases: Nil candidates +;; +;;; Code: + +(require 'ert) + +;; Stub missing dependencies before loading music-config +(defvar-keymap cj/custom-keymap + :doc "Stub keymap for testing") + +;; Load production code +(require 'music-config) + +;;; Normal Cases + +(ert-deftest test-music-config--completion-table-normal-metadata-action-returns-metadata () + "Completion table returns metadata when action is 'metadata." + (let* ((candidates '("Rock" "Jazz" "Classical")) + (table (cj/music--completion-table candidates)) + (result (funcall table "" nil 'metadata))) + (should (eq (car result) 'metadata)) + ;; Check metadata contains expected properties + (should (equal (alist-get 'display-sort-function (cdr result)) 'identity)) + (should (equal (alist-get 'cycle-sort-function (cdr result)) 'identity)) + (should (eq (alist-get 'completion-ignore-case (cdr result)) t)))) + +(ert-deftest test-music-config--completion-table-normal-t-action-returns-all-completions () + "Completion table returns all matching completions when action is t." + (let* ((candidates '("Rock" "Jazz" "Classical")) + (table (cj/music--completion-table candidates)) + (result (funcall table "" nil t))) + ;; Empty string should match all candidates + (should (equal (sort result #'string<) '("Classical" "Jazz" "Rock"))))) + +(ert-deftest test-music-config--completion-table-normal-nil-action-tries-completion () + "Completion table tries completion when action is nil." + (let* ((candidates '("Rock" "Jazz" "Classical")) + (table (cj/music--completion-table candidates)) + (result (funcall table "Roc" nil nil))) + ;; Should return completion attempt for "Roc" -> "Rock" + (should (stringp result)) + (should (string-prefix-p "Roc" result)))) + +(ert-deftest test-music-config--completion-table-normal-case-insensitive-metadata () + "Completion table metadata indicates case-insensitive completion." + (let* ((candidates '("Rock" "Jazz" "Classical")) + (table (cj/music--completion-table candidates)) + (metadata (funcall table "" nil 'metadata))) + ;; Metadata should indicate case-insensitive + (should (eq (alist-get 'completion-ignore-case (cdr metadata)) t)))) + +;;; Boundary Cases + +(ert-deftest test-music-config--completion-table-boundary-empty-candidates () + "Completion table with empty candidate list returns no completions." + (let* ((candidates '()) + (table (cj/music--completion-table candidates)) + (result (funcall table "anything" nil t))) + (should (null result)))) + +(ert-deftest test-music-config--completion-table-boundary-single-candidate () + "Completion table with single candidate returns it on match." + (let* ((candidates '("OnlyOne")) + (table (cj/music--completion-table candidates)) + (result (funcall table "Only" nil t))) + (should (equal result '("OnlyOne"))))) + +(ert-deftest test-music-config--completion-table-boundary-partial-matching () + "Completion table matches multiple candidates with common prefix." + (let* ((candidates '("playlist1" "playlist2" "jazz")) + (table (cj/music--completion-table candidates)) + (result (funcall table "play" nil t))) + (should (= (length result) 2)) + (should (member "playlist1" result)) + (should (member "playlist2" result)) + (should-not (member "jazz" result)))) + +(ert-deftest test-music-config--completion-table-boundary-no-matches () + "Completion table returns empty when no candidates match." + (let* ((candidates '("Rock" "Jazz" "Classical")) + (table (cj/music--completion-table candidates)) + (result (funcall table "Metal" nil t))) + (should (null result)))) + +(ert-deftest test-music-config--completion-table-boundary-exact-match () + "Completion table returns t for exact match with nil action." + (let* ((candidates '("Rock" "Jazz" "Classical")) + (table (cj/music--completion-table candidates)) + (result (funcall table "Jazz" nil nil))) + ;; Exact match with nil action returns t + (should (eq result t)))) + +(ert-deftest test-music-config--completion-table-boundary-mixed-case-candidates () + "Completion table with mixed-case duplicate candidates." + (let* ((candidates '("Rock" "ROCK" "rock")) + (table (cj/music--completion-table candidates)) + (result (funcall table "R" nil t))) + ;; All start with "R", but exact case matters for complete-with-action + ;; Only exact case match "R" prefix + (should (member "Rock" result)) + (should (member "ROCK" result)) + ;; "rock" doesn't match "R" prefix (lowercase) + (should-not (member "rock" result)))) + +(ert-deftest test-music-config--completion-table-boundary-unicode-candidates () + "Completion table handles unicode characters in candidates." + (let* ((candidates '("中文" "日本語" "한국어")) + (table (cj/music--completion-table candidates)) + (result (funcall table "中" nil t))) + (should (member "中文" result)))) + +;;; Error Cases + +(ert-deftest test-music-config--completion-table-error-nil-candidates-handles-gracefully () + "Completion table with nil candidates handles gracefully." + (let* ((candidates nil) + (table (cj/music--completion-table candidates)) + (result (funcall table "anything" nil t))) + ;; Should not crash, returns empty + (should (null result)))) + +(provide 'test-music-config--completion-table) +;;; test-music-config--completion-table.el ends here diff --git a/tests/test-music-config--get-m3u-basenames.el b/tests/test-music-config--get-m3u-basenames.el new file mode 100644 index 00000000..91c8af70 --- /dev/null +++ b/tests/test-music-config--get-m3u-basenames.el @@ -0,0 +1,121 @@ +;;; test-music-config--get-m3u-basenames.el --- Tests for M3U basename extraction -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Unit tests for cj/music--get-m3u-basenames function. +;; Tests the helper that extracts M3U basenames (without .m3u extension). +;; +;; Test organization: +;; - Normal Cases: Multiple files, single file +;; - Boundary Cases: Empty directory, extension removal +;; - Error Cases: Nonexistent directory +;; +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Stub missing dependencies before loading music-config +(defvar-keymap cj/custom-keymap + :doc "Stub keymap for testing") + +;; Load production code +(require 'music-config) + +;;; Setup & Teardown + +(defun test-music-config--get-m3u-basenames-setup () + "Setup test environment." + (cj/create-test-base-dir)) + +(defun test-music-config--get-m3u-basenames-teardown () + "Clean up test environment." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-music-config--get-m3u-basenames-normal-multiple-files-returns-basenames () + "Extract basenames from multiple M3U files without .m3u extension." + (test-music-config--get-m3u-basenames-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "playlists")) + (file1 (cj/create-temp-test-file-with-content "" "rock.m3u")) + (file2 (cj/create-temp-test-file-with-content "" "jazz.m3u")) + (file3 (cj/create-temp-test-file-with-content "" "classical.m3u"))) + (rename-file file1 (expand-file-name "rock.m3u" test-dir)) + (rename-file file2 (expand-file-name "jazz.m3u" test-dir)) + (rename-file file3 (expand-file-name "classical.m3u" test-dir)) + + (let ((cj/music-m3u-root test-dir)) + (let ((result (cj/music--get-m3u-basenames))) + (should (= (length result) 3)) + ;; Sort for consistent comparison + (let ((sorted-result (sort result #'string<))) + (should (equal sorted-result '("classical" "jazz" "rock"))))))) + (test-music-config--get-m3u-basenames-teardown))) + +(ert-deftest test-music-config--get-m3u-basenames-normal-single-file-returns-basename () + "Extract basename from single M3U file without .m3u extension." + (test-music-config--get-m3u-basenames-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "playlists")) + (file1 (cj/create-temp-test-file-with-content "" "favorites.m3u"))) + (rename-file file1 (expand-file-name "favorites.m3u" test-dir)) + + (let ((cj/music-m3u-root test-dir)) + (let ((result (cj/music--get-m3u-basenames))) + (should (= (length result) 1)) + (should (equal (car result) "favorites"))))) + (test-music-config--get-m3u-basenames-teardown))) + +;;; Boundary Cases + +(ert-deftest test-music-config--get-m3u-basenames-boundary-empty-directory-returns-empty () + "Extract basenames from empty directory returns empty list." + (test-music-config--get-m3u-basenames-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "empty-playlists"))) + (let ((cj/music-m3u-root test-dir)) + (let ((result (cj/music--get-m3u-basenames))) + (should (null result))))) + (test-music-config--get-m3u-basenames-teardown))) + +(ert-deftest test-music-config--get-m3u-basenames-boundary-extension-removed () + "Basenames have .m3u extension removed." + (test-music-config--get-m3u-basenames-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "playlists")) + (file1 (cj/create-temp-test-file-with-content "" "test.m3u"))) + (rename-file file1 (expand-file-name "playlist.m3u" test-dir)) + + (let ((cj/music-m3u-root test-dir)) + (let ((result (cj/music--get-m3u-basenames))) + (should (equal result '("playlist"))) + ;; Verify no .m3u extension present + (should-not (string-match-p "\\.m3u" (car result)))))) + (test-music-config--get-m3u-basenames-teardown))) + +(ert-deftest test-music-config--get-m3u-basenames-boundary-spaces-in-filename-preserved () + "Basenames with spaces preserve the spaces." + (test-music-config--get-m3u-basenames-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "playlists")) + (file1 (cj/create-temp-test-file-with-content "" "test.m3u"))) + (rename-file file1 (expand-file-name "My Favorite Songs.m3u" test-dir)) + + (let ((cj/music-m3u-root test-dir)) + (let ((result (cj/music--get-m3u-basenames))) + (should (equal result '("My Favorite Songs")))))) + (test-music-config--get-m3u-basenames-teardown))) + +;;; Error Cases + +(ert-deftest test-music-config--get-m3u-basenames-error-nonexistent-directory-signals-error () + "Nonexistent directory signals error." + (let ((cj/music-m3u-root "/nonexistent/directory/path")) + (should-error (cj/music--get-m3u-basenames) + :type 'file-error))) + +(provide 'test-music-config--get-m3u-basenames) +;;; test-music-config--get-m3u-basenames.el ends here diff --git a/tests/test-music-config--get-m3u-files.el b/tests/test-music-config--get-m3u-files.el new file mode 100644 index 00000000..2d31d554 --- /dev/null +++ b/tests/test-music-config--get-m3u-files.el @@ -0,0 +1,150 @@ +;;; test-music-config--get-m3u-files.el --- Tests for M3U file discovery -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Unit tests for cj/music--get-m3u-files function. +;; Tests the helper that discovers M3U files in the music directory. +;; +;; Test organization: +;; - Normal Cases: Multiple M3U files, single file +;; - Boundary Cases: Empty directory, non-M3U files, various filenames +;; - Error Cases: Nonexistent directory +;; +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Stub missing dependencies before loading music-config +(defvar-keymap cj/custom-keymap + :doc "Stub keymap for testing") + +;; Load production code +(require 'music-config) + +;;; Setup & Teardown + +(defun test-music-config--get-m3u-files-setup () + "Setup test environment." + (cj/create-test-base-dir)) + +(defun test-music-config--get-m3u-files-teardown () + "Clean up test environment." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-music-config--get-m3u-files-normal-multiple-files-returns-list () + "Discover multiple M3U files returns list of (basename . fullpath) conses." + (test-music-config--get-m3u-files-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "playlists")) + (file1 (cj/create-temp-test-file-with-content "" "playlist1.m3u")) + (file2 (cj/create-temp-test-file-with-content "" "playlist2.m3u")) + (file3 (cj/create-temp-test-file-with-content "" "playlist3.m3u"))) + ;; Move files to test-dir + (rename-file file1 (expand-file-name "playlist1.m3u" test-dir)) + (rename-file file2 (expand-file-name "playlist2.m3u" test-dir)) + (rename-file file3 (expand-file-name "playlist3.m3u" test-dir)) + + (let ((cj/music-m3u-root test-dir)) + (let ((result (cj/music--get-m3u-files))) + (should (= (length result) 3)) + ;; Check structure: list of (basename . fullpath) conses + ;; Sort for consistent comparison (directory-files order is filesystem-dependent) + (let ((basenames (sort (mapcar #'car result) #'string<)) + (fullpaths (sort (mapcar #'cdr result) #'string<))) + (should (equal basenames '("playlist1.m3u" "playlist2.m3u" "playlist3.m3u"))) + (should (equal fullpaths + (list (expand-file-name "playlist1.m3u" test-dir) + (expand-file-name "playlist2.m3u" test-dir) + (expand-file-name "playlist3.m3u" test-dir)))))))) + (test-music-config--get-m3u-files-teardown))) + +(ert-deftest test-music-config--get-m3u-files-normal-single-file-returns-list () + "Discover single M3U file returns single-item list." + (test-music-config--get-m3u-files-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "playlists")) + (file1 (cj/create-temp-test-file-with-content "" "myplaylist.m3u"))) + (rename-file file1 (expand-file-name "myplaylist.m3u" test-dir)) + + (let ((cj/music-m3u-root test-dir)) + (let ((result (cj/music--get-m3u-files))) + (should (= (length result) 1)) + (should (equal (caar result) "myplaylist.m3u")) + (should (equal (cdar result) (expand-file-name "myplaylist.m3u" test-dir)))))) + (test-music-config--get-m3u-files-teardown))) + +;;; Boundary Cases + +(ert-deftest test-music-config--get-m3u-files-boundary-empty-directory-returns-empty () + "Discover M3U files in empty directory returns empty list." + (test-music-config--get-m3u-files-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "empty-playlists"))) + (let ((cj/music-m3u-root test-dir)) + (let ((result (cj/music--get-m3u-files))) + (should (null result))))) + (test-music-config--get-m3u-files-teardown))) + +(ert-deftest test-music-config--get-m3u-files-boundary-non-m3u-files-ignored () + "Directory with non-M3U files returns empty list." + (test-music-config--get-m3u-files-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "mixed-files")) + (txt-file (cj/create-temp-test-file-with-content "" "readme.txt")) + (mp3-file (cj/create-temp-test-file-with-content "" "song.mp3")) + (json-file (cj/create-temp-test-file-with-content "" "data.json"))) + (rename-file txt-file (expand-file-name "readme.txt" test-dir)) + (rename-file mp3-file (expand-file-name "song.mp3" test-dir)) + (rename-file json-file (expand-file-name "data.json" test-dir)) + + (let ((cj/music-m3u-root test-dir)) + (let ((result (cj/music--get-m3u-files))) + (should (null result))))) + (test-music-config--get-m3u-files-teardown))) + +(ert-deftest test-music-config--get-m3u-files-boundary-m3u-with-spaces-included () + "M3U files with spaces in name are discovered." + (test-music-config--get-m3u-files-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "playlists")) + (file1 (cj/create-temp-test-file-with-content "" "my-playlist.m3u"))) + (rename-file file1 (expand-file-name "My Favorite Songs.m3u" test-dir)) + + (let ((cj/music-m3u-root test-dir)) + (let ((result (cj/music--get-m3u-files))) + (should (= (length result) 1)) + (should (equal (caar result) "My Favorite Songs.m3u"))))) + (test-music-config--get-m3u-files-teardown))) + +(ert-deftest test-music-config--get-m3u-files-boundary-mixed-m3u-and-other-files () + "Directory with both M3U and non-M3U files returns only M3U files." + (test-music-config--get-m3u-files-setup) + (unwind-protect + (let* ((test-dir (cj/create-test-subdirectory "mixed")) + (m3u-file (cj/create-temp-test-file-with-content "" "playlist.m3u")) + (txt-file (cj/create-temp-test-file-with-content "" "readme.txt")) + (mp3-file (cj/create-temp-test-file-with-content "" "song.mp3"))) + (rename-file m3u-file (expand-file-name "playlist.m3u" test-dir)) + (rename-file txt-file (expand-file-name "readme.txt" test-dir)) + (rename-file mp3-file (expand-file-name "song.mp3" test-dir)) + + (let ((cj/music-m3u-root test-dir)) + (let ((result (cj/music--get-m3u-files))) + (should (= (length result) 1)) + (should (equal (caar result) "playlist.m3u"))))) + (test-music-config--get-m3u-files-teardown))) + +;;; Error Cases + +(ert-deftest test-music-config--get-m3u-files-error-nonexistent-directory-signals-error () + "Nonexistent directory signals error." + (let ((cj/music-m3u-root "/nonexistent/directory/path")) + (should-error (cj/music--get-m3u-files) + :type 'file-error))) + +(provide 'test-music-config--get-m3u-files) +;;; test-music-config--get-m3u-files.el ends here diff --git a/tests/test-music-config--m3u-file-tracks.el b/tests/test-music-config--m3u-file-tracks.el new file mode 100644 index 00000000..badc9817 --- /dev/null +++ b/tests/test-music-config--m3u-file-tracks.el @@ -0,0 +1,193 @@ +;;; test-music-config--m3u-file-tracks.el --- Tests for M3U file parsing -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Unit tests for cj/music--m3u-file-tracks function. +;; Tests the M3U parser that extracts track paths from playlist files. +;; +;; Test organization: +;; - Normal Cases: Absolute paths, relative paths, URLs (http/https/mms) +;; - Boundary Cases: Empty lines, whitespace, comments, order preservation +;; - Error Cases: Nonexistent files, nil input +;; +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Stub missing dependencies before loading music-config +(defvar-keymap cj/custom-keymap + :doc "Stub keymap for testing") + +;; Load production code +(require 'music-config) + +;;; Setup & Teardown + +(defun test-music-config--m3u-file-tracks-setup () + "Setup test environment." + (cj/create-test-base-dir)) + +(defun test-music-config--m3u-file-tracks-teardown () + "Clean up test environment." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-music-config--m3u-file-tracks-normal-absolute-paths-returns-list () + "Parse M3U with absolute paths returns list in order." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content "/home/user/music/track1.mp3\n/home/user/music/track2.mp3\n/home/user/music/track3.mp3\n") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (equal tracks '("/home/user/music/track1.mp3" + "/home/user/music/track2.mp3" + "/home/user/music/track3.mp3")))) + (test-music-config--m3u-file-tracks-teardown))) + +(ert-deftest test-music-config--m3u-file-tracks-normal-relative-paths-expanded () + "Parse M3U with relative paths expands them relative to M3U directory." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content "artist/track1.mp3\nartist/track2.mp3\n") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (m3u-dir (file-name-directory m3u-file)) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (equal tracks (list (expand-file-name "artist/track1.mp3" m3u-dir) + (expand-file-name "artist/track2.mp3" m3u-dir))))) + (test-music-config--m3u-file-tracks-teardown))) + +(ert-deftest test-music-config--m3u-file-tracks-normal-http-urls-preserved () + "Parse M3U with http:// URLs preserves them as-is." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content "http://example.com/stream1.mp3\nhttp://example.com/stream2.mp3\n") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (equal tracks '("http://example.com/stream1.mp3" + "http://example.com/stream2.mp3")))) + (test-music-config--m3u-file-tracks-teardown))) + +(ert-deftest test-music-config--m3u-file-tracks-normal-https-urls-preserved () + "Parse M3U with https:// URLs preserves them as-is." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content "https://secure.example.com/stream.mp3\n") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (equal tracks '("https://secure.example.com/stream.mp3")))) + (test-music-config--m3u-file-tracks-teardown))) + +(ert-deftest test-music-config--m3u-file-tracks-normal-mms-urls-preserved () + "Parse M3U with mms:// URLs preserves them as-is." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content "mms://radio.example.com/stream\n") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (equal tracks '("mms://radio.example.com/stream")))) + (test-music-config--m3u-file-tracks-teardown))) + +(ert-deftest test-music-config--m3u-file-tracks-normal-mixed-paths-and-urls () + "Parse M3U with mix of absolute, relative, and URLs handles all correctly." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content "/home/user/music/local.mp3\nartist/relative.mp3\nhttp://example.com/stream.mp3\n") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (m3u-dir (file-name-directory m3u-file)) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (equal tracks (list "/home/user/music/local.mp3" + (expand-file-name "artist/relative.mp3" m3u-dir) + "http://example.com/stream.mp3")))) + (test-music-config--m3u-file-tracks-teardown))) + +;;; Boundary Cases + +(ert-deftest test-music-config--m3u-file-tracks-boundary-empty-lines-ignored () + "Parse M3U with empty lines ignores them and returns tracks." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content "/home/user/music/track1.mp3\n\n/home/user/music/track2.mp3\n\n\n/home/user/music/track3.mp3\n") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (equal tracks '("/home/user/music/track1.mp3" + "/home/user/music/track2.mp3" + "/home/user/music/track3.mp3")))) + (test-music-config--m3u-file-tracks-teardown))) + +(ert-deftest test-music-config--m3u-file-tracks-boundary-whitespace-only-lines-ignored () + "Parse M3U with whitespace-only lines ignores them." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content "/home/user/music/track1.mp3\n \n\t\t\n/home/user/music/track2.mp3\n") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (equal tracks '("/home/user/music/track1.mp3" + "/home/user/music/track2.mp3")))) + (test-music-config--m3u-file-tracks-teardown))) + +(ert-deftest test-music-config--m3u-file-tracks-boundary-comments-ignored () + "Parse M3U with comment lines ignores them, returns only tracks." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content "#EXTM3U\n#EXTINF:-1,Track Title\n/home/user/music/track.mp3\n#Another comment\n") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (equal tracks '("/home/user/music/track.mp3")))) + (test-music-config--m3u-file-tracks-teardown))) + +(ert-deftest test-music-config--m3u-file-tracks-boundary-leading-trailing-whitespace-trimmed () + "Parse M3U with whitespace around paths trims it." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content " /home/user/music/track1.mp3 \n\t/home/user/music/track2.mp3\t\n") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (equal tracks '("/home/user/music/track1.mp3" + "/home/user/music/track2.mp3")))) + (test-music-config--m3u-file-tracks-teardown))) + +(ert-deftest test-music-config--m3u-file-tracks-boundary-empty-file-returns-nil () + "Parse empty M3U file returns nil." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content "") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (null tracks))) + (test-music-config--m3u-file-tracks-teardown))) + +(ert-deftest test-music-config--m3u-file-tracks-boundary-only-comments-returns-empty () + "Parse M3U with only comments returns empty list." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content "#EXTM3U\n#EXTINF:-1,Title\n#Another comment\n") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (null tracks))) + (test-music-config--m3u-file-tracks-teardown))) + +(ert-deftest test-music-config--m3u-file-tracks-boundary-preserves-order () + "Parse M3U preserves track order (tests nreverse)." + (test-music-config--m3u-file-tracks-setup) + (unwind-protect + (let* ((content "/track1.mp3\n/track2.mp3\n/track3.mp3\n/track4.mp3\n/track5.mp3\n") + (m3u-file (cj/create-temp-test-file-with-content content "test.m3u")) + (tracks (cj/music--m3u-file-tracks m3u-file))) + (should (equal tracks '("/track1.mp3" "/track2.mp3" "/track3.mp3" "/track4.mp3" "/track5.mp3")))) + (test-music-config--m3u-file-tracks-teardown))) + +;;; Error Cases + +(ert-deftest test-music-config--m3u-file-tracks-error-nonexistent-file-returns-nil () + "Parse nonexistent file returns nil." + (should (null (cj/music--m3u-file-tracks "/nonexistent/path/playlist.m3u")))) + +(ert-deftest test-music-config--m3u-file-tracks-error-nil-input-returns-nil () + "Parse nil input returns nil gracefully." + (should (null (cj/music--m3u-file-tracks nil)))) + +(provide 'test-music-config--m3u-file-tracks) +;;; test-music-config--m3u-file-tracks.el ends here diff --git a/tests/test-music-config--safe-filename.el b/tests/test-music-config--safe-filename.el new file mode 100644 index 00000000..8105ee15 --- /dev/null +++ b/tests/test-music-config--safe-filename.el @@ -0,0 +1,97 @@ +;;; test-music-config--safe-filename.el --- Tests for filename sanitization -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Unit tests for cj/music--safe-filename function. +;; Tests the pure helper that sanitizes filenames by replacing invalid chars. +;; +;; Test organization: +;; - Normal Cases: Valid filenames unchanged, spaces replaced +;; - Boundary Cases: Special chars, unicode, slashes, consecutive invalid chars +;; - Error Cases: Nil input +;; +;;; Code: + +(require 'ert) + +;; Stub missing dependencies before loading music-config +(defvar-keymap cj/custom-keymap + :doc "Stub keymap for testing") + +;; Load production code +(require 'music-config) + +;;; Normal Cases + +(ert-deftest test-music-config--safe-filename-normal-alphanumeric-unchanged () + "Validate alphanumeric filename remains unchanged." + (should (string= (cj/music--safe-filename "MyPlaylist123") + "MyPlaylist123"))) + +(ert-deftest test-music-config--safe-filename-normal-with-hyphens-unchanged () + "Validate filename with hyphens remains unchanged." + (should (string= (cj/music--safe-filename "my-playlist-name") + "my-playlist-name"))) + +(ert-deftest test-music-config--safe-filename-normal-with-underscores-unchanged () + "Validate filename with underscores remains unchanged." + (should (string= (cj/music--safe-filename "my_playlist_name") + "my_playlist_name"))) + +(ert-deftest test-music-config--safe-filename-normal-spaces-replaced () + "Validate spaces are replaced with underscores." + (should (string= (cj/music--safe-filename "My Favorite Songs") + "My_Favorite_Songs"))) + +;;; Boundary Cases + +(ert-deftest test-music-config--safe-filename-boundary-special-chars-replaced () + "Validate special characters are replaced with underscores." + (should (string= (cj/music--safe-filename "playlist@#$%^&*()") + "playlist_________"))) + +(ert-deftest test-music-config--safe-filename-boundary-unicode-replaced () + "Validate unicode characters are replaced with underscores." + (should (string= (cj/music--safe-filename "中文歌曲") + "____"))) + +(ert-deftest test-music-config--safe-filename-boundary-mixed-valid-invalid () + "Validate mixed valid and invalid characters." + (should (string= (cj/music--safe-filename "Rock & Roll") + "Rock___Roll"))) + +(ert-deftest test-music-config--safe-filename-boundary-dots-replaced () + "Validate dots are replaced with underscores." + (should (string= (cj/music--safe-filename "my.playlist.name") + "my_playlist_name"))) + +(ert-deftest test-music-config--safe-filename-boundary-slashes-replaced () + "Validate slashes are replaced with underscores." + (should (string= (cj/music--safe-filename "folder/file") + "folder_file"))) + +(ert-deftest test-music-config--safe-filename-boundary-consecutive-invalid-chars () + "Validate consecutive invalid characters each become underscores." + (should (string= (cj/music--safe-filename "test!!!name") + "test___name"))) + +(ert-deftest test-music-config--safe-filename-boundary-empty-string-unchanged () + "Validate empty string remains unchanged." + (should (string= (cj/music--safe-filename "") + ""))) + +(ert-deftest test-music-config--safe-filename-boundary-only-invalid-chars () + "Validate string with only invalid characters becomes all underscores." + (should (string= (cj/music--safe-filename "!@#$%") + "_____"))) + +;;; Error Cases + +(ert-deftest test-music-config--safe-filename-error-nil-input-signals-error () + "Validate nil input signals error." + (should-error (cj/music--safe-filename nil) + :type 'wrong-type-argument)) + +(provide 'test-music-config--safe-filename) +;;; test-music-config--safe-filename.el ends here diff --git a/tests/test-music-config--valid-directory-p.el b/tests/test-music-config--valid-directory-p.el new file mode 100644 index 00000000..21c2b240 --- /dev/null +++ b/tests/test-music-config--valid-directory-p.el @@ -0,0 +1,139 @@ +;;; test-music-config--valid-directory-p.el --- Tests for directory validation -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Unit tests for cj/music--valid-directory-p function. +;; Tests the pure helper that validates non-hidden directories. +;; +;; Test organization: +;; - Normal Cases: Valid visible directories +;; - Boundary Cases: Trailing slashes, dots in names, hidden directories +;; - Error Cases: Files (not dirs), nonexistent paths, nil input +;; +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Stub missing dependencies before loading music-config +(defvar-keymap cj/custom-keymap + :doc "Stub keymap for testing") + +;; Load production code +(require 'music-config) + +;;; Setup & Teardown + +(defun test-music-config--valid-directory-p-setup () + "Setup test environment." + (cj/create-test-base-dir)) + +(defun test-music-config--valid-directory-p-teardown () + "Clean up test environment." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-music-config--valid-directory-p-normal-visible-directory-returns-true () + "Validate visible directory returns non-nil." + (test-music-config--valid-directory-p-setup) + (unwind-protect + (let ((test-dir (cj/create-test-subdirectory "testdir"))) + (should (cj/music--valid-directory-p test-dir))) + (test-music-config--valid-directory-p-teardown))) + +(ert-deftest test-music-config--valid-directory-p-normal-nested-directory-returns-true () + "Validate nested visible directory returns non-nil." + (test-music-config--valid-directory-p-setup) + (unwind-protect + (let ((test-dir (cj/create-test-subdirectory "testdir/subdir/nested"))) + (should (cj/music--valid-directory-p test-dir))) + (test-music-config--valid-directory-p-teardown))) + +;;; Boundary Cases + +(ert-deftest test-music-config--valid-directory-p-boundary-trailing-slash-returns-true () + "Validate directory with trailing slash returns non-nil." + (test-music-config--valid-directory-p-setup) + (unwind-protect + (let ((test-dir (cj/create-test-subdirectory "testdir"))) + (should (cj/music--valid-directory-p (file-name-as-directory test-dir)))) + (test-music-config--valid-directory-p-teardown))) + +(ert-deftest test-music-config--valid-directory-p-boundary-no-trailing-slash-returns-true () + "Validate directory without trailing slash returns non-nil." + (test-music-config--valid-directory-p-setup) + (unwind-protect + (let ((test-dir (cj/create-test-subdirectory "testdir"))) + (should (cj/music--valid-directory-p (directory-file-name test-dir)))) + (test-music-config--valid-directory-p-teardown))) + +(ert-deftest test-music-config--valid-directory-p-boundary-dot-in-middle-returns-true () + "Validate directory with dot in middle of name returns non-nil." + (test-music-config--valid-directory-p-setup) + (unwind-protect + (let ((test-dir (cj/create-test-subdirectory "my.music.dir"))) + (should (cj/music--valid-directory-p test-dir))) + (test-music-config--valid-directory-p-teardown))) + +(ert-deftest test-music-config--valid-directory-p-boundary-hidden-directory-returns-nil () + "Validate hidden directory (starting with dot) returns nil." + (test-music-config--valid-directory-p-setup) + (unwind-protect + (let ((test-dir (cj/create-test-subdirectory ".hidden"))) + (should-not (cj/music--valid-directory-p test-dir))) + (test-music-config--valid-directory-p-teardown))) + +(ert-deftest test-music-config--valid-directory-p-boundary-current-dir-dot-returns-nil () + "Validate current directory '.' returns nil (hidden)." + (test-music-config--valid-directory-p-setup) + (unwind-protect + (let ((test-dir (cj/create-test-subdirectory "testdir"))) + ;; Change to test dir and check "." + (let ((default-directory test-dir)) + (should-not (cj/music--valid-directory-p ".")))) + (test-music-config--valid-directory-p-teardown))) + +(ert-deftest test-music-config--valid-directory-p-boundary-parent-dir-dotdot-returns-nil () + "Validate parent directory '..' returns nil (hidden)." + (test-music-config--valid-directory-p-setup) + (unwind-protect + (let ((test-dir (cj/create-test-subdirectory "testdir/subdir"))) + ;; Change to subdir and check ".." + (let ((default-directory test-dir)) + (should-not (cj/music--valid-directory-p "..")))) + (test-music-config--valid-directory-p-teardown))) + +(ert-deftest test-music-config--valid-directory-p-boundary-hidden-subdir-basename-check () + "Validate hidden subdirectory returns nil based on basename." + (test-music-config--valid-directory-p-setup) + (unwind-protect + (let ((hidden-dir (cj/create-test-subdirectory "visible/.hidden"))) + (should-not (cj/music--valid-directory-p hidden-dir))) + (test-music-config--valid-directory-p-teardown))) + +;;; Error Cases + +(ert-deftest test-music-config--valid-directory-p-error-regular-file-returns-nil () + "Validate regular file (not directory) returns nil." + (test-music-config--valid-directory-p-setup) + (unwind-protect + (let ((test-file (cj/create-temp-test-file "testfile-"))) + (should-not (cj/music--valid-directory-p test-file))) + (test-music-config--valid-directory-p-teardown))) + +(ert-deftest test-music-config--valid-directory-p-error-nonexistent-path-returns-nil () + "Validate nonexistent path returns nil." + (should-not (cj/music--valid-directory-p "/nonexistent/path/to/directory"))) + +(ert-deftest test-music-config--valid-directory-p-error-nil-input-returns-nil () + "Validate nil input returns nil gracefully." + (should-not (cj/music--valid-directory-p nil))) + +(ert-deftest test-music-config--valid-directory-p-error-empty-string-returns-nil () + "Validate empty string returns nil." + (should-not (cj/music--valid-directory-p ""))) + +(provide 'test-music-config--valid-directory-p) +;;; test-music-config--valid-directory-p.el ends here diff --git a/tests/test-music-config--valid-file-p.el b/tests/test-music-config--valid-file-p.el new file mode 100644 index 00000000..8099c50c --- /dev/null +++ b/tests/test-music-config--valid-file-p.el @@ -0,0 +1,99 @@ +;;; test-music-config--valid-file-p.el --- Tests for music file validation -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Unit tests for cj/music--valid-file-p function. +;; Tests the pure, deterministic helper that validates music file extensions. +;; +;; Test organization: +;; - Normal Cases: Valid music extensions (case-insensitive) +;; - Boundary Cases: Edge conditions (no extension, dots in path, empty strings) +;; - Error Cases: Invalid extensions, nil input +;; +;;; Code: + +(require 'ert) + +;; Stub missing dependencies before loading music-config +(defvar-keymap cj/custom-keymap + :doc "Stub keymap for testing") + +;; Load production code +(require 'music-config) + +;;; Normal Cases + +(ert-deftest test-music-config--valid-file-p-normal-mp3-extension-returns-true () + "Validate mp3 file extension returns non-nil." + (should (cj/music--valid-file-p "/path/to/song.mp3"))) + +(ert-deftest test-music-config--valid-file-p-normal-flac-extension-returns-true () + "Validate flac file extension returns non-nil." + (should (cj/music--valid-file-p "/path/to/song.flac"))) + +(ert-deftest test-music-config--valid-file-p-normal-all-extensions-return-true () + "Validate all configured music extensions return non-nil." + ;; Test each extension from cj/music-file-extensions + (dolist (ext '("aac" "flac" "m4a" "mp3" "ogg" "opus" "wav")) + (should (cj/music--valid-file-p (format "/path/to/song.%s" ext))))) + +(ert-deftest test-music-config--valid-file-p-normal-uppercase-extension-returns-true () + "Validate uppercase extension returns non-nil (case-insensitive)." + (should (cj/music--valid-file-p "/path/to/song.MP3"))) + +(ert-deftest test-music-config--valid-file-p-normal-mixed-case-extension-returns-true () + "Validate mixed-case extension returns non-nil (case-insensitive)." + (should (cj/music--valid-file-p "/path/to/song.Mp3")) + (should (cj/music--valid-file-p "/path/to/song.FLaC"))) + +;;; Boundary Cases + +(ert-deftest test-music-config--valid-file-p-boundary-dots-in-path-returns-true () + "Validate file with dots in directory path uses only last extension." + (should (cj/music--valid-file-p "/path/with.dots/in.directory/song.mp3"))) + +(ert-deftest test-music-config--valid-file-p-boundary-multiple-extensions-uses-last () + "Validate file with multiple extensions uses rightmost extension." + (should (cj/music--valid-file-p "/path/to/song.backup.mp3")) + (should (cj/music--valid-file-p "/path/to/song.old.flac"))) + +(ert-deftest test-music-config--valid-file-p-boundary-just-filename-with-extension-returns-true () + "Validate bare filename without path returns non-nil." + (should (cj/music--valid-file-p "song.mp3"))) + +(ert-deftest test-music-config--valid-file-p-boundary-no-extension-returns-nil () + "Validate file without extension returns nil." + (should-not (cj/music--valid-file-p "/path/to/song"))) + +(ert-deftest test-music-config--valid-file-p-boundary-dot-at-end-returns-nil () + "Validate file ending with dot (empty extension) returns nil." + (should-not (cj/music--valid-file-p "/path/to/song."))) + +(ert-deftest test-music-config--valid-file-p-boundary-empty-string-returns-nil () + "Validate empty string returns nil." + (should-not (cj/music--valid-file-p ""))) + +;;; Error Cases + +(ert-deftest test-music-config--valid-file-p-error-nil-input-returns-nil () + "Validate nil input returns nil gracefully." + (should-not (cj/music--valid-file-p nil))) + +(ert-deftest test-music-config--valid-file-p-error-non-music-extension-returns-nil () + "Validate non-music file extension returns nil." + (should-not (cj/music--valid-file-p "/path/to/document.txt")) + (should-not (cj/music--valid-file-p "/path/to/readme.md"))) + +(ert-deftest test-music-config--valid-file-p-error-image-extension-returns-nil () + "Validate image file extension returns nil." + (should-not (cj/music--valid-file-p "/path/to/cover.jpg")) + (should-not (cj/music--valid-file-p "/path/to/artwork.png"))) + +(ert-deftest test-music-config--valid-file-p-error-video-extension-returns-nil () + "Validate video file extension returns nil (mp4 not in list, only m4a)." + (should-not (cj/music--valid-file-p "/path/to/video.mp4")) + (should-not (cj/music--valid-file-p "/path/to/clip.mkv"))) + +(provide 'test-music-config--valid-file-p) +;;; test-music-config--valid-file-p.el ends here diff --git a/tests/test-org-agenda-build-list.el b/tests/test-org-agenda-build-list.el new file mode 100644 index 00000000..6b424200 --- /dev/null +++ b/tests/test-org-agenda-build-list.el @@ -0,0 +1,294 @@ +;;; test-org-agenda-build-list.el --- Tests for cj/build-org-agenda-list -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/build-org-agenda-list caching logic. +;; Tests cache behavior, TTL expiration, force rebuild, and async build flag. + +;;; Code: + +(require 'ert) + +;; Add modules to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar inbox-file "/tmp/test-inbox.org") +(defvar schedule-file "/tmp/test-schedule.org") +(defvar gcal-file "/tmp/test-gcal.org") +(defvar projects-dir "/tmp/test-projects/") + +;; Now load the actual production module +(require 'org-agenda-config) + +;;; Setup and Teardown + +(defun test-org-agenda-setup () + "Reset cache and state before each test." + (setq cj/org-agenda-files-cache nil) + (setq cj/org-agenda-files-cache-time nil) + (setq cj/org-agenda-files-building nil) + (setq org-agenda-files nil)) + +(defun test-org-agenda-teardown () + "Clean up after each test." + (setq cj/org-agenda-files-cache nil) + (setq cj/org-agenda-files-cache-time nil) + (setq cj/org-agenda-files-building nil) + (setq org-agenda-files nil)) + +;;; Normal Cases + +(ert-deftest test-org-agenda-build-list-normal-first-call-builds-cache () + "Test that first call builds cache from scratch. + +When cache is empty, function should: +1. Scan directory for todo.org files +2. Build agenda files list +3. Populate cache +4. Set cache timestamp" + (test-org-agenda-setup) + (unwind-protect + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern &optional _include-dirs) '("/tmp/project/todo.org")))) + + ;; Before call: cache empty + (should (null cj/org-agenda-files-cache)) + (should (null cj/org-agenda-files-cache-time)) + + ;; Build agenda files + (cj/build-org-agenda-list) + + ;; After call: cache populated + (should cj/org-agenda-files-cache) + (should cj/org-agenda-files-cache-time) + (should org-agenda-files) + + ;; Cache matches org-agenda-files + (should (equal cj/org-agenda-files-cache org-agenda-files)) + + ;; Contains base files (inbox, schedule, gcal) plus project files + (should (>= (length org-agenda-files) 3))) + (test-org-agenda-teardown))) + +(ert-deftest test-org-agenda-build-list-normal-second-call-uses-cache () + "Test that second call uses cache instead of rebuilding. + +When cache is valid (not expired): +1. Should NOT scan directories again +2. Should restore files from cache +3. Should NOT update cache timestamp" + (test-org-agenda-setup) + (unwind-protect + (let ((scan-count 0)) + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern &optional _include-dirs) + (setq scan-count (1+ scan-count)) + '("/tmp/project/todo.org")))) + + ;; First call: builds cache + (cj/build-org-agenda-list) + (should (= scan-count 1)) ; 1 directory scanned + + (let ((cached-time cj/org-agenda-files-cache-time) + (cached-files cj/org-agenda-files-cache)) + + ;; Second call: uses cache + (cj/build-org-agenda-list) + + ;; Scan count unchanged (cache hit) + (should (= scan-count 1)) + + ;; Cache unchanged + (should (equal cj/org-agenda-files-cache-time cached-time)) + (should (equal cj/org-agenda-files-cache cached-files))))) + (test-org-agenda-teardown))) + +(ert-deftest test-org-agenda-build-list-normal-force-rebuild-bypasses-cache () + "Test that force-rebuild parameter bypasses cache. + +When force-rebuild is non-nil: +1. Should ignore valid cache +2. Should rebuild from scratch +3. Should update cache with new data" + (test-org-agenda-setup) + (unwind-protect + (let ((scan-count 0)) + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern &optional _include-dirs) + (setq scan-count (1+ scan-count)) + (if (> scan-count 1) + '("/tmp/project/todo.org" "/tmp/project2/todo.org") ; New file on rebuild + '("/tmp/project/todo.org"))))) + + ;; First call: builds cache + (cj/build-org-agenda-list) + (let ((initial-count (length org-agenda-files))) + + ;; Force rebuild + (cj/build-org-agenda-list 'force) + + ;; Scanned again + (should (= scan-count 2)) + + ;; New files include additional project + (should (> (length org-agenda-files) initial-count))))) + (test-org-agenda-teardown))) + +;;; Boundary Cases + +(ert-deftest test-org-agenda-build-list-boundary-cache-expires-after-ttl () + "Test that cache expires after TTL period. + +When cache timestamp exceeds TTL: +1. Should rebuild files list +2. Should update cache timestamp +3. Should rescan directory" + (test-org-agenda-setup) + (unwind-protect + (let ((scan-count 0)) + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern &optional _include-dirs) + (setq scan-count (1+ scan-count)) + '("/tmp/project/todo.org")))) + + ;; First call: builds cache + (cj/build-org-agenda-list) + (should (= scan-count 1)) + + ;; Simulate cache expiration (set time to 2 hours ago) + (setq cj/org-agenda-files-cache-time + (- (float-time) (* 2 3600))) + + ;; Second call: cache expired, rebuild + (cj/build-org-agenda-list) + + ;; Scanned again (cache was expired) + (should (= scan-count 2)) + + ;; Cache timestamp updated to current time + (should (< (- (float-time) cj/org-agenda-files-cache-time) 1)))) + (test-org-agenda-teardown))) + +(ert-deftest test-org-agenda-build-list-boundary-empty-directory-creates-minimal-list () + "Test behavior when directory contains no todo.org files. + +When directory scan returns empty: +1. Should still create base files (inbox, schedule) +2. Should not fail or error +3. Should cache the minimal result" + (test-org-agenda-setup) + (unwind-protect + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern &optional _include-dirs) nil))) ; No files found + + (cj/build-org-agenda-list) + + ;; Should have base files only (inbox, schedule, gcal) + (should (= (length org-agenda-files) 3)) + + ;; Cache should contain base files + (should cj/org-agenda-files-cache) + (should (= (length cj/org-agenda-files-cache) 3))) + (test-org-agenda-teardown))) + +(ert-deftest test-org-agenda-build-list-boundary-building-flag-set-during-build () + "Test that building flag is set during build and cleared after. + +During build: +1. Flag should be set to prevent concurrent builds +2. Flag should clear even if build fails +3. Flag state should be consistent" + (test-org-agenda-setup) + (unwind-protect + (let ((flag-during-build nil)) + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern &optional _include-dirs) + ;; Capture flag state during directory scan + (setq flag-during-build cj/org-agenda-files-building) + '("/tmp/project/todo.org")))) + + ;; Before build + (should (null cj/org-agenda-files-building)) + + ;; Build + (cj/build-org-agenda-list) + + ;; Flag was set during build + (should flag-during-build) + + ;; Flag cleared after build + (should (null cj/org-agenda-files-building)))) + (test-org-agenda-teardown))) + +(ert-deftest test-org-agenda-build-list-boundary-building-flag-clears-on-error () + "Test that building flag clears even if build errors. + +When build encounters error: +1. Flag should still be cleared (unwind-protect) +2. Prevents permanently locked state +3. Next build can proceed" + (test-org-agenda-setup) + (unwind-protect + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern &optional _include-dirs) + (error "Simulated scan failure")))) + + ;; Build will error + (should-error (cj/build-org-agenda-list)) + + ;; Flag cleared despite error (unwind-protect) + (should (null cj/org-agenda-files-building))) + (test-org-agenda-teardown))) + +;;; Error Cases + +(ert-deftest test-org-agenda-build-list-error-nil-cache-with-old-timestamp () + "Test handling of inconsistent state (nil cache but timestamp set). + +When cache is nil but timestamp exists: +1. Should recognize cache as invalid +2. Should rebuild files list +3. Should set both cache and timestamp" + (test-org-agenda-setup) + (unwind-protect + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern &optional _include-dirs) '("/tmp/project/todo.org")))) + + ;; Set inconsistent state + (setq cj/org-agenda-files-cache nil) + (setq cj/org-agenda-files-cache-time (float-time)) + + ;; Build should recognize invalid state + (cj/build-org-agenda-list) + + ;; Cache now populated + (should cj/org-agenda-files-cache) + (should cj/org-agenda-files-cache-time) + (should org-agenda-files)) + (test-org-agenda-teardown))) + +(ert-deftest test-org-agenda-build-list-error-directory-scan-failure-propagates () + "Test that directory scan failures propagate as errors. + +When directory-files-recursively errors: +1. Error should propagate to caller +2. Cache should not be corrupted +3. Building flag should clear" + (test-org-agenda-setup) + (unwind-protect + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern &optional _include-dirs) + (error "Permission denied")))) + + ;; Should propagate error + (should-error (cj/build-org-agenda-list)) + + ;; Cache not corrupted (still nil) + (should (null cj/org-agenda-files-cache)) + + ;; Building flag cleared + (should (null cj/org-agenda-files-building))) + (test-org-agenda-teardown))) + +(provide 'test-org-agenda-build-list) +;;; test-org-agenda-build-list.el ends here diff --git a/tests/test-org-contacts-capture-finalize.el b/tests/test-org-contacts-capture-finalize.el new file mode 100644 index 00000000..6793defe --- /dev/null +++ b/tests/test-org-contacts-capture-finalize.el @@ -0,0 +1,178 @@ +;;; test-org-contacts-capture-finalize.el --- Tests for org-contacts capture template finalization -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;;; Commentary: + +;; Unit tests for the org-contacts capture template finalization function +;; that automatically inserts birthday timestamps. + +;;; Code: + +;; Initialize package system for batch mode +(when noninteractive + (package-initialize)) + +(require 'ert) +(require 'org) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar contacts-file "/tmp/test-contacts.org" + "Stub contacts file for testing.") + +;; Declare org-capture-plist for dynamic scoping in tests +(defvar org-capture-plist nil + "Plist that org-capture uses during capture. Declared for testing.") + +;; Load the actual module +(require 'org-contacts-config) + +;;; Tests for birthday timestamp finalization + +(ert-deftest test-contacts-capture-finalize-with-full-birthday () + "Test that finalize adds timestamp for YYYY-MM-DD birthday." + (with-temp-buffer + (org-mode) + (insert "* Alice Anderson\n") + (insert ":PROPERTIES:\n") + (insert ":EMAIL: alice@example.com\n") + (insert ":BIRTHDAY: 1985-03-15\n") + (insert ":END:\n") + (insert "Added: [2025-11-01 Fri 20:30]\n") + + ;; Simulate capture context + (let ((org-capture-plist '(:key "C"))) + (cj/org-contacts-finalize-birthday-timestamp) + + (let ((content (buffer-string))) + ;; Should have birthday timestamp + (should (string-match-p "<1985-03-15 [A-Za-z]\\{3\\} \\+1y>" content)) + ;; Timestamp should be after :END: + (should (string-match-p ":END:\n<1985-03-15" content)))))) + +(ert-deftest test-contacts-capture-finalize-with-partial-birthday () + "Test that finalize adds timestamp for MM-DD birthday with current year." + (let ((current-year (nth 5 (decode-time)))) + (with-temp-buffer + (org-mode) + (insert "* Bob Baker\n") + (insert ":PROPERTIES:\n") + (insert ":BIRTHDAY: 07-04\n") + (insert ":END:\n") + + (let ((org-capture-plist '(:key "C"))) + (cj/org-contacts-finalize-birthday-timestamp) + + (let ((content (buffer-string))) + ;; Should have birthday timestamp with current year + (should (string-match-p (format "<%d-07-04 [A-Za-z]\\{3\\} \\+1y>" current-year) content))))))) + +(ert-deftest test-contacts-capture-finalize-without-birthday () + "Test that finalize does nothing when no birthday property." + (with-temp-buffer + (org-mode) + (insert "* Carol Chen\n") + (insert ":PROPERTIES:\n") + (insert ":EMAIL: carol@example.com\n") + (insert ":END:\n") + + (let ((original-content (buffer-string)) + (org-capture-plist '(:key "C"))) + (cj/org-contacts-finalize-birthday-timestamp) + + ;; Content should be unchanged + (should (string= (buffer-string) original-content)) + ;; Should have no timestamp + (should-not (string-match-p "<[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" (buffer-string)))))) + +(ert-deftest test-contacts-capture-finalize-with-empty-birthday () + "Test that finalize skips empty birthday values." + (with-temp-buffer + (org-mode) + (insert "* David Davis\n") + (insert ":PROPERTIES:\n") + (insert ":BIRTHDAY: \n") + (insert ":END:\n") + + (let ((original-content (buffer-string)) + (org-capture-plist '(:key "C"))) + (cj/org-contacts-finalize-birthday-timestamp) + + ;; Content should be unchanged + (should (string= (buffer-string) original-content)) + ;; Should have no timestamp + (should-not (string-match-p "<[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" (buffer-string)))))) + +(ert-deftest test-contacts-capture-finalize-prevents-duplicates () + "Test that finalize doesn't add duplicate timestamps." + (with-temp-buffer + (org-mode) + (insert "* Eve Evans\n") + (insert ":PROPERTIES:\n") + (insert ":BIRTHDAY: 2000-01-01\n") + (insert ":END:\n") + (insert "<2000-01-01 Sat +1y>\n") + + (let ((org-capture-plist '(:key "C"))) + (cj/org-contacts-finalize-birthday-timestamp) + + ;; Should have exactly one timestamp + (should (= 1 (how-many "<2000-01-01 [A-Za-z]\\{3\\} \\+1y>" (point-min) (point-max))))))) + +(ert-deftest test-contacts-capture-finalize-only-for-contact-template () + "Test that finalize only runs for 'C' template key." + (with-temp-buffer + (org-mode) + (insert "* Task with birthday property\n") + (insert ":PROPERTIES:\n") + (insert ":BIRTHDAY: 2000-01-01\n") + (insert ":END:\n") + + (let ((original-content (buffer-string)) + (org-capture-plist '(:key "t"))) ; Different template key + (cj/org-contacts-finalize-birthday-timestamp) + + ;; Content should be unchanged + (should (string= (buffer-string) original-content))))) + +(ert-deftest test-contacts-capture-finalize-preserves-existing-content () + "Test that finalize preserves all existing content." + (with-temp-buffer + (org-mode) + (insert "* Alice Anderson\n") + (insert ":PROPERTIES:\n") + (insert ":EMAIL: alice@example.com\n") + (insert ":PHONE: 555-1234\n") + (insert ":BIRTHDAY: 1985-03-15\n") + (insert ":NICKNAME: Ali\n") + (insert ":NOTE: Met at conference\n") + (insert ":END:\n") + (insert "Added: [2025-11-01 Fri 20:30]\n") + + (let ((org-capture-plist '(:key "C"))) + (cj/org-contacts-finalize-birthday-timestamp) + + (let ((content (buffer-string))) + ;; All properties should still be present + (should (string-search ":EMAIL: alice@example.com" content)) + (should (string-search ":PHONE: 555-1234" content)) + (should (string-search ":BIRTHDAY: 1985-03-15" content)) + (should (string-search ":NICKNAME: Ali" content)) + (should (string-search ":NOTE: Met at conference" content)) + ;; Added timestamp should still be there + (should (string-search "Added: [2025-11-01 Fri 20:30]" content)) + ;; Birthday timestamp should be added + (should (string-match-p "<1985-03-15 [A-Za-z]\\{3\\} \\+1y>" content)))))) + +(provide 'test-org-contacts-capture-finalize) +;;; test-org-contacts-capture-finalize.el ends here diff --git a/tests/test-org-contacts-parse-email.el b/tests/test-org-contacts-parse-email.el new file mode 100644 index 00000000..37e79fba --- /dev/null +++ b/tests/test-org-contacts-parse-email.el @@ -0,0 +1,219 @@ +;;; test-org-contacts-parse-email.el --- Tests for cj/--parse-email-string -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--parse-email-string function from org-contacts-config.el +;; +;; This function parses a string containing one or more email addresses +;; separated by commas, semicolons, or spaces, and formats them as +;; "Name <email>" strings. +;; +;; Examples: +;; Input: name="John Doe", email-string="john@example.com" +;; Output: '("John Doe <john@example.com>") +;; +;; Input: name="Jane Smith", email-string="jane@work.com, jane@home.com" +;; Output: '("Jane Smith <jane@work.com>" "Jane Smith <jane@home.com>") + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Now load the actual production module +(require 'org-contacts-config) + +;;; Test Helpers + +(defun test-parse-email (name email-string) + "Test cj/--parse-email-string with NAME and EMAIL-STRING. +Returns the formatted email list." + (cj/--parse-email-string name email-string)) + +;;; Normal Cases - Single Email + +(ert-deftest test-parse-single-email () + "Should format single email address." + (let ((result (test-parse-email "John Doe" "john@example.com"))) + (should (equal result '("John Doe <john@example.com>"))))) + +(ert-deftest test-parse-single-email-with-subdomain () + "Should handle email with subdomain." + (let ((result (test-parse-email "Jane Smith" "jane@mail.company.com"))) + (should (equal result '("Jane Smith <jane@mail.company.com>"))))) + +(ert-deftest test-parse-email-with-numbers () + "Should handle email containing numbers." + (let ((result (test-parse-email "User 123" "user123@test.com"))) + (should (equal result '("User 123 <user123@test.com>"))))) + +(ert-deftest test-parse-email-with-dots () + "Should handle email with dots in local part." + (let ((result (test-parse-email "Bob Jones" "bob.jones@example.com"))) + (should (equal result '("Bob Jones <bob.jones@example.com>"))))) + +(ert-deftest test-parse-email-with-hyphen () + "Should handle email with hyphens." + (let ((result (test-parse-email "Alice Brown" "alice-brown@test-domain.com"))) + (should (equal result '("Alice Brown <alice-brown@test-domain.com>"))))) + +;;; Normal Cases - Multiple Emails with Different Separators + +(ert-deftest test-parse-two-emails-comma () + "Should parse two emails separated by comma." + (let ((result (test-parse-email "John Doe" "john@work.com, john@home.com"))) + (should (equal result '("John Doe <john@work.com>" "John Doe <john@home.com>"))))) + +(ert-deftest test-parse-two-emails-semicolon () + "Should parse two emails separated by semicolon." + (let ((result (test-parse-email "Jane Smith" "jane@work.com; jane@home.com"))) + (should (equal result '("Jane Smith <jane@work.com>" "Jane Smith <jane@home.com>"))))) + +(ert-deftest test-parse-two-emails-space () + "Should parse two emails separated by space." + (let ((result (test-parse-email "Bob Jones" "bob@work.com bob@home.com"))) + (should (equal result '("Bob Jones <bob@work.com>" "Bob Jones <bob@home.com>"))))) + +(ert-deftest test-parse-three-emails-mixed-separators () + "Should parse emails with mixed separators." + (let ((result (test-parse-email "Alice" "alice@a.com, alice@b.com; alice@c.com"))) + (should (equal result '("Alice <alice@a.com>" "Alice <alice@b.com>" "Alice <alice@c.com>"))))) + +(ert-deftest test-parse-multiple-emails-with-spaces () + "Should parse comma-separated emails with spaces." + (let ((result (test-parse-email "User" "a@test.com , b@test.com , c@test.com"))) + (should (equal result '("User <a@test.com>" "User <b@test.com>" "User <c@test.com>"))))) + +;;; Normal Cases - Whitespace Handling + +(ert-deftest test-parse-email-leading-whitespace () + "Should trim leading whitespace from email." + (let ((result (test-parse-email "John" " john@example.com"))) + (should (equal result '("John <john@example.com>"))))) + +(ert-deftest test-parse-email-trailing-whitespace () + "Should trim trailing whitespace from email." + (let ((result (test-parse-email "Jane" "jane@example.com "))) + (should (equal result '("Jane <jane@example.com>"))))) + +(ert-deftest test-parse-email-surrounding-whitespace () + "Should trim surrounding whitespace from email." + (let ((result (test-parse-email "Bob" " bob@example.com "))) + (should (equal result '("Bob <bob@example.com>"))))) + +(ert-deftest test-parse-emails-with-tabs () + "Should handle emails separated by tabs." + (let ((result (test-parse-email "User" "a@test.com\tb@test.com"))) + (should (equal result '("User <a@test.com>" "User <b@test.com>"))))) + +;;; Edge Cases - Empty and Nil + +(ert-deftest test-parse-nil-email-string () + "Should return nil for nil email string." + (let ((result (test-parse-email "John Doe" nil))) + (should (null result)))) + +(ert-deftest test-parse-empty-email-string () + "Should return nil for empty email string." + (let ((result (test-parse-email "Jane Smith" ""))) + (should (null result)))) + +(ert-deftest test-parse-whitespace-only () + "Should return nil for whitespace-only string." + (let ((result (test-parse-email "Bob Jones" " "))) + (should (null result)))) + +(ert-deftest test-parse-tabs-only () + "Should return nil for tabs-only string." + (let ((result (test-parse-email "Alice" "\t\t\t"))) + (should (null result)))) + +(ert-deftest test-parse-mixed-whitespace-only () + "Should return nil for mixed whitespace." + (let ((result (test-parse-email "User" " \t \n "))) + (should (null result)))) + +;;; Edge Cases - Multiple Consecutive Separators + +(ert-deftest test-parse-multiple-commas () + "Should handle multiple consecutive commas." + (let ((result (test-parse-email "John" "john@a.com,,,john@b.com"))) + (should (equal result '("John <john@a.com>" "John <john@b.com>"))))) + +(ert-deftest test-parse-multiple-semicolons () + "Should handle multiple consecutive semicolons." + (let ((result (test-parse-email "Jane" "jane@a.com;;;jane@b.com"))) + (should (equal result '("Jane <jane@a.com>" "Jane <jane@b.com>"))))) + +(ert-deftest test-parse-multiple-spaces () + "Should handle multiple consecutive spaces." + (let ((result (test-parse-email "Bob" "bob@a.com bob@b.com"))) + (should (equal result '("Bob <bob@a.com>" "Bob <bob@b.com>"))))) + +(ert-deftest test-parse-mixed-multiple-separators () + "Should handle mixed consecutive separators." + (let ((result (test-parse-email "User" "a@test.com , ; b@test.com"))) + (should (equal result '("User <a@test.com>" "User <b@test.com>"))))) + +;;; Edge Cases - Special Name Formats + +(ert-deftest test-parse-name-with-title () + "Should handle name with title." + (let ((result (test-parse-email "Dr. John Smith" "john@example.com"))) + (should (equal result '("Dr. John Smith <john@example.com>"))))) + +(ert-deftest test-parse-name-with-suffix () + "Should handle name with suffix." + (let ((result (test-parse-email "John Doe Jr." "john@example.com"))) + (should (equal result '("John Doe Jr. <john@example.com>"))))) + +(ert-deftest test-parse-name-with-special-chars () + "Should handle name with special characters." + (let ((result (test-parse-email "O'Brien, Patrick" "patrick@example.com"))) + (should (equal result '("O'Brien, Patrick <patrick@example.com>"))))) + +(ert-deftest test-parse-unicode-name () + "Should handle Unicode characters in name." + (let ((result (test-parse-email "José García" "jose@example.com"))) + (should (equal result '("José García <jose@example.com>"))))) + +;;; Edge Cases - Special Email Formats + +(ert-deftest test-parse-email-with-plus () + "Should handle email with plus sign." + (let ((result (test-parse-email "User" "user+tag@example.com"))) + (should (equal result '("User <user+tag@example.com>"))))) + +(ert-deftest test-parse-email-with-underscore () + "Should handle email with underscore." + (let ((result (test-parse-email "User" "user_name@example.com"))) + (should (equal result '("User <user_name@example.com>"))))) + +(ert-deftest test-parse-very-long-email () + "Should handle very long email address." + (let* ((long-local (make-string 50 ?a)) + (email (concat long-local "@example.com")) + (result (test-parse-email "User" email))) + (should (equal result (list (format "User <%s>" email)))))) + +;;; Integration Tests + +(ert-deftest test-parse-realistic-contact () + "Should parse realistic contact with multiple emails." + (let ((result (test-parse-email "John Doe" "john.doe@company.com, jdoe@personal.com"))) + (should (equal result '("John Doe <john.doe@company.com>" "John Doe <jdoe@personal.com>"))))) + +(ert-deftest test-parse-messy-input () + "Should handle messy real-world input." + (let ((result (test-parse-email "Jane Smith" " jane@work.com ; jane@home.com,jane@mobile.com "))) + (should (equal result '("Jane Smith <jane@work.com>" "Jane Smith <jane@home.com>" "Jane Smith <jane@mobile.com>"))))) + +(ert-deftest test-parse-single-with-extra-separators () + "Should handle single email with trailing separators." + (let ((result (test-parse-email "Bob" "bob@example.com;;;"))) + (should (equal result '("Bob <bob@example.com>"))))) + +(provide 'test-org-contacts-parse-email) +;;; test-org-contacts-parse-email.el ends here diff --git a/tests/test-org-drill-first-function.el b/tests/test-org-drill-first-function.el new file mode 100644 index 00000000..925cdf84 --- /dev/null +++ b/tests/test-org-drill-first-function.el @@ -0,0 +1,135 @@ +;;; test-org-drill-first-function.el --- Test org-drill 'first' function compatibility -*- lexical-binding: t -*- + +;;; Commentary: +;; +;; Tests to reproduce and verify the fix for org-drill's use of deprecated +;; 'first' function which was removed in modern Emacs. +;; +;; Original error: "mapcar: Symbol's function definition is void: first" +;; +;; The error occurred because org-drill (or its dependencies) use old Common Lisp +;; functions like 'first' instead of the modern 'cl-first' from cl-lib. + +;;; Code: + +(require 'ert) + +(ert-deftest test-org-drill-first-function-not-defined-without-compat () + "Verify that 'first' function doesn't exist by default in modern Emacs. + +This test documents the original problem - the 'first' function from the +old 'cl' package is not available in modern Emacs, which only provides +'cl-first' from cl-lib." + (let ((first-defined (fboundp 'first))) + ;; In a clean Emacs without our compatibility shim, 'first' should not exist + ;; (unless the old 'cl' package was loaded, which is deprecated) + (should (or (not first-defined) + ;; If it IS defined, it should be our compatibility alias + (eq (symbol-function 'first) 'cl-first))))) + +(ert-deftest test-org-drill-cl-first-is-available () + "Verify that cl-first is available from cl-lib. + +The modern cl-lib package provides cl-first as the replacement for +the deprecated 'first' function." + (require 'cl-lib) + (should (fboundp 'cl-first)) + ;; Test it works + (should (eq 'a (cl-first '(a b c))))) + +(ert-deftest test-org-drill-first-compatibility-alias () + "Verify that our compatibility alias makes 'first' work like 'cl-first'. + +This is the fix we applied - creating an alias so that code using the +old 'first' function will work with the modern 'cl-first'." + (require 'cl-lib) + + ;; Create the compatibility alias (same as in org-drill-config.el) + (unless (fboundp 'first) + (defalias 'first 'cl-first)) + + ;; Now 'first' should be defined + (should (fboundp 'first)) + + ;; And it should behave like cl-first + (should (eq 'a (first '(a b c)))) + (should (eq 'x (first '(x y z)))) + (should (eq nil (first '())))) + +(ert-deftest test-org-drill-mapcar-with-first () + "Test the exact error scenario: (mapcar 'first ...). + +This reproduces the original error that occurred during org-drill's +item collection phase where it uses mapcar with the 'first' function." + (require 'cl-lib) + + ;; Create the compatibility alias + (unless (fboundp 'first) + (defalias 'first 'cl-first)) + + ;; Simulate org-drill data structure: list of (status data) pairs + (let ((drill-entries '((:new 0 0) + (:young 5 3) + (:overdue 10 2) + (:mature 20 1)))) + + ;; This is the kind of operation that was failing + ;; Extract first element from each entry + (let ((statuses (mapcar 'first drill-entries))) + (should (equal statuses '(:new :young :overdue :mature)))))) + +(ert-deftest test-org-drill-second-and-third-aliases () + "Verify that second and third compatibility aliases also work. + +org-drill might use other deprecated cl functions too, so we create +aliases for second and third as well." + (require 'cl-lib) + + ;; Create all compatibility aliases + (unless (fboundp 'first) + (defalias 'first 'cl-first)) + (unless (fboundp 'second) + (defalias 'second 'cl-second)) + (unless (fboundp 'third) + (defalias 'third 'cl-third)) + + (let ((test-list '(a b c d e))) + (should (eq 'a (first test-list))) + (should (eq 'b (second test-list))) + (should (eq 'c (third test-list))))) + +(ert-deftest test-org-drill-config-loads-without-error () + "Verify that org-drill-config.el loads successfully with our fix. + +This test ensures that the :init block in our use-package form +doesn't cause any loading errors." + ;; This should not throw an error + (should-not (condition-case err + (progn + (load (expand-file-name "modules/org-drill-config.el" + user-emacs-directory)) + nil) + (error err)))) + +(ert-deftest test-org-drill-data-structure-operations () + "Verify that common org-drill data structure operations work with our fix. + +org-drill works with data structures that require extracting elements. +This test ensures our compatibility aliases work with typical patterns." + (require 'cl-lib) + + ;; Create compatibility aliases + (unless (fboundp 'first) + (defalias 'first 'cl-first)) + + ;; Test that we can work with org-drill-like data structures + ;; (similar to what persist-defvar would store) + (let ((test-data '((:status-1 data-1) + (:status-2 data-2) + (:status-3 data-3)))) + ;; This kind of operation should work + (should (equal '(:status-1 :status-2 :status-3) + (mapcar 'first test-data))))) + +(provide 'test-org-drill-first-function) +;;; test-org-drill-first-function.el ends here diff --git a/tests/test-org-drill-font-switching.el b/tests/test-org-drill-font-switching.el new file mode 100644 index 00000000..27d5f420 --- /dev/null +++ b/tests/test-org-drill-font-switching.el @@ -0,0 +1,175 @@ +;;; test-org-drill-font-switching.el --- Tests for org-drill display management -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests that org-drill automatically manages display settings (fonts, modeline) +;; and restores them when the session ends. +;; +;; These are unit tests for the pure logic functions, testing them in isolation +;; without requiring the full org-drill package. + +;;; Code: + +(require 'ert) + +;; Define the functions we're testing (extracted from org-drill-config.el) + +(defvar cj/org-drill-previous-preset nil + "Stores the font preset active before starting org-drill.") + +(defvar cj/org-drill-previous-modeline-format nil + "Stores the modeline format active before starting org-drill.") + +(defvar fontaine-current-preset nil + "Current fontaine preset (mocked for testing).") + +(defvar mode-line-format '("Mock modeline") + "Mock modeline format for testing.") + +(defvar org-drill-hide-modeline-during-session t + "Whether to hide modeline during drill sessions.") + +(defun fontaine-set-preset (preset) + "Mock function: Set fontaine preset to PRESET." + (setq fontaine-current-preset preset)) + +(defun cj/org-drill-setup-display () + "Set up display for drill sessions: larger fonts and hidden modeline." + (unless cj/org-drill-previous-preset + (setq cj/org-drill-previous-preset fontaine-current-preset)) + (fontaine-set-preset 'EBook) + (when org-drill-hide-modeline-during-session + (unless cj/org-drill-previous-modeline-format + (setq cj/org-drill-previous-modeline-format mode-line-format)) + (setq mode-line-format nil))) + +(defun cj/org-drill-restore-display () + "Restore display settings after drill session ends." + (when cj/org-drill-previous-preset + (fontaine-set-preset cj/org-drill-previous-preset) + (setq cj/org-drill-previous-preset nil)) + (when cj/org-drill-previous-modeline-format + (setq mode-line-format cj/org-drill-previous-modeline-format) + (setq cj/org-drill-previous-modeline-format nil))) + +;;; Font Management Tests + +(ert-deftest test-org-drill-display/saves-current-preset () + "Test that starting org-drill saves the current font preset." + (let ((cj/org-drill-previous-preset nil) + (cj/org-drill-previous-modeline-format nil) + (fontaine-current-preset 'default)) + (cj/org-drill-setup-display) + (should (eq cj/org-drill-previous-preset 'default)))) + +(ert-deftest test-org-drill-display/switches-to-ebook () + "Test that starting org-drill switches to EBook preset." + (let ((cj/org-drill-previous-preset nil) + (cj/org-drill-previous-modeline-format nil) + (fontaine-current-preset 'default)) + (cj/org-drill-setup-display) + (should (eq fontaine-current-preset 'EBook)))) + +(ert-deftest test-org-drill-display/restores-previous-preset () + "Test that ending org-drill restores the previous font preset." + (let ((cj/org-drill-previous-preset 'default) + (cj/org-drill-previous-modeline-format nil) + (fontaine-current-preset 'EBook)) + (cj/org-drill-restore-display) + (should (eq fontaine-current-preset 'default)))) + +(ert-deftest test-org-drill-display/clears-saved-preset-after-restore () + "Test that restoring display clears the saved preset." + (let ((cj/org-drill-previous-preset 'default) + (cj/org-drill-previous-modeline-format nil) + (fontaine-current-preset 'EBook)) + (cj/org-drill-restore-display) + (should (null cj/org-drill-previous-preset)))) + +;;; Modeline Management Tests + +(ert-deftest test-org-drill-display/hides-modeline () + "Test that starting org-drill hides the modeline when configured." + (let ((cj/org-drill-previous-preset nil) + (cj/org-drill-previous-modeline-format nil) + (fontaine-current-preset 'default) + (mode-line-format '("Mock modeline")) + (org-drill-hide-modeline-during-session t)) + (cj/org-drill-setup-display) + (should (null mode-line-format)) + (should (equal cj/org-drill-previous-modeline-format '("Mock modeline"))))) + +(ert-deftest test-org-drill-display/respects-modeline-config () + "Test that modeline hiding respects the configuration variable." + (let ((cj/org-drill-previous-preset nil) + (cj/org-drill-previous-modeline-format nil) + (fontaine-current-preset 'default) + (mode-line-format '("Mock modeline")) + (org-drill-hide-modeline-during-session nil)) + (cj/org-drill-setup-display) + (should (equal mode-line-format '("Mock modeline"))) + (should (null cj/org-drill-previous-modeline-format)))) + +(ert-deftest test-org-drill-display/restores-modeline () + "Test that ending org-drill restores the modeline." + (let ((cj/org-drill-previous-preset 'default) + (cj/org-drill-previous-modeline-format '("Mock modeline")) + (fontaine-current-preset 'EBook) + (mode-line-format nil)) + (cj/org-drill-restore-display) + (should (equal mode-line-format '("Mock modeline"))) + (should (null cj/org-drill-previous-modeline-format)))) + +;;; Boundary Cases + +(ert-deftest test-org-drill-display/does-not-save-preset-twice () + "Test that calling setup twice doesn't overwrite the saved preset." + (let ((cj/org-drill-previous-preset nil) + (cj/org-drill-previous-modeline-format nil) + (fontaine-current-preset 'default)) + ;; First call saves 'default + (cj/org-drill-setup-display) + (should (eq cj/org-drill-previous-preset 'default)) + + ;; Manually change current preset (simulating a preset change during drill) + (setq fontaine-current-preset 'FiraCode) + + ;; Second call should NOT update saved preset + (cj/org-drill-setup-display) + (should (eq cj/org-drill-previous-preset 'default)) + (should-not (eq cj/org-drill-previous-preset 'FiraCode)))) + +(ert-deftest test-org-drill-display/restore-with-nil-previous-preset () + "Test that restore does nothing when no preset was saved." + (let ((cj/org-drill-previous-preset nil) + (cj/org-drill-previous-modeline-format nil) + (fontaine-current-preset 'EBook)) + (cj/org-drill-restore-display) + ;; Should remain at EBook (no restore happened) + (should (eq fontaine-current-preset 'EBook)) + (should (null cj/org-drill-previous-preset)))) + +;;; Integration Tests + +(ert-deftest test-org-drill-display/full-cycle () + "Test complete cycle: save -> switch -> restore." + (let ((cj/org-drill-previous-preset nil) + (cj/org-drill-previous-modeline-format nil) + (fontaine-current-preset 'FiraCode) + (mode-line-format '("Original modeline")) + (org-drill-hide-modeline-during-session t)) + ;; Step 1: Start drill (save state, switch to EBook, hide modeline) + (cj/org-drill-setup-display) + (should (eq cj/org-drill-previous-preset 'FiraCode)) + (should (eq fontaine-current-preset 'EBook)) + (should (equal cj/org-drill-previous-modeline-format '("Original modeline"))) + (should (null mode-line-format)) + + ;; Step 2: End drill (restore everything) + (cj/org-drill-restore-display) + (should (eq fontaine-current-preset 'FiraCode)) + (should (null cj/org-drill-previous-preset)) + (should (equal mode-line-format '("Original modeline"))) + (should (null cj/org-drill-previous-modeline-format)))) + +(provide 'test-org-drill-font-switching) +;;; test-org-drill-font-switching.el ends here diff --git a/tests/test-org-refile-build-targets.el b/tests/test-org-refile-build-targets.el new file mode 100644 index 00000000..e7ab5c42 --- /dev/null +++ b/tests/test-org-refile-build-targets.el @@ -0,0 +1,305 @@ +;;; test-org-refile-build-targets.el --- Tests for cj/build-org-refile-targets -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/build-org-refile-targets caching logic. +;; Tests cache behavior, TTL expiration, force rebuild, and async build flag. + +;;; Code: + +(require 'ert) + +;; Add modules to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar inbox-file "/tmp/test-inbox.org") +(defvar reference-file "/tmp/test-reference.org") +(defvar schedule-file "/tmp/test-schedule.org") +(defvar user-emacs-directory "/tmp/test-emacs.d/") +(defvar code-dir "/tmp/test-code/") +(defvar projects-dir "/tmp/test-projects/") + +;; Now load the actual production module +(require 'org-refile-config) + +;;; Setup and Teardown + +(defun test-org-refile-setup () + "Reset cache and state before each test." + (setq cj/org-refile-targets-cache nil) + (setq cj/org-refile-targets-cache-time nil) + (setq cj/org-refile-targets-building nil) + (setq org-refile-targets nil)) + +(defun test-org-refile-teardown () + "Clean up after each test." + (setq cj/org-refile-targets-cache nil) + (setq cj/org-refile-targets-cache-time nil) + (setq cj/org-refile-targets-building nil) + (setq org-refile-targets nil)) + +;;; Normal Cases + +(ert-deftest test-org-refile-build-targets-normal-first-call-builds-cache () + "Test that first call builds cache from scratch. + +When cache is empty, function should: +1. Scan directories for todo.org files +2. Build refile targets list +3. Populate cache +4. Set cache timestamp" + (test-org-refile-setup) + (unwind-protect + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern) '("/tmp/todo.org"))) + ((symbol-function 'fboundp) (lambda (_sym) nil))) + + ;; Before call: cache empty + (should (null cj/org-refile-targets-cache)) + (should (null cj/org-refile-targets-cache-time)) + + ;; Build targets + (cj/build-org-refile-targets) + + ;; After call: cache populated + (should cj/org-refile-targets-cache) + (should cj/org-refile-targets-cache-time) + (should org-refile-targets) + + ;; Cache matches org-refile-targets + (should (equal cj/org-refile-targets-cache org-refile-targets)) + + ;; Contains base files (inbox, reference, schedule) + (should (>= (length org-refile-targets) 3))) + (test-org-refile-teardown))) + +(ert-deftest test-org-refile-build-targets-normal-second-call-uses-cache () + "Test that second call uses cache instead of rebuilding. + +When cache is valid (not expired): +1. Should NOT scan directories again +2. Should restore targets from cache +3. Should NOT update cache timestamp" + (test-org-refile-setup) + (unwind-protect + (let ((scan-count 0)) + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern) + (setq scan-count (1+ scan-count)) + '("/tmp/todo.org"))) + ((symbol-function 'fboundp) (lambda (_sym) nil))) + + ;; First call: builds cache + (cj/build-org-refile-targets) + (should (= scan-count 3)) ; 3 directories scanned + + (let ((cached-time cj/org-refile-targets-cache-time) + (cached-targets cj/org-refile-targets-cache)) + + ;; Second call: uses cache + (cj/build-org-refile-targets) + + ;; Scan count unchanged (cache hit) + (should (= scan-count 3)) + + ;; Cache unchanged + (should (equal cj/org-refile-targets-cache-time cached-time)) + (should (equal cj/org-refile-targets-cache cached-targets))))) + (test-org-refile-teardown))) + +(ert-deftest test-org-refile-build-targets-normal-force-rebuild-bypasses-cache () + "Test that force-rebuild parameter bypasses cache. + +When force-rebuild is non-nil: +1. Should ignore valid cache +2. Should rebuild from scratch +3. Should update cache with new data" + (test-org-refile-setup) + (unwind-protect + (let ((scan-count 0)) + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern) + (setq scan-count (1+ scan-count)) + (if (> scan-count 3) + '("/tmp/todo.org" "/tmp/todo2.org") ; New file on rebuild + '("/tmp/todo.org")))) + ((symbol-function 'fboundp) (lambda (_sym) nil))) + + ;; First call: builds cache + (cj/build-org-refile-targets) + (let ((initial-count (length org-refile-targets))) + + ;; Force rebuild + (cj/build-org-refile-targets 'force) + + ;; Scanned again (3 more directories) + (should (= scan-count 6)) + + ;; New targets include additional file + (should (> (length org-refile-targets) initial-count))))) + (test-org-refile-teardown))) + +;;; Boundary Cases + +(ert-deftest test-org-refile-build-targets-boundary-cache-expires-after-ttl () + "Test that cache expires after TTL period. + +When cache timestamp exceeds TTL: +1. Should rebuild targets +2. Should update cache timestamp +3. Should rescan directories" + (test-org-refile-setup) + (unwind-protect + (let ((scan-count 0)) + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern) + (setq scan-count (1+ scan-count)) + '("/tmp/todo.org"))) + ((symbol-function 'fboundp) (lambda (_sym) nil))) + + ;; First call: builds cache + (cj/build-org-refile-targets) + (should (= scan-count 3)) + + ;; Simulate cache expiration (set time to 2 hours ago) + (setq cj/org-refile-targets-cache-time + (- (float-time) (* 2 3600))) + + ;; Second call: cache expired, rebuild + (cj/build-org-refile-targets) + + ;; Scanned again (cache was expired) + (should (= scan-count 6)) + + ;; Cache timestamp updated to current time + (should (< (- (float-time) cj/org-refile-targets-cache-time) 1)))) + (test-org-refile-teardown))) + +(ert-deftest test-org-refile-build-targets-boundary-empty-directories-creates-minimal-targets () + "Test behavior when directories contain no todo.org files. + +When directory scans return empty: +1. Should still create base targets (inbox, reference, schedule) +2. Should not fail or error +3. Should cache the minimal result" + (test-org-refile-setup) + (unwind-protect + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern) nil)) ; No files found + ((symbol-function 'fboundp) (lambda (_sym) nil))) + + (cj/build-org-refile-targets) + + ;; Should have base files only + (should (= (length org-refile-targets) 3)) + + ;; Cache should contain base files + (should cj/org-refile-targets-cache) + (should (= (length cj/org-refile-targets-cache) 3))) + (test-org-refile-teardown))) + +(ert-deftest test-org-refile-build-targets-boundary-building-flag-set-during-build () + "Test that building flag is set during build and cleared after. + +During build: +1. Flag should be set to prevent concurrent builds +2. Flag should clear even if build fails +3. Flag state should be consistent" + (test-org-refile-setup) + (unwind-protect + (let ((flag-during-build nil)) + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern) + ;; Capture flag state during directory scan + (setq flag-during-build cj/org-refile-targets-building) + '("/tmp/todo.org"))) + ((symbol-function 'fboundp) (lambda (_sym) nil))) + + ;; Before build + (should (null cj/org-refile-targets-building)) + + ;; Build + (cj/build-org-refile-targets) + + ;; Flag was set during build + (should flag-during-build) + + ;; Flag cleared after build + (should (null cj/org-refile-targets-building)))) + (test-org-refile-teardown))) + +(ert-deftest test-org-refile-build-targets-boundary-building-flag-clears-on-error () + "Test that building flag clears even if build errors. + +When build encounters error: +1. Flag should still be cleared (unwind-protect) +2. Prevents permanently locked state +3. Next build can proceed" + (test-org-refile-setup) + (unwind-protect + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern) + (error "Simulated scan failure"))) + ((symbol-function 'fboundp) (lambda (_sym) nil))) + + ;; Build will error + (should-error (cj/build-org-refile-targets)) + + ;; Flag cleared despite error (unwind-protect) + (should (null cj/org-refile-targets-building))) + (test-org-refile-teardown))) + +;;; Error Cases + +(ert-deftest test-org-refile-build-targets-error-nil-cache-with-old-timestamp () + "Test handling of inconsistent state (nil cache but timestamp set). + +When cache is nil but timestamp exists: +1. Should recognize cache as invalid +2. Should rebuild targets +3. Should set both cache and timestamp" + (test-org-refile-setup) + (unwind-protect + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern) '("/tmp/todo.org"))) + ((symbol-function 'fboundp) (lambda (_sym) nil))) + + ;; Set inconsistent state + (setq cj/org-refile-targets-cache nil) + (setq cj/org-refile-targets-cache-time (float-time)) + + ;; Build should recognize invalid state + (cj/build-org-refile-targets) + + ;; Cache now populated + (should cj/org-refile-targets-cache) + (should cj/org-refile-targets-cache-time) + (should org-refile-targets)) + (test-org-refile-teardown))) + +(ert-deftest test-org-refile-build-targets-error-directory-scan-failure-propagates () + "Test that directory scan failures propagate as errors. + +When directory-files-recursively errors: +1. Error should propagate to caller +2. Cache should not be corrupted +3. Building flag should clear" + (test-org-refile-setup) + (unwind-protect + (cl-letf (((symbol-function 'directory-files-recursively) + (lambda (_dir _pattern) + (error "Permission denied"))) + ((symbol-function 'fboundp) (lambda (_sym) nil))) + + ;; Should propagate error + (should-error (cj/build-org-refile-targets)) + + ;; Cache not corrupted (still nil) + (should (null cj/org-refile-targets-cache)) + + ;; Building flag cleared + (should (null cj/org-refile-targets-building))) + (test-org-refile-teardown))) + +(provide 'test-org-refile-build-targets) +;;; test-org-refile-build-targets.el ends here diff --git a/tests/test-org-roam-config-copy-todo-to-today.el b/tests/test-org-roam-config-copy-todo-to-today.el new file mode 100644 index 00000000..bcac5a26 --- /dev/null +++ b/tests/test-org-roam-config-copy-todo-to-today.el @@ -0,0 +1,182 @@ +;;; test-org-roam-config-copy-todo-to-today.el --- Tests for org-roam TODO completion hook -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the org-after-todo-state-change-hook configuration that copies +;; completed tasks to daily org-roam nodes. +;; +;; The hook should trigger for ANY org-mode done state (DONE, CANCELLED, etc.), +;; not just "DONE". This is verified by checking membership in org-done-keywords. +;; +;; The critical behavior being tested is that the hook is registered +;; immediately when org-mode loads, NOT when org-roam loads (which happens +;; lazily). This ensures tasks can be copied to dailies even before the user +;; has invoked any org-roam commands. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;;; Setup and Teardown + +(defun test-org-roam-todo-hook-setup () + "Setup for org-roam todo hook tests." + (cj/create-test-base-dir)) + +(defun test-org-roam-todo-hook-teardown () + "Teardown for org-roam todo hook tests." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-org-roam-hook-registered-after-org-loads () + "The hook should be registered after org loads." + (test-org-roam-todo-hook-setup) + (unwind-protect + (progn + (require 'org) + (require 'org-roam-config) + (should (consp org-after-todo-state-change-hook))) + (test-org-roam-todo-hook-teardown))) + +(ert-deftest test-org-roam-hook-calls-copy-function-on-done () + "The hook lambda should call copy function when state is DONE." + (test-org-roam-todo-hook-setup) + (unwind-protect + (let ((copy-function-called nil)) + (require 'org) + (require 'org-roam-config) + (setq org-done-keywords '("DONE" "CANCELLED")) ; Set done keywords for test + (setq org-last-state nil) ; No previous state (new task) + (setq org-state "DONE") ; Dynamic variable used by org-mode hooks + (cl-letf (((symbol-function 'cj/org-roam-copy-todo-to-today) + (lambda () (setq copy-function-called t)))) + (run-hooks 'org-after-todo-state-change-hook) + (should copy-function-called))) + (test-org-roam-todo-hook-teardown))) + +(ert-deftest test-org-roam-hook-calls-copy-function-on-cancelled () + "The hook lambda should call copy function when state is CANCELLED." + (test-org-roam-todo-hook-setup) + (unwind-protect + (let ((copy-function-called nil)) + (require 'org) + (require 'org-roam-config) + (setq org-done-keywords '("DONE" "CANCELLED")) ; Set done keywords for test + (setq org-last-state nil) ; No previous state (new task) + (setq org-state "CANCELLED") ; Dynamic variable used by org-mode hooks + (cl-letf (((symbol-function 'cj/org-roam-copy-todo-to-today) + (lambda () (setq copy-function-called t)))) + (run-hooks 'org-after-todo-state-change-hook) + (should copy-function-called))) + (test-org-roam-todo-hook-teardown))) + +;;; Boundary Cases + +(ert-deftest test-org-roam-hook-registered-before-org-roam-loads () + "The hook should be registered even if org-roam has not loaded yet." + (test-org-roam-todo-hook-setup) + (unwind-protect + (progn + (require 'org) + (require 'org-roam-config) + (should (consp org-after-todo-state-change-hook)) + (should-not (featurep 'org-roam))) + (test-org-roam-todo-hook-teardown))) + +(ert-deftest test-org-roam-hook-calls-copy-on-todo-to-done () + "The hook should copy when transitioning FROM TODO TO DONE." + (test-org-roam-todo-hook-setup) + (unwind-protect + (let ((copy-function-called nil)) + (require 'org) + (require 'org-roam-config) + (setq org-done-keywords '("DONE" "CANCELLED")) + (setq org-last-state "TODO") ; Previous state was TODO (non-done) + (setq org-state "DONE") ; New state is DONE + (cl-letf (((symbol-function 'cj/org-roam-copy-todo-to-today) + (lambda () (setq copy-function-called t)))) + (run-hooks 'org-after-todo-state-change-hook) + (should copy-function-called))) + (test-org-roam-todo-hook-teardown))) + +(ert-deftest test-org-roam-hook-calls-copy-on-in-progress-to-done () + "The hook should copy when transitioning FROM IN-PROGRESS TO DONE." + (test-org-roam-todo-hook-setup) + (unwind-protect + (let ((copy-function-called nil)) + (require 'org) + (require 'org-roam-config) + (setq org-done-keywords '("DONE" "CANCELLED")) + (setq org-last-state "IN-PROGRESS") ; Previous state was IN-PROGRESS (non-done) + (setq org-state "DONE") ; New state is DONE + (cl-letf (((symbol-function 'cj/org-roam-copy-todo-to-today) + (lambda () (setq copy-function-called t)))) + (run-hooks 'org-after-todo-state-change-hook) + (should copy-function-called))) + (test-org-roam-todo-hook-teardown))) + +(ert-deftest test-org-roam-hook-calls-copy-on-waiting-to-cancelled () + "The hook should copy when transitioning FROM WAITING TO CANCELLED." + (test-org-roam-todo-hook-setup) + (unwind-protect + (let ((copy-function-called nil)) + (require 'org) + (require 'org-roam-config) + (setq org-done-keywords '("DONE" "CANCELLED")) + (setq org-last-state "WAITING") ; Previous state was WAITING (non-done) + (setq org-state "CANCELLED") ; New state is CANCELLED + (cl-letf (((symbol-function 'cj/org-roam-copy-todo-to-today) + (lambda () (setq copy-function-called t)))) + (run-hooks 'org-after-todo-state-change-hook) + (should copy-function-called))) + (test-org-roam-todo-hook-teardown))) + +(ert-deftest test-org-roam-hook-ignores-done-to-cancelled () + "The hook should NOT copy when transitioning FROM DONE TO CANCELLED (both done)." + (test-org-roam-todo-hook-setup) + (unwind-protect + (let ((copy-function-called nil)) + (require 'org) + (require 'org-roam-config) + (setq org-done-keywords '("DONE" "CANCELLED")) + (setq org-last-state "DONE") ; Previous state was DONE (already done) + (setq org-state "CANCELLED") ; New state is CANCELLED (also done) + (cl-letf (((symbol-function 'cj/org-roam-copy-todo-to-today) + (lambda () (setq copy-function-called t)))) + (run-hooks 'org-after-todo-state-change-hook) + (should-not copy-function-called))) + (test-org-roam-todo-hook-teardown))) + +(ert-deftest test-org-roam-hook-ignores-todo-state () + "The hook should not copy when transitioning TO TODO state (non-done)." + (test-org-roam-todo-hook-setup) + (unwind-protect + (let ((copy-function-called nil)) + (require 'org) + (require 'org-roam-config) + (setq org-done-keywords '("DONE" "CANCELLED")) ; TODO is not in done keywords + (setq org-state "TODO") ; Transitioning TO TODO + (cl-letf (((symbol-function 'cj/org-roam-copy-todo-to-today) + (lambda () (setq copy-function-called t)))) + (run-hooks 'org-after-todo-state-change-hook) + (should-not copy-function-called))) + (test-org-roam-todo-hook-teardown))) + +(ert-deftest test-org-roam-hook-ignores-in-progress-state () + "The hook should not copy when transitioning TO IN-PROGRESS state (non-done)." + (test-org-roam-todo-hook-setup) + (unwind-protect + (let ((copy-function-called nil)) + (require 'org) + (require 'org-roam-config) + (setq org-done-keywords '("DONE" "CANCELLED")) ; IN-PROGRESS is not in done keywords + (setq org-state "IN-PROGRESS") ; Transitioning TO IN-PROGRESS + (cl-letf (((symbol-function 'cj/org-roam-copy-todo-to-today) + (lambda () (setq copy-function-called t)))) + (run-hooks 'org-after-todo-state-change-hook) + (should-not copy-function-called))) + (test-org-roam-todo-hook-teardown))) + +(provide 'test-org-roam-config-copy-todo-to-today) +;;; test-org-roam-config-copy-todo-to-today.el ends here diff --git a/tests/test-org-roam-config-demote.el b/tests/test-org-roam-config-demote.el new file mode 100644 index 00000000..98cc8244 --- /dev/null +++ b/tests/test-org-roam-config-demote.el @@ -0,0 +1,183 @@ +;;; test-org-roam-config-demote.el --- Tests for cj/--demote-org-subtree -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--demote-org-subtree function from org-roam-config.el +;; +;; This function demotes org subtree content from one level to another. +;; All headings in the tree are adjusted proportionally, with a minimum level of 1. +;; +;; Examples: +;; Input: "*** Heading\n**** Sub", from: 3, to: 1 +;; Output: "* Heading\n** Sub" +;; +;; Input: "** Heading\n*** Sub", from: 2, to: 1 +;; Output: "* Heading\n** Sub" + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Now load the actual production module +(require 'org-roam-config) + +;;; Test Helpers + +(defun test-demote (content from-level to-level) + "Test cj/--demote-org-subtree on CONTENT. +FROM-LEVEL is the current top level, TO-LEVEL is the desired top level. +Returns the demoted content." + (cj/--demote-org-subtree content from-level to-level)) + +;;; Normal Cases - Single Heading + +(ert-deftest test-demote-level2-to-level1 () + "Should demote level 2 heading to level 1." + (let ((result (test-demote "** Heading\n" 2 1))) + (should (string= result "* Heading\n")))) + +(ert-deftest test-demote-level3-to-level1 () + "Should demote level 3 heading to level 1." + (let ((result (test-demote "*** Heading\n" 3 1))) + (should (string= result "* Heading\n")))) + +(ert-deftest test-demote-level4-to-level1 () + "Should demote level 4 heading to level 1." + (let ((result (test-demote "**** Heading\n" 4 1))) + (should (string= result "* Heading\n")))) + +(ert-deftest test-demote-level3-to-level2 () + "Should demote level 3 heading to level 2." + (let ((result (test-demote "*** Heading\n" 3 2))) + (should (string= result "** Heading\n")))) + +;;; Normal Cases - Multiple Headings at Same Level + +(ert-deftest test-demote-multiple-same-level () + "Should demote multiple headings at same level." + (let ((result (test-demote "** First\n** Second\n** Third\n" 2 1))) + (should (string= result "* First\n* Second\n* Third\n")))) + +;;; Normal Cases - Hierarchical Structure + +(ert-deftest test-demote-with-subheading () + "Should demote heading and subheading proportionally." + (let ((result (test-demote "** Heading\n*** Subheading\n" 2 1))) + (should (string= result "* Heading\n** Subheading\n")))) + +(ert-deftest test-demote-three-levels () + "Should demote three-level hierarchy." + (let ((result (test-demote "** Main\n*** Sub\n**** SubSub\n" 2 1))) + (should (string= result "* Main\n** Sub\n*** SubSub\n")))) + +(ert-deftest test-demote-complex-hierarchy () + "Should demote complex hierarchy maintaining relative structure." + (let ((result (test-demote "*** Top\n**** Sub1\n***** Deep\n**** Sub2\n" 3 1))) + (should (string= result "* Top\n** Sub1\n*** Deep\n** Sub2\n")))) + +;;; Normal Cases - With Content + +(ert-deftest test-demote-heading-with-text () + "Should demote heading preserving body text." + (let ((result (test-demote "** Heading\nBody text\n" 2 1))) + (should (string= result "* Heading\nBody text\n")))) + +(ert-deftest test-demote-with-properties () + "Should demote heading preserving properties." + (let ((result (test-demote "** Heading\n:PROPERTIES:\n:ID: 123\n:END:\n" 2 1))) + (should (string= result "* Heading\n:PROPERTIES:\n:ID: 123\n:END:\n")))) + +(ert-deftest test-demote-with-mixed-content () + "Should demote headings preserving all content." + (let ((result (test-demote "** H1\nText\n*** H2\nMore text\n" 2 1))) + (should (string= result "* H1\nText\n** H2\nMore text\n")))) + +;;; Boundary Cases - No Demotion Needed + +(ert-deftest test-demote-same-level () + "Should return content unchanged when from equals to." + (let ((result (test-demote "* Heading\n" 1 1))) + (should (string= result "* Heading\n")))) + +(ert-deftest test-demote-promote-ignored () + "Should return content unchanged when to > from (promotion)." + (let ((result (test-demote "* Heading\n" 1 2))) + (should (string= result "* Heading\n")))) + +;;; Boundary Cases - Minimum Level + +(ert-deftest test-demote-respects-minimum-level () + "Should not demote below level 1." + (let ((result (test-demote "** Main\n*** Sub\n" 2 1))) + (should (string= result "* Main\n** Sub\n")) + ;; Sub went from 3 to 2, not below 1 + (should (string-match-p "^\\*\\* Sub" result)))) + +(ert-deftest test-demote-deep-hierarchy-min-level () + "Should respect minimum level for deep hierarchies." + (let ((result (test-demote "**** L4\n***** L5\n****** L6\n" 4 1))) + (should (string= result "* L4\n** L5\n*** L6\n")))) + +;;; Boundary Cases - Empty and Edge Cases + +(ert-deftest test-demote-empty-string () + "Should handle empty string." + (let ((result (test-demote "" 2 1))) + (should (string= result "")))) + +(ert-deftest test-demote-no-headings () + "Should return non-heading content unchanged." + (let ((result (test-demote "Just plain text\nNo headings here\n" 2 1))) + (should (string= result "Just plain text\nNo headings here\n")))) + +(ert-deftest test-demote-heading-without-space () + "Should not match headings without space after stars." + (let ((result (test-demote "**Not a heading\n** Real Heading\n" 2 1))) + (should (string= result "**Not a heading\n* Real Heading\n")))) + +;;; Edge Cases - Special Heading Content + +(ert-deftest test-demote-heading-with-tags () + "Should demote heading preserving tags." + (let ((result (test-demote "** Heading :tag1:tag2:\n" 2 1))) + (should (string= result "* Heading :tag1:tag2:\n")))) + +(ert-deftest test-demote-heading-with-todo () + "Should demote heading preserving TODO keyword." + (let ((result (test-demote "** TODO Task\n" 2 1))) + (should (string= result "* TODO Task\n")))) + +(ert-deftest test-demote-heading-with-priority () + "Should demote heading preserving priority." + (let ((result (test-demote "** [#A] Important\n" 2 1))) + (should (string= result "* [#A] Important\n")))) + +;;; Edge Cases - Whitespace + +(ert-deftest test-demote-preserves-indentation () + "Should preserve indentation in body text." + (let ((result (test-demote "** Heading\n Indented text\n" 2 1))) + (should (string= result "* Heading\n Indented text\n")))) + +(ert-deftest test-demote-multiple-spaces-after-stars () + "Should handle multiple spaces after stars." + (let ((result (test-demote "** Heading\n" 2 1))) + (should (string= result "* Heading\n")))) + +;;; Edge Cases - Large Demotion + +(ert-deftest test-demote-large-level-difference () + "Should handle large level differences." + (let ((result (test-demote "****** Level 6\n******* Level 7\n" 6 1))) + (should (string= result "* Level 6\n** Level 7\n")))) + +(ert-deftest test-demote-to-level-2 () + "Should demote to level 2 when specified." + (let ((result (test-demote "***** Level 5\n****** Level 6\n" 5 2))) + (should (string= result "** Level 5\n*** Level 6\n")))) + +(provide 'test-org-roam-config-demote) +;;; test-org-roam-config-demote.el ends here diff --git a/tests/test-org-roam-config-format.el b/tests/test-org-roam-config-format.el new file mode 100644 index 00000000..e9378b7a --- /dev/null +++ b/tests/test-org-roam-config-format.el @@ -0,0 +1,151 @@ +;;; test-org-roam-config-format.el --- Tests for cj/--format-roam-node -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--format-roam-node function from org-roam-config.el +;; +;; This function formats org-roam node file content with title, node-id, and body content. +;; It creates a complete org-roam file with properties, title, category, and filetags. +;; +;; Example: +;; Input: title: "My Note", node-id: "abc123", content: "* Content\n" +;; Output: Full org-roam file with metadata and content + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Now load the actual production module +(require 'org-roam-config) + +;;; Test Helpers + +(defun test-format (title node-id content) + "Test cj/--format-roam-node with TITLE, NODE-ID, and CONTENT. +Returns the formatted file content." + (cj/--format-roam-node title node-id content)) + +;;; Normal Cases + +(ert-deftest test-format-simple-node () + "Should format simple node with all components." + (let ((result (test-format "Test Title" "id-123" "* Content\n"))) + (should (string-match-p ":PROPERTIES:" result)) + (should (string-match-p ":ID: id-123" result)) + (should (string-match-p "#\\+TITLE: Test Title" result)) + (should (string-match-p "#\\+CATEGORY: Test Title" result)) + (should (string-match-p "#\\+FILETAGS: Topic" result)) + (should (string-match-p "\\* Content" result)))) + +(ert-deftest test-format-properties-first () + "Should place properties at the beginning." + (let ((result (test-format "Title" "id" "content"))) + (should (string-prefix-p ":PROPERTIES:\n" result)))) + +(ert-deftest test-format-id-after-properties () + "Should place ID in properties block." + (let ((result (test-format "Title" "test-id-456" "content"))) + (should (string-match-p ":PROPERTIES:\n:ID: test-id-456\n:END:" result)))) + +(ert-deftest test-format-title-after-properties () + "Should place title after properties." + (let ((result (test-format "My Title" "id" "content"))) + (should (string-match-p ":END:\n#\\+TITLE: My Title\n" result)))) + +(ert-deftest test-format-category-matches-title () + "Should set category to match title." + (let ((result (test-format "Project Name" "id" "content"))) + (should (string-match-p "#\\+TITLE: Project Name\n#\\+CATEGORY: Project Name\n" result)))) + +(ert-deftest test-format-filetags-topic () + "Should set filetags to Topic." + (let ((result (test-format "Title" "id" "content"))) + (should (string-match-p "#\\+FILETAGS: Topic\n" result)))) + +(ert-deftest test-format-content-at-end () + "Should place content after metadata." + (let ((result (test-format "Title" "id" "* Heading\nBody text\n"))) + (should (string-suffix-p "* Heading\nBody text\n" result)))) + +;;; Edge Cases - Various Titles + +(ert-deftest test-format-title-with-spaces () + "Should handle title with spaces." + (let ((result (test-format "Multi Word Title" "id" "content"))) + (should (string-match-p "#\\+TITLE: Multi Word Title" result)) + (should (string-match-p "#\\+CATEGORY: Multi Word Title" result)))) + +(ert-deftest test-format-title-with-punctuation () + "Should handle title with punctuation." + (let ((result (test-format "Title: With, Punctuation!" "id" "content"))) + (should (string-match-p "#\\+TITLE: Title: With, Punctuation!" result)))) + +(ert-deftest test-format-title-with-numbers () + "Should handle title with numbers." + (let ((result (test-format "Version 2.0" "id" "content"))) + (should (string-match-p "#\\+TITLE: Version 2\\.0" result)))) + +;;; Edge Cases - Various Node IDs + +(ert-deftest test-format-uuid-style-id () + "Should handle UUID-style ID." + (let ((result (test-format "Title" "a1b2c3d4-e5f6-7890-abcd-ef1234567890" "content"))) + (should (string-match-p ":ID: a1b2c3d4-e5f6-7890-abcd-ef1234567890" result)))) + +(ert-deftest test-format-short-id () + "Should handle short ID." + (let ((result (test-format "Title" "1" "content"))) + (should (string-match-p ":ID: 1" result)))) + +(ert-deftest test-format-long-id () + "Should handle long ID." + (let* ((long-id (make-string 100 ?a)) + (result (test-format "Title" long-id "content"))) + (should (string-match-p (concat ":ID: " long-id) result)))) + +;;; Edge Cases - Various Content + +(ert-deftest test-format-empty-content () + "Should handle empty content." + (let ((result (test-format "Title" "id" ""))) + (should (string-suffix-p "#+FILETAGS: Topic\n\n" result)))) + +(ert-deftest test-format-multiline-content () + "Should handle multiline content." + (let ((result (test-format "Title" "id" "* H1\nText\n** H2\nMore\n"))) + (should (string-suffix-p "* H1\nText\n** H2\nMore\n" result)))) + +(ert-deftest test-format-content-with-properties () + "Should handle content that already has properties." + (let ((result (test-format "Title" "id" "* Heading\n:PROPERTIES:\n:CUSTOM: value\n:END:\n"))) + (should (string-match-p ":CUSTOM: value" result)))) + +;;; Integration Tests - Structure + +(ert-deftest test-format-complete-structure () + "Should create proper org-roam file structure." + (let ((result (test-format "My Note" "abc-123" "* Content\n"))) + ;; Check order of components + (should (< (string-match ":PROPERTIES:" result) + (string-match ":ID:" result))) + (should (< (string-match ":ID:" result) + (string-match ":END:" result))) + (should (< (string-match ":END:" result) + (string-match "#\\+TITLE:" result))) + (should (< (string-match "#\\+TITLE:" result) + (string-match "#\\+CATEGORY:" result))) + (should (< (string-match "#\\+CATEGORY:" result) + (string-match "#\\+FILETAGS:" result))) + (should (< (string-match "#\\+FILETAGS:" result) + (string-match "\\* Content" result))))) + +(ert-deftest test-format-double-newline-after-metadata () + "Should have double newline between metadata and content." + (let ((result (test-format "Title" "id" "* Content"))) + (should (string-match-p "#\\+FILETAGS: Topic\n\n\\* Content" result)))) + +(provide 'test-org-roam-config-format) +;;; test-org-roam-config-format.el ends here diff --git a/tests/test-org-roam-config-link-description.el b/tests/test-org-roam-config-link-description.el new file mode 100644 index 00000000..06321b8f --- /dev/null +++ b/tests/test-org-roam-config-link-description.el @@ -0,0 +1,188 @@ +;;; test-org-roam-config-link-description.el --- Tests for cj/org-link-get-description -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/org-link-get-description function from org-roam-config.el +;; +;; This function extracts the description from an org link, or returns the text unchanged. +;; If TEXT contains an org link like [[url][description]], it returns description. +;; If TEXT contains multiple links, only the first one is processed. +;; Otherwise it returns TEXT unchanged. +;; +;; Examples: +;; Input: "[[https://example.com][Example Site]]" +;; Output: "Example Site" +;; +;; Input: "[[https://example.com]]" +;; Output: "https://example.com" +;; +;; Input: "Plain text" +;; Output: "Plain text" + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Now load the actual production module +(require 'org-roam-config) + +;;; Test Helpers + +(defun test-link-description (text) + "Test cj/org-link-get-description on TEXT. +Returns the extracted description or text unchanged." + (cj/org-link-get-description text)) + +;;; Normal Cases - Link with Description + +(ert-deftest test-link-with-description () + "Should extract description from link with description." + (let ((result (test-link-description "[[https://example.com][Example Site]]"))) + (should (string= result "Example Site")))) + +(ert-deftest test-link-with-multiword-description () + "Should extract multi-word description." + (let ((result (test-link-description "[[url][Multiple Word Description]]"))) + (should (string= result "Multiple Word Description")))) + +(ert-deftest test-link-with-special-chars-in-description () + "Should extract description with special characters." + (let ((result (test-link-description "[[url][Description: with, punctuation!]]"))) + (should (string= result "Description: with, punctuation!")))) + +(ert-deftest test-link-file-path-with-description () + "Should extract description from file link." + (let ((result (test-link-description "[[file:~/document.pdf][My Document]]"))) + (should (string= result "My Document")))) + +(ert-deftest test-link-with-numbers-in-description () + "Should extract description containing numbers." + (let ((result (test-link-description "[[url][Chapter 42]]"))) + (should (string= result "Chapter 42")))) + +;;; Normal Cases - Link without Description + +(ert-deftest test-link-without-description-url () + "Should return URL when no description is present." + (let ((result (test-link-description "[[https://example.com]]"))) + (should (string= result "https://example.com")))) + +(ert-deftest test-link-without-description-file () + "Should return file path when no description." + (let ((result (test-link-description "[[file:~/notes.org]]"))) + (should (string= result "file:~/notes.org")))) + +(ert-deftest test-link-without-description-id () + "Should return ID when no description." + (let ((result (test-link-description "[[id:abc123]]"))) + (should (string= result "id:abc123")))) + +;;; Normal Cases - No Link + +(ert-deftest test-plain-text () + "Should return plain text unchanged." + (let ((result (test-link-description "Plain text without link"))) + (should (string= result "Plain text without link")))) + +(ert-deftest test-text-with-brackets-but-not-link () + "Should return text with single brackets unchanged." + (let ((result (test-link-description "Text [with] brackets"))) + (should (string= result "Text [with] brackets")))) + +(ert-deftest test-text-with-partial-link-syntax () + "Should return text with partial link syntax unchanged." + (let ((result (test-link-description "[[incomplete link"))) + (should (string= result "[[incomplete link")))) + +;;; Boundary Cases - Multiple Links + +(ert-deftest test-multiple-links-extracts-first () + "Should extract description from first link only." + (let ((result (test-link-description "[[url1][First]] and [[url2][Second]]"))) + (should (string= result "First")))) + +(ert-deftest test-multiple-links-first-has-no-description () + "Should extract URL from first link when it has no description." + (let ((result (test-link-description "[[url1]] and [[url2][Second]]"))) + (should (string= result "url1")))) + +;;; Boundary Cases - Empty and Edge Cases + +(ert-deftest test-empty-string () + "Should return empty string unchanged." + (let ((result (test-link-description ""))) + (should (string= result "")))) + +(ert-deftest test-link-with-empty-description () + "Should return text unchanged when description brackets are empty." + (let ((result (test-link-description "[[https://example.com][]]"))) + ;; Regex requires at least one char in description, so no match + (should (string= result "[[https://example.com][]]")))) + +(ert-deftest test-link-with-empty-url () + "Should return text unchanged when link is completely empty." + (let ((result (test-link-description "[[]]"))) + ;; Regex requires at least one char in URL, so no match, returns unchanged + (should (string= result "[[]]")))) + +(ert-deftest test-link-with-empty-url-and-description () + "Should handle completely empty link." + (let ((result (test-link-description "[][]"))) + (should (string= result "[][]")))) + +;;; Edge Cases - Special Link Types + +(ert-deftest test-internal-link () + "Should extract description from internal link." + (let ((result (test-link-description "[[*Heading][My Heading]]"))) + (should (string= result "My Heading")))) + +(ert-deftest test-internal-link-without-description () + "Should return heading target from internal link without description." + (let ((result (test-link-description "[[*Heading]]"))) + (should (string= result "*Heading")))) + +(ert-deftest test-custom-id-link () + "Should handle custom ID links." + (let ((result (test-link-description "[[#custom-id][Custom Section]]"))) + (should (string= result "Custom Section")))) + +;;; Edge Cases - Link with Surrounding Text + +(ert-deftest test-link-with-prefix-text () + "Should extract description from link with prefix text." + (let ((result (test-link-description "See [[url][documentation]] for details"))) + (should (string= result "documentation")))) + +(ert-deftest test-link-at-start () + "Should extract description from link at start of text." + (let ((result (test-link-description "[[url][Link]] at beginning"))) + (should (string= result "Link")))) + +(ert-deftest test-link-at-end () + "Should extract description from link at end of text." + (let ((result (test-link-description "Text with [[url][link]]"))) + (should (string= result "link")))) + +;;; Edge Cases - Special Characters in URL + +(ert-deftest test-link-with-query-params () + "Should handle URL with query parameters." + (let ((result (test-link-description "[[https://example.com?q=test&foo=bar][Search]]"))) + (should (string= result "Search")))) + +(ert-deftest test-link-with-anchor () + "Should handle URL with anchor." + (let ((result (test-link-description "[[https://example.com#section][Section]]"))) + (should (string= result "Section")))) + +(ert-deftest test-link-with-spaces-in-description () + "Should preserve spaces in description." + (let ((result (test-link-description "[[url][Multiple Spaces]]"))) + (should (string= result "Multiple Spaces")))) + +(provide 'test-org-roam-config-link-description) +;;; test-org-roam-config-link-description.el ends here diff --git a/tests/test-org-roam-config-slug.el b/tests/test-org-roam-config-slug.el new file mode 100644 index 00000000..eb3149dd --- /dev/null +++ b/tests/test-org-roam-config-slug.el @@ -0,0 +1,223 @@ +;;; test-org-roam-config-slug.el --- Tests for cj/--generate-roam-slug -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--generate-roam-slug function from org-roam-config.el +;; +;; This function converts a title to a filename-safe slug by: +;; 1. Converting to lowercase +;; 2. Replacing non-alphanumeric characters with hyphens +;; 3. Removing leading and trailing hyphens +;; +;; Examples: +;; Input: "My Project Name" +;; Output: "my-project-name" +;; +;; Input: "Hello, World!" +;; Output: "hello-world" + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Now load the actual production module +(require 'org-roam-config) + +;;; Test Helpers + +(defun test-slug (title) + "Test cj/--generate-roam-slug on TITLE. +Returns the slugified string." + (cj/--generate-roam-slug title)) + +;;; Normal Cases - Simple Titles + +(ert-deftest test-slug-simple-word () + "Should return lowercase simple word." + (let ((result (test-slug "Hello"))) + (should (string= result "hello")))) + +(ert-deftest test-slug-multiple-words () + "Should replace spaces with hyphens." + (let ((result (test-slug "My Project Name"))) + (should (string= result "my-project-name")))) + +(ert-deftest test-slug-already-lowercase () + "Should handle already lowercase text." + (let ((result (test-slug "simple"))) + (should (string= result "simple")))) + +(ert-deftest test-slug-mixed-case () + "Should convert mixed case to lowercase." + (let ((result (test-slug "MixedCaseTitle"))) + (should (string= result "mixedcasetitle")))) + +;;; Normal Cases - Punctuation + +(ert-deftest test-slug-with-comma () + "Should remove commas." + (let ((result (test-slug "Hello, World"))) + (should (string= result "hello-world")))) + +(ert-deftest test-slug-with-period () + "Should remove periods." + (let ((result (test-slug "Version 2.0"))) + (should (string= result "version-2-0")))) + +(ert-deftest test-slug-with-exclamation () + "Should remove exclamation marks." + (let ((result (test-slug "Hello World!"))) + (should (string= result "hello-world")))) + +(ert-deftest test-slug-with-question () + "Should remove question marks." + (let ((result (test-slug "What Is This?"))) + (should (string= result "what-is-this")))) + +(ert-deftest test-slug-with-colon () + "Should remove colons." + (let ((result (test-slug "Note: Important"))) + (should (string= result "note-important")))) + +(ert-deftest test-slug-with-parentheses () + "Should remove parentheses." + (let ((result (test-slug "Item (copy)"))) + (should (string= result "item-copy")))) + +;;; Normal Cases - Numbers + +(ert-deftest test-slug-with-numbers () + "Should preserve numbers." + (let ((result (test-slug "Chapter 42"))) + (should (string= result "chapter-42")))) + +(ert-deftest test-slug-only-numbers () + "Should handle titles with only numbers." + (let ((result (test-slug "123"))) + (should (string= result "123")))) + +(ert-deftest test-slug-mixed-alphanumeric () + "Should preserve alphanumeric characters." + (let ((result (test-slug "Test123ABC"))) + (should (string= result "test123abc")))) + +;;; Boundary Cases - Multiple Consecutive Special Chars + +(ert-deftest test-slug-multiple-spaces () + "Should collapse multiple spaces into single hyphen." + (let ((result (test-slug "Hello World"))) + (should (string= result "hello-world")))) + +(ert-deftest test-slug-mixed-punctuation () + "Should collapse mixed punctuation into single hyphen." + (let ((result (test-slug "Hello, ... World!"))) + (should (string= result "hello-world")))) + +(ert-deftest test-slug-consecutive-hyphens () + "Should collapse consecutive hyphens." + (let ((result (test-slug "Hello---World"))) + (should (string= result "hello-world")))) + +;;; Boundary Cases - Leading/Trailing Special Chars + +(ert-deftest test-slug-leading-space () + "Should remove leading hyphen from leading space." + (let ((result (test-slug " Hello"))) + (should (string= result "hello")))) + +(ert-deftest test-slug-trailing-space () + "Should remove trailing hyphen from trailing space." + (let ((result (test-slug "Hello "))) + (should (string= result "hello")))) + +(ert-deftest test-slug-leading-punctuation () + "Should remove leading hyphen from leading punctuation." + (let ((result (test-slug "...Hello"))) + (should (string= result "hello")))) + +(ert-deftest test-slug-trailing-punctuation () + "Should remove trailing hyphen from trailing punctuation." + (let ((result (test-slug "Hello!!!"))) + (should (string= result "hello")))) + +(ert-deftest test-slug-leading-and-trailing () + "Should remove both leading and trailing hyphens." + (let ((result (test-slug " Hello World "))) + (should (string= result "hello-world")))) + +;;; Boundary Cases - Empty and Short + +(ert-deftest test-slug-empty-string () + "Should return empty string for empty input." + (let ((result (test-slug ""))) + (should (string= result "")))) + +(ert-deftest test-slug-only-punctuation () + "Should return empty string for only punctuation." + (let ((result (test-slug "!!!"))) + (should (string= result "")))) + +(ert-deftest test-slug-only-spaces () + "Should return empty string for only spaces." + (let ((result (test-slug " "))) + (should (string= result "")))) + +(ert-deftest test-slug-single-char () + "Should handle single character." + (let ((result (test-slug "A"))) + (should (string= result "a")))) + +;;; Edge Cases - Special Characters + +(ert-deftest test-slug-with-underscore () + "Should replace underscores with hyphens." + (let ((result (test-slug "my_variable_name"))) + (should (string= result "my-variable-name")))) + +(ert-deftest test-slug-with-slash () + "Should remove slashes." + (let ((result (test-slug "path/to/file"))) + (should (string= result "path-to-file")))) + +(ert-deftest test-slug-with-at-sign () + "Should remove at signs." + (let ((result (test-slug "user@example"))) + (should (string= result "user-example")))) + +(ert-deftest test-slug-with-hash () + "Should remove hash symbols." + (let ((result (test-slug "#hashtag"))) + (should (string= result "hashtag")))) + +(ert-deftest test-slug-with-dollar () + "Should remove dollar signs." + (let ((result (test-slug "$price"))) + (should (string= result "price")))) + +;;; Edge Cases - Unicode (if supported) + +(ert-deftest test-slug-with-unicode () + "Should remove unicode characters." + (let ((result (test-slug "Café"))) + (should (string= result "caf")))) + +(ert-deftest test-slug-with-emoji () + "Should remove emoji." + (let ((result (test-slug "Hello 😀 World"))) + (should (string= result "hello-world")))) + +;;; Edge Cases - Long Titles + +(ert-deftest test-slug-very-long-title () + "Should handle very long titles." + (let* ((long-title (mapconcat #'identity (make-list 20 "word") " ")) + (result (test-slug long-title))) + (should (string-prefix-p "word-" result)) + (should (string-suffix-p "-word" result)) + (should (not (string-match-p " " result))))) + +(provide 'test-org-roam-config-slug) +;;; test-org-roam-config-slug.el ends here diff --git a/tests/test-org-sort-by-todo-and-priority.el b/tests/test-org-sort-by-todo-and-priority.el new file mode 100644 index 00000000..873f37c2 --- /dev/null +++ b/tests/test-org-sort-by-todo-and-priority.el @@ -0,0 +1,283 @@ +;;; test-org-sort-by-todo-and-priority.el --- Tests for cj/org-sort-by-todo-and-priority -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Unit tests for cj/org-sort-by-todo-and-priority function. +;; Tests multi-level sorting: TODO status (TODO before DONE) and priority (A before B before C). +;; +;; Testing approach: +;; - Use real org-mode buffers (don't mock org-sort-entries) +;; - Trust org-mode framework works correctly +;; - Test OUR integration logic: calling org-sort-entries twice in correct order +;; - Verify final sort order matches expected TODO/priority combination +;; +;; The function uses stable sorting: +;; 1. First sort by priority (A, B, C, D, none) +;; 2. Then sort by TODO status (TODO before DONE) +;; Result: Priority order preserved within each TODO state group + +;;; Code: + +(require 'ert) +(require 'org) +(require 'org-config) ; Defines cj/org-sort-by-todo-and-priority + +;;; Test Helpers + +(defun test-org-sort-by-todo-and-priority--create-buffer (content) + "Create a temporary org-mode buffer with CONTENT. +Returns the buffer object. +Disables org-mode hooks to avoid missing package dependencies in batch mode." + (let ((buf (generate-new-buffer "*test-org-sort*"))) + (with-current-buffer buf + ;; Disable hooks to prevent org-superstar and other package loads + (let ((org-mode-hook nil)) + (org-mode)) + (insert content) + (goto-char (point-min))) + buf)) + +(defun test-org-sort-by-todo-and-priority--get-entry-order (buffer) + "Extract ordered list of TODO states and priorities from BUFFER. +Returns list of strings like \"TODO [#A]\" or \"DONE\" for each heading." + (with-current-buffer buffer + (goto-char (point-min)) + (let (entries) + (org-map-entries + (lambda () + (let* ((todo-state (org-get-todo-state)) + ;; Get heading: no-tags, no-todo, KEEP priority, no-comment + (heading (org-get-heading t t nil t)) + ;; Extract priority cookie from heading text + (priority (when (string-match "\\[#\\([A-Z]\\)\\]" heading) + (match-string 1 heading)))) + (push (if priority + (format "%s [#%s]" (or todo-state "") priority) + (or todo-state "")) + entries))) + nil 'tree) + (nreverse entries)))) + +(defun test-org-sort-by-todo-and-priority--sort-children (buffer) + "Position cursor on parent heading in BUFFER and sort its children. +Moves to first * heading (Parent) and calls sort function to sort children." + (with-current-buffer buffer + (goto-char (point-min)) + (when (re-search-forward "^\\* " nil t) + (beginning-of-line) + (cj/org-sort-by-todo-and-priority)))) + +;;; Normal Cases + +(ert-deftest test-org-sort-by-todo-and-priority-normal-mixed-todo-done-sorts-correctly () + "Test mixed TODO and DONE entries with various priorities sort correctly. + +Input: TODO [#A], DONE [#B], TODO [#C], DONE [#A] +Expected: TODO [#A], TODO [#C], DONE [#A], DONE [#B]" + (let* ((content "* Parent +** TODO [#A] First task +** DONE [#B] Second task +** TODO [#C] Third task +** DONE [#A] Fourth task +") + (buf (test-org-sort-by-todo-and-priority--create-buffer content))) + (unwind-protect + (progn + (test-org-sort-by-todo-and-priority--sort-children buf) + (let ((order (test-org-sort-by-todo-and-priority--get-entry-order buf))) + (should (equal order '("" "TODO [#A]" "TODO [#C]" "DONE [#A]" "DONE [#B]"))))) + (kill-buffer buf)))) + +(ert-deftest test-org-sort-by-todo-and-priority-normal-multiple-todos-sorts-by-priority () + "Test multiple TODO entries sort by priority A before B before C. + +Input: TODO [#C], TODO [#A], TODO [#B] +Expected: TODO [#A], TODO [#B], TODO [#C]" + (let* ((content "* Parent +** TODO [#C] Task C +** TODO [#A] Task A +** TODO [#B] Task B +") + (buf (test-org-sort-by-todo-and-priority--create-buffer content))) + (unwind-protect + (progn + (test-org-sort-by-todo-and-priority--sort-children buf) + (let ((order (test-org-sort-by-todo-and-priority--get-entry-order buf))) + (should (equal order '("" "TODO [#A]" "TODO [#B]" "TODO [#C]"))))) + (kill-buffer buf)))) + +(ert-deftest test-org-sort-by-todo-and-priority-normal-multiple-dones-sorts-by-priority () + "Test multiple DONE entries sort by priority A before B before C. + +Input: DONE [#C], DONE [#A], DONE [#B] +Expected: DONE [#A], DONE [#B], DONE [#C]" + (let* ((content "* Parent +** DONE [#C] Done C +** DONE [#A] Done A +** DONE [#B] Done B +") + (buf (test-org-sort-by-todo-and-priority--create-buffer content))) + (unwind-protect + (progn + (test-org-sort-by-todo-and-priority--sort-children buf) + (let ((order (test-org-sort-by-todo-and-priority--get-entry-order buf))) + (should (equal order '("" "DONE [#A]" "DONE [#B]" "DONE [#C]"))))) + (kill-buffer buf)))) + +(ert-deftest test-org-sort-by-todo-and-priority-normal-same-priority-todo-before-done () + "Test entries with same priority sort TODO before DONE. + +Input: DONE [#A], TODO [#A] +Expected: TODO [#A], DONE [#A]" + (let* ((content "* Parent +** DONE [#A] Done task +** TODO [#A] Todo task +") + (buf (test-org-sort-by-todo-and-priority--create-buffer content))) + (unwind-protect + (progn + (test-org-sort-by-todo-and-priority--sort-children buf) + (let ((order (test-org-sort-by-todo-and-priority--get-entry-order buf))) + (should (equal order '("" "TODO [#A]" "DONE [#A]"))))) + (kill-buffer buf)))) + +;;; Boundary Cases + +(ert-deftest test-org-sort-by-todo-and-priority-boundary-empty-section-no-error () + "Test sorting empty section does not signal error. + +Input: Heading with no children +Expected: No error, no change" + (let* ((content "* Parent\n") + (buf (test-org-sort-by-todo-and-priority--create-buffer content))) + (unwind-protect + (with-current-buffer buf + (goto-char (point-min)) + (should-not (condition-case err + (progn + (cj/org-sort-by-todo-and-priority) + nil) + (error err)))) + (kill-buffer buf)))) + +(ert-deftest test-org-sort-by-todo-and-priority-boundary-single-todo-no-change () + "Test sorting single TODO entry does not change order. + +Input: Single TODO [#A] +Expected: Same order (no change)" + (let* ((content "* Parent +** TODO [#A] Only task +") + (buf (test-org-sort-by-todo-and-priority--create-buffer content))) + (unwind-protect + (progn + (test-org-sort-by-todo-and-priority--sort-children buf) + (let ((order (test-org-sort-by-todo-and-priority--get-entry-order buf))) + (should (equal order '("" "TODO [#A]"))))) + (kill-buffer buf)))) + +(ert-deftest test-org-sort-by-todo-and-priority-boundary-single-done-no-change () + "Test sorting single DONE entry does not change order. + +Input: Single DONE [#B] +Expected: Same order (no change)" + (let* ((content "* Parent +** DONE [#B] Only task +") + (buf (test-org-sort-by-todo-and-priority--create-buffer content))) + (unwind-protect + (progn + (test-org-sort-by-todo-and-priority--sort-children buf) + (let ((order (test-org-sort-by-todo-and-priority--get-entry-order buf))) + (should (equal order '("" "DONE [#B]"))))) + (kill-buffer buf)))) + +(ert-deftest test-org-sort-by-todo-and-priority-boundary-all-todos-sorts-by-priority () + "Test all TODO entries sort by priority only. + +Input: TODO [#C], TODO [#A], TODO [#B] +Expected: TODO [#A], TODO [#B], TODO [#C]" + (let* ((content "* Parent +** TODO [#C] Task C +** TODO [#A] Task A +** TODO [#B] Task B +") + (buf (test-org-sort-by-todo-and-priority--create-buffer content))) + (unwind-protect + (progn + (test-org-sort-by-todo-and-priority--sort-children buf) + (let ((order (test-org-sort-by-todo-and-priority--get-entry-order buf))) + (should (equal order '("" "TODO [#A]" "TODO [#B]" "TODO [#C]"))))) + (kill-buffer buf)))) + +(ert-deftest test-org-sort-by-todo-and-priority-boundary-all-dones-sorts-by-priority () + "Test all DONE entries sort by priority only. + +Input: DONE [#B], DONE [#D], DONE [#A] +Expected: DONE [#A], DONE [#B], DONE [#D]" + (let* ((content "* Parent +** DONE [#B] Done B +** DONE [#D] Done D +** DONE [#A] Done A +") + (buf (test-org-sort-by-todo-and-priority--create-buffer content))) + (unwind-protect + (progn + (test-org-sort-by-todo-and-priority--sort-children buf) + (let ((order (test-org-sort-by-todo-and-priority--get-entry-order buf))) + (should (equal order '("" "DONE [#A]" "DONE [#B]" "DONE [#D]"))))) + (kill-buffer buf)))) + +(ert-deftest test-org-sort-by-todo-and-priority-boundary-no-priorities-sorts-by-todo () + "Test entries without priorities sort by TODO status only. + +Input: TODO (no priority), DONE (no priority), TODO (no priority) +Expected: TODO, TODO, DONE" + (let* ((content "* Parent +** TODO Task 1 +** DONE Task 2 +** TODO Task 3 +") + (buf (test-org-sort-by-todo-and-priority--create-buffer content))) + (unwind-protect + (progn + (test-org-sort-by-todo-and-priority--sort-children buf) + (let ((order (test-org-sort-by-todo-and-priority--get-entry-order buf))) + (should (equal order '("" "TODO" "TODO" "DONE"))))) + (kill-buffer buf)))) + +(ert-deftest test-org-sort-by-todo-and-priority-boundary-unprioritized-after-prioritized () + "Test unprioritized entries appear after prioritized within TODO/DONE groups. + +Input: TODO (no priority), TODO [#A], DONE [#B], DONE (no priority) +Expected: TODO [#A], TODO (no priority), DONE [#B], DONE (no priority)" + (let* ((content "* Parent +** TODO Task no priority +** TODO [#A] Task A +** DONE [#B] Done B +** DONE Done no priority +") + (buf (test-org-sort-by-todo-and-priority--create-buffer content))) + (unwind-protect + (progn + (test-org-sort-by-todo-and-priority--sort-children buf) + (let ((order (test-org-sort-by-todo-and-priority--get-entry-order buf))) + (should (equal order '("" "TODO [#A]" "TODO" "DONE [#B]" "DONE"))))) + (kill-buffer buf)))) + +;;; Error Cases + +(ert-deftest test-org-sort-by-todo-and-priority-error-non-org-buffer-signals-error () + "Test calling in non-org-mode buffer signals user-error. + +Input: fundamental-mode buffer +Expected: user-error" + (let ((buf (generate-new-buffer "*test-non-org*"))) + (unwind-protect + (with-current-buffer buf + (fundamental-mode) + (should-error (cj/org-sort-by-todo-and-priority) :type 'user-error)) + (kill-buffer buf)))) + +(provide 'test-org-sort-by-todo-and-priority) +;;; test-org-sort-by-todo-and-priority.el ends here diff --git a/tests/test-org-webclipper-process.el b/tests/test-org-webclipper-process.el new file mode 100644 index 00000000..9a25ef5c --- /dev/null +++ b/tests/test-org-webclipper-process.el @@ -0,0 +1,210 @@ +;;; test-org-webclipper-process.el --- Tests for cj/--process-webclip-content -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--process-webclip-content function from org-webclipper.el +;; +;; This function processes webclipped org-mode content by: +;; 1. Removing the first top-level heading +;; 2. Removing any initial blank lines +;; 3. Demoting all remaining headings by one level +;; +;; Examples: +;; Input: "* Title\nContent\n** Sub\n" +;; Output: "Content\n*** Sub\n" +;; +;; Input: "* Title\n\n\n** Sub\n" +;; Output: "*** Sub\n" + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Now load the actual production module +(require 'org-webclipper) + +;;; Test Helpers + +(defun test-process-webclip (content) + "Test cj/--process-webclip-content on CONTENT. +Returns the processed content." + (cj/--process-webclip-content content)) + +;;; Normal Cases - Single Heading Removal + +(ert-deftest test-process-removes-first-heading () + "Should remove the first top-level heading." + (let ((result (test-process-webclip "* Title\nContent\n"))) + (should (string= result "Content\n")))) + +(ert-deftest test-process-removes-heading-with-text () + "Should remove first heading preserving body text." + (let ((result (test-process-webclip "* Page Title\nParagraph text\n"))) + (should (string= result "Paragraph text\n")))) + +(ert-deftest test-process-removes-heading-with-tags () + "Should remove first heading even with tags." + (let ((result (test-process-webclip "* Title :tag1:tag2:\nContent\n"))) + (should (string= result "Content\n")))) + +(ert-deftest test-process-removes-heading-with-todo () + "Should remove first heading even with TODO keyword." + (let ((result (test-process-webclip "* TODO Task\nContent\n"))) + (should (string= result "Content\n")))) + +;;; Normal Cases - Blank Line Removal + +(ert-deftest test-process-removes-single-blank-line () + "Should remove single blank line after heading removal." + (let ((result (test-process-webclip "* Title\n\nContent\n"))) + (should (string= result "Content\n")))) + +(ert-deftest test-process-removes-multiple-blank-lines () + "Should remove multiple blank lines after heading removal." + (let ((result (test-process-webclip "* Title\n\n\n\nContent\n"))) + (should (string= result "Content\n")))) + +(ert-deftest test-process-removes-blank-lines-with-spaces () + "Should remove blank lines that contain only spaces." + (let ((result (test-process-webclip "* Title\n \n\t\nContent\n"))) + (should (string= result "Content\n")))) + +(ert-deftest test-process-preserves-blank-lines-in-content () + "Should preserve blank lines within the content." + (let ((result (test-process-webclip "* Title\nPara 1\n\nPara 2\n"))) + (should (string= result "Para 1\n\nPara 2\n")))) + +;;; Normal Cases - Heading Demotion + +(ert-deftest test-process-demotes-second-level () + "Should demote level 2 heading to level 3." + (let ((result (test-process-webclip "* Title\n** Section\n"))) + (should (string= result "*** Section\n")))) + +(ert-deftest test-process-demotes-third-level () + "Should demote level 3 heading to level 4." + (let ((result (test-process-webclip "* Title\n*** Subsection\n"))) + (should (string= result "**** Subsection\n")))) + +(ert-deftest test-process-demotes-multiple-headings () + "Should demote all headings in the content." + (let ((result (test-process-webclip "* Title\n** Section 1\n** Section 2\n"))) + (should (string= result "*** Section 1\n*** Section 2\n")))) + +(ert-deftest test-process-demotes-nested-hierarchy () + "Should demote nested heading structure." + (let ((result (test-process-webclip "* Title\n** Section\n*** Subsection\n"))) + (should (string= result "*** Section\n**** Subsection\n")))) + +;;; Normal Cases - Combined Processing + +(ert-deftest test-process-full-workflow () + "Should remove heading, blank lines, and demote remaining headings." + (let ((result (test-process-webclip "* Article Title\n\n** Introduction\nText\n** Conclusion\n"))) + (should (string= result "*** Introduction\nText\n*** Conclusion\n")))) + +(ert-deftest test-process-with-properties () + "Should preserve properties in demoted headings." + (let ((result (test-process-webclip "* Title\n** Heading\n:PROPERTIES:\n:ID: 123\n:END:\n"))) + (should (string= result "*** Heading\n:PROPERTIES:\n:ID: 123\n:END:\n")))) + +(ert-deftest test-process-with-mixed-content () + "Should handle mixed text and headings." + (let ((result (test-process-webclip "* Title\nIntro text\n** Section\nBody text\n"))) + (should (string= result "Intro text\n*** Section\nBody text\n")))) + +;;; Edge Cases - Empty and Minimal Content + +(ert-deftest test-process-empty-string () + "Should return empty string for empty input." + (let ((result (test-process-webclip ""))) + (should (string= result "")))) + +(ert-deftest test-process-only-heading () + "Should return empty string when only first heading present." + (let ((result (test-process-webclip "* Title\n"))) + (should (string= result "")))) + +(ert-deftest test-process-only-blank-lines () + "Should return empty string for only blank lines after heading." + (let ((result (test-process-webclip "* Title\n\n\n"))) + (should (string= result "")))) + +(ert-deftest test-process-no-heading () + "Should handle content without any heading." + (let ((result (test-process-webclip "Just plain text\n"))) + (should (string= result "Just plain text\n")))) + +(ert-deftest test-process-heading-no-newline () + "Should demote heading without trailing newline (doesn't match removal pattern)." + (let ((result (test-process-webclip "* Title"))) + (should (string= result "** Title")))) + +;;; Edge Cases - Heading Variations + +(ert-deftest test-process-heading-without-space () + "Should not match heading without space after stars." + (let ((result (test-process-webclip "*Title\nContent\n"))) + (should (string= result "*Title\nContent\n")))) + +(ert-deftest test-process-multiple-top-level-headings () + "Should only remove first top-level heading." + (let ((result (test-process-webclip "* Title 1\n* Title 2\n"))) + (should (string= result "** Title 2\n")))) + +(ert-deftest test-process-heading-with-priority () + "Should remove heading with priority marker." + (let ((result (test-process-webclip "* [#A] Important\nContent\n"))) + (should (string= result "Content\n")))) + +(ert-deftest test-process-heading-with-links () + "Should remove heading containing links." + (let ((result (test-process-webclip "* [[url][Link Title]]\nContent\n"))) + (should (string= result "Content\n")))) + +;;; Edge Cases - Special Content + +(ert-deftest test-process-preserves-lists () + "Should preserve list formatting." + (let ((result (test-process-webclip "* Title\n- Item 1\n- Item 2\n"))) + (should (string= result "- Item 1\n- Item 2\n")))) + +(ert-deftest test-process-preserves-code-blocks () + "Should preserve code block content." + (let ((result (test-process-webclip "* Title\n#+BEGIN_SRC python\nprint('hi')\n#+END_SRC\n"))) + (should (string= result "#+BEGIN_SRC python\nprint('hi')\n#+END_SRC\n")))) + +(ert-deftest test-process-preserves-tables () + "Should preserve org table content." + (let ((result (test-process-webclip "* Title\n| A | B |\n| 1 | 2 |\n"))) + (should (string= result "| A | B |\n| 1 | 2 |\n")))) + +;;; Edge Cases - Deep Nesting + +(ert-deftest test-process-very-deep-headings () + "Should demote very deep heading structures." + (let ((result (test-process-webclip "* Title\n****** Level 6\n"))) + (should (string= result "******* Level 6\n")))) + +(ert-deftest test-process-complex-document () + "Should handle complex document structure." + (let ((result (test-process-webclip "* Main Title\n\n** Section 1\nText 1\n*** Subsection 1.1\nText 2\n** Section 2\nText 3\n"))) + (should (string= result "*** Section 1\nText 1\n**** Subsection 1.1\nText 2\n*** Section 2\nText 3\n")))) + +;;; Integration Tests + +(ert-deftest test-process-realistic-webpage () + "Should process realistic webclipped content." + (let ((result (test-process-webclip "* How to Program in Emacs Lisp\n\n** Introduction\nEmacs Lisp is powerful.\n\n** Getting Started\nFirst, open Emacs.\n\n*** Installation\nDownload from gnu.org\n"))) + (should (string= result "*** Introduction\nEmacs Lisp is powerful.\n\n*** Getting Started\nFirst, open Emacs.\n\n**** Installation\nDownload from gnu.org\n")))) + +(ert-deftest test-process-article-with-metadata () + "Should handle article with org metadata." + (let ((result (test-process-webclip "* Article Title :article:web:\n#+DATE: 2024-01-01\n\n** Content\nBody text\n"))) + (should (string= result "#+DATE: 2024-01-01\n\n*** Content\nBody text\n")))) + +(provide 'test-org-webclipper-process) +;;; test-org-webclipper-process.el ends here diff --git a/tests/test-system-lib-executable-exists-p.el b/tests/test-system-lib-executable-exists-p.el new file mode 100644 index 00000000..457bb010 --- /dev/null +++ b/tests/test-system-lib-executable-exists-p.el @@ -0,0 +1,73 @@ +;;; test-system-lib-executable-exists-p.el --- Tests for cj/executable-exists-p -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/executable-exists-p function from system-lib.el. +;; Tests whether external programs are correctly detected in PATH. + +;;; Code: + +(require 'ert) +(require 'system-lib) + +;;; Normal Cases + +(ert-deftest test-system-lib-executable-exists-p-normal-existing-program-returns-path () + "Test that existing program in PATH returns non-nil. + +Standard case: checking for a program that definitely exists on all systems." + (should (cj/executable-exists-p "ls"))) + +(ert-deftest test-system-lib-executable-exists-p-normal-diff-exists-returns-path () + "Test that diff program exists and is detected. + +Tests specifically for diff which we use in our diff functionality." + (should (cj/executable-exists-p "diff"))) + +;;; Boundary Cases + +(ert-deftest test-system-lib-executable-exists-p-boundary-empty-string-returns-nil () + "Test that empty string returns nil. + +Boundary case: empty string is not a valid program name." + (should-not (cj/executable-exists-p ""))) + +(ert-deftest test-system-lib-executable-exists-p-boundary-whitespace-only-returns-nil () + "Test that whitespace-only string returns nil. + +Boundary case: strings containing only whitespace are not valid programs." + (should-not (cj/executable-exists-p " "))) + +(ert-deftest test-system-lib-executable-exists-p-boundary-absolute-path-returns-path () + "Test that absolute path to executable returns the path. + +Boundary case: executable-find accepts both program names and full paths." + (should (cj/executable-exists-p "/usr/bin/ls"))) + +;;; Error Cases + +(ert-deftest test-system-lib-executable-exists-p-error-nil-input-returns-nil () + "Test that nil input returns nil gracefully. + +Error case: nil is not a valid program name." + (should-not (cj/executable-exists-p nil))) + +(ert-deftest test-system-lib-executable-exists-p-error-number-input-returns-nil () + "Test that numeric input returns nil gracefully. + +Error case: number is not a valid program name." + (should-not (cj/executable-exists-p 42))) + +(ert-deftest test-system-lib-executable-exists-p-error-nonexistent-program-returns-nil () + "Test that nonexistent program returns nil. + +Error case: program that definitely doesn't exist in PATH." + (should-not (cj/executable-exists-p "this-program-definitely-does-not-exist-xyz123"))) + +(ert-deftest test-system-lib-executable-exists-p-error-special-characters-returns-nil () + "Test that program name with special characters returns nil. + +Error case: invalid characters in program name." + (should-not (cj/executable-exists-p "program-with-$pecial-ch@rs"))) + +(provide 'test-system-lib-executable-exists-p) +;;; test-system-lib-executable-exists-p.el ends here diff --git a/tests/test-test-runner.el b/tests/test-test-runner.el new file mode 100644 index 00000000..0edc0d65 --- /dev/null +++ b/tests/test-test-runner.el @@ -0,0 +1,359 @@ +;;; test-test-runner.el --- Tests for test-runner.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for test-runner.el - ERT test runner with focus/unfocus workflow. +;; +;; Testing approach: +;; - Tests focus on internal `cj/test--do-*` functions (pure business logic) +;; - File system operations use temp directories +;; - Tests are isolated with setup/teardown +;; - Tests verify return values, not user messages + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Load the module (ignore keymap error in batch mode) +(condition-case nil + (require 'test-runner) + (error nil)) + +;;; Test Utilities + +(defvar test-testrunner--temp-dir nil + "Temporary directory for test files during tests.") + +(defvar test-testrunner--original-focused-files nil + "Backup of focused files list before test.") + +(defun test-testrunner-setup () + "Setup test environment before each test." + ;; Backup current state + (setq test-testrunner--original-focused-files cj/test-focused-files) + ;; Reset to clean state + (setq cj/test-focused-files '()) + ;; Create temp directory for file tests + (setq test-testrunner--temp-dir (make-temp-file "test-runner-test" t))) + +(defun test-testrunner-teardown () + "Clean up test environment after each test." + ;; Restore state + (setq cj/test-focused-files test-testrunner--original-focused-files) + ;; Clean up temp directory + (when (and test-testrunner--temp-dir + (file-directory-p test-testrunner--temp-dir)) + (delete-directory test-testrunner--temp-dir t)) + (setq test-testrunner--temp-dir nil)) + +(defun test-testrunner-create-test-file (filename content) + "Create test file FILENAME with CONTENT in temp directory." + (let ((filepath (expand-file-name filename test-testrunner--temp-dir))) + (with-temp-file filepath + (insert content)) + filepath)) + +;;; Normal Cases - Load Files + +(ert-deftest test-testrunner-load-files-success () + "Should successfully load test files." + (test-testrunner-setup) + (let* ((file1 (test-testrunner-create-test-file "test-simple.el" + "(defun test-func () t)")) + (file2 (test-testrunner-create-test-file "test-other.el" + "(defun other-func () nil)")) + (result (cj/test--do-load-files test-testrunner--temp-dir + (list file1 file2)))) + (should (eq (car result) 'success)) + (should (= (cdr result) 2))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-load-files-with-errors () + "Should handle errors during file loading." + (test-testrunner-setup) + (let* ((good-file (test-testrunner-create-test-file "test-good.el" + "(defun good () t)")) + (bad-file (test-testrunner-create-test-file "test-bad.el" + "(defun bad ( ")) + (result (cj/test--do-load-files test-testrunner--temp-dir + (list good-file bad-file)))) + (should (eq (car result) 'error)) + (should (= (nth 1 result) 1)) ; loaded-count + (should (= (length (nth 2 result)) 1))) ; errors list + (test-testrunner-teardown)) + +;;; Normal Cases - Focus Add + +(ert-deftest test-testrunner-focus-add-success () + "Should successfully add file to focus." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-add "test-foo.el" + '("test-foo.el" "test-bar.el") + '()))) + (should (eq result 'success))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-add-already-focused () + "Should detect already focused file." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-add "test-foo.el" + '("test-foo.el" "test-bar.el") + '("test-foo.el")))) + (should (eq result 'already-focused))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-add-not-available () + "Should detect file not in available list." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-add "test-missing.el" + '("test-foo.el" "test-bar.el") + '()))) + (should (eq result 'not-available))) + (test-testrunner-teardown)) + +;;; Normal Cases - Focus Add File + +(ert-deftest test-testrunner-focus-add-file-success () + "Should successfully validate and add file to focus." + (test-testrunner-setup) + (let* ((filepath (expand-file-name "test-foo.el" test-testrunner--temp-dir)) + (result (cj/test--do-focus-add-file filepath test-testrunner--temp-dir '()))) + (should (eq (car result) 'success)) + (should (string= (cdr result) "test-foo.el"))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-add-file-no-file () + "Should detect nil filepath." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-add-file nil test-testrunner--temp-dir '()))) + (should (eq (car result) 'no-file))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-add-file-not-in-testdir () + "Should detect file outside test directory." + (test-testrunner-setup) + (let* ((filepath "/tmp/outside-test.el") + (result (cj/test--do-focus-add-file filepath test-testrunner--temp-dir '()))) + (should (eq (car result) 'not-in-testdir))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-add-file-already-focused () + "Should detect already focused file." + (test-testrunner-setup) + (let* ((filepath (expand-file-name "test-foo.el" test-testrunner--temp-dir)) + (result (cj/test--do-focus-add-file filepath + test-testrunner--temp-dir + '("test-foo.el")))) + (should (eq (car result) 'already-focused)) + (should (string= (cdr result) "test-foo.el"))) + (test-testrunner-teardown)) + +;;; Normal Cases - Focus Remove + +(ert-deftest test-testrunner-focus-remove-success () + "Should successfully remove file from focus." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-remove "test-foo.el" '("test-foo.el" "test-bar.el")))) + (should (eq result 'success))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-remove-empty-list () + "Should detect empty focused list." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-remove "test-foo.el" '()))) + (should (eq result 'empty-list))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-remove-not-found () + "Should detect file not in focused list." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-remove "test-missing.el" '("test-foo.el")))) + (should (eq result 'not-found))) + (test-testrunner-teardown)) + +;;; Normal Cases - Get Focused Tests + +(ert-deftest test-testrunner-get-focused-tests-success () + "Should extract test names from focused files." + (test-testrunner-setup) + (let* ((file1 (test-testrunner-create-test-file "test-first.el" + "(ert-deftest test-alpha-one () (should t))\n(ert-deftest test-alpha-two () (should t))")) + (result (cj/test--do-get-focused-tests '("test-first.el") test-testrunner--temp-dir))) + (should (eq (car result) 'success)) + (should (= (length (nth 1 result)) 2)) ; 2 test names + (should (= (nth 2 result) 1))) ; 1 file loaded + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-get-focused-tests-empty-list () + "Should detect empty focused files list." + (test-testrunner-setup) + (let ((result (cj/test--do-get-focused-tests '() test-testrunner--temp-dir))) + (should (eq (car result) 'empty-list))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-get-focused-tests-no-tests () + "Should detect when no tests found in files." + (test-testrunner-setup) + (test-testrunner-create-test-file "test-empty.el" "(defun not-a-test () t)") + (let ((result (cj/test--do-get-focused-tests '("test-empty.el") test-testrunner--temp-dir))) + (should (eq (car result) 'no-tests))) + (test-testrunner-teardown)) + +;;; Normal Cases - Extract Test Names + +(ert-deftest test-testrunner-extract-test-names-simple () + "Should extract test names from file." + (test-testrunner-setup) + (let* ((file (test-testrunner-create-test-file "test-simple.el" + "(ert-deftest test-foo () (should t))\n(ert-deftest test-bar () (should nil))")) + (names (cj/test--extract-test-names file))) + (should (= (length names) 2)) + (should (member "test-foo" names)) + (should (member "test-bar" names))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-extract-test-names-with-whitespace () + "Should extract test names with various whitespace." + (test-testrunner-setup) + (let* ((file (test-testrunner-create-test-file "test-whitespace.el" + "(ert-deftest test-spaces () (should t))\n (ert-deftest test-indent () t)")) + (names (cj/test--extract-test-names file))) + (should (= (length names) 2)) + (should (member "test-spaces" names)) + (should (member "test-indent" names))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-extract-test-names-no-tests () + "Should return empty list when no tests in file." + (test-testrunner-setup) + (let* ((file (test-testrunner-create-test-file "test-none.el" + "(defun not-a-test () t)")) + (names (cj/test--extract-test-names file))) + (should (null names))) + (test-testrunner-teardown)) + +;;; Normal Cases - Extract Test at Position + +(ert-deftest test-testrunner-extract-test-at-pos-found () + "Should extract test name at point." + (test-testrunner-setup) + (with-temp-buffer + (insert "(ert-deftest test-sample ()\n (should t))") + (goto-char (point-min)) + (let ((name (cj/test--extract-test-at-pos))) + (should (eq name 'test-sample)))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-extract-test-at-pos-not-found () + "Should return nil when not in a test." + (test-testrunner-setup) + (with-temp-buffer + (insert "(defun regular-function ()\n (message \"hi\"))") + (goto-char (point-min)) + (let ((name (cj/test--extract-test-at-pos))) + (should (null name)))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-extract-test-at-pos-invalid-syntax () + "Should return nil for invalid syntax." + (test-testrunner-setup) + (with-temp-buffer + (insert "(ert-deftest") + (goto-char (point-min)) + (let ((name (cj/test--extract-test-at-pos))) + (should (null name)))) + (test-testrunner-teardown)) + +;;; Boundary Cases - Load Files + +(ert-deftest test-testrunner-load-files-empty-list () + "Should handle empty file list." + (test-testrunner-setup) + (let ((result (cj/test--do-load-files test-testrunner--temp-dir '()))) + (should (eq (car result) 'success)) + (should (= (cdr result) 0))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-load-files-nonexistent () + "Should handle nonexistent files." + (test-testrunner-setup) + (let* ((fake-file (expand-file-name "nonexistent.el" test-testrunner--temp-dir)) + (result (cj/test--do-load-files test-testrunner--temp-dir (list fake-file)))) + (should (eq (car result) 'error)) + (should (= (nth 1 result) 0))) ; 0 files loaded + (test-testrunner-teardown)) + +;;; Boundary Cases - Focus Add + +(ert-deftest test-testrunner-focus-add-single-available () + "Should add when only one file available." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-add "test-only.el" '("test-only.el") '()))) + (should (eq result 'success))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-add-case-sensitive () + "Should be case-sensitive for filenames." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-add "Test-Foo.el" + '("test-foo.el") + '()))) + (should (eq result 'not-available))) + (test-testrunner-teardown)) + +;;; Boundary Cases - Get Focused Tests + +(ert-deftest test-testrunner-get-focused-tests-multiple-files () + "Should collect tests from multiple files." + (test-testrunner-setup) + (test-testrunner-create-test-file "test-first.el" + "(ert-deftest test-beta-one () t)") + (test-testrunner-create-test-file "test-second.el" + "(ert-deftest test-beta-two () t)") + (let ((result (cj/test--do-get-focused-tests '("test-first.el" "test-second.el") + test-testrunner--temp-dir))) + (should (eq (car result) 'success)) + (should (= (length (nth 1 result)) 2)) ; 2 tests total + (should (= (nth 2 result) 2))) ; 2 files loaded + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-get-focused-tests-skip-nonexistent () + "Should skip nonexistent files." + (test-testrunner-setup) + (test-testrunner-create-test-file "test-exists.el" + "(ert-deftest test-gamma-one () t)") + (let ((result (cj/test--do-get-focused-tests '("test-exists.el" "test-missing.el") + test-testrunner--temp-dir))) + (should (eq (car result) 'success)) + (should (= (length (nth 1 result)) 1)) ; 1 test found + (should (= (nth 2 result) 1))) ; 1 file loaded (missing skipped) + (test-testrunner-teardown)) + +;;; Boundary Cases - Extract Test Names + +(ert-deftest test-testrunner-extract-test-names-hyphens-underscores () + "Should handle test names with hyphens and underscores." + (test-testrunner-setup) + (let* ((file (test-testrunner-create-test-file "test-names.el" + "(ert-deftest test-with-hyphens () t)\n(ert-deftest test_with_underscores () t)")) + (names (cj/test--extract-test-names file))) + (should (= (length names) 2)) + (should (member "test-with-hyphens" names)) + (should (member "test_with_underscores" names))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-extract-test-names-ignore-comments () + "Should not extract test names from comments." + (test-testrunner-setup) + (let* ((file (test-testrunner-create-test-file "test-comments.el" + ";; (ert-deftest test-commented () t)\n(ert-deftest test-real () t)")) + (names (cj/test--extract-test-names file))) + (should (= (length names) 1)) + (should (member "test-real" names))) + (test-testrunner-teardown)) + +(provide 'test-test-runner) +;;; test-test-runner.el ends here diff --git a/tests/test-transcription-audio-file.el b/tests/test-transcription-audio-file.el new file mode 100644 index 00000000..ac4ff452 --- /dev/null +++ b/tests/test-transcription-audio-file.el @@ -0,0 +1,88 @@ +;;; test-transcription-audio-file.el --- Tests for audio file detection -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/--audio-file-p function +;; Categories: Normal cases, Boundary cases, Error cases + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'transcription-config) + +;; ----------------------------- Normal Cases ---------------------------------- + +(ert-deftest test-cj/--audio-file-p-m4a () + "Test that .m4a files are recognized as audio." + (should (cj/--audio-file-p "meeting.m4a"))) + +(ert-deftest test-cj/--audio-file-p-mp3 () + "Test that .mp3 files are recognized as audio." + (should (cj/--audio-file-p "podcast.mp3"))) + +(ert-deftest test-cj/--audio-file-p-wav () + "Test that .wav files are recognized as audio." + (should (cj/--audio-file-p "recording.wav"))) + +(ert-deftest test-cj/--audio-file-p-flac () + "Test that .flac files are recognized as audio." + (should (cj/--audio-file-p "music.flac"))) + +(ert-deftest test-cj/--audio-file-p-with-path () + "Test audio file recognition with full path." + (should (cj/--audio-file-p "/home/user/recordings/meeting.m4a"))) + +;; ----------------------------- Boundary Cases -------------------------------- + +(ert-deftest test-cj/--audio-file-p-uppercase-extension () + "Test that uppercase extensions are recognized." + (should (cj/--audio-file-p "MEETING.M4A"))) + +(ert-deftest test-cj/--audio-file-p-mixed-case () + "Test that mixed case extensions are recognized." + (should (cj/--audio-file-p "podcast.Mp3"))) + +(ert-deftest test-cj/--audio-file-p-no-extension () + "Test that files without extension are not recognized." + (should-not (cj/--audio-file-p "meeting"))) + +(ert-deftest test-cj/--audio-file-p-empty-string () + "Test that empty string is not recognized as audio." + (should-not (cj/--audio-file-p ""))) + +(ert-deftest test-cj/--audio-file-p-dotfile () + "Test that dotfiles without proper extension are not recognized." + (should-not (cj/--audio-file-p ".hidden"))) + +(ert-deftest test-cj/--audio-file-p-multiple-dots () + "Test file with multiple dots but audio extension." + (should (cj/--audio-file-p "meeting.2025-11-04.final.m4a"))) + +;; ------------------------------ Error Cases ---------------------------------- + +(ert-deftest test-cj/--audio-file-p-not-audio () + "Test that non-audio files are not recognized." + (should-not (cj/--audio-file-p "document.pdf"))) + +(ert-deftest test-cj/--audio-file-p-text-file () + "Test that text files are not recognized as audio." + (should-not (cj/--audio-file-p "notes.txt"))) + +(ert-deftest test-cj/--audio-file-p-org-file () + "Test that org files are not recognized as audio." + (should-not (cj/--audio-file-p "tasks.org"))) + +(ert-deftest test-cj/--audio-file-p-video-file () + "Test that video files are not recognized as audio." + (should-not (cj/--audio-file-p "video.mp4"))) + +(ert-deftest test-cj/--audio-file-p-nil () + "Test that nil input returns nil." + (should-not (cj/--audio-file-p nil))) + +(provide 'test-transcription-audio-file) +;;; test-transcription-audio-file.el ends here diff --git a/tests/test-transcription-config--transcription-script-path.el b/tests/test-transcription-config--transcription-script-path.el new file mode 100644 index 00000000..a56cb05c --- /dev/null +++ b/tests/test-transcription-config--transcription-script-path.el @@ -0,0 +1,106 @@ +;;; test-transcription-config--transcription-script-path.el --- Tests for cj/--transcription-script-path -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--transcription-script-path function from transcription-config.el +;; +;; This function returns the absolute path to the transcription script based on +;; the current value of cj/transcribe-backend. + +;;; Code: + +(require 'ert) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub notification function +(unless (fboundp 'notifications-notify) + (defun notifications-notify (&rest _args) + "Stub notification function for testing." + nil)) + +;; Now load the actual production module +(require 'transcription-config) + +;;; Setup and Teardown + +(defun test-transcription-script-path-setup () + "Set up test environment." + ;; Save original backend setting + (setq test-transcription-original-backend cj/transcribe-backend)) + +(defun test-transcription-script-path-teardown () + "Clean up test environment." + ;; Restore original backend setting + (setq cj/transcribe-backend test-transcription-original-backend)) + +;;; Normal Cases + +(ert-deftest test-transcription-config--transcription-script-path-normal-openai-api-returns-oai-transcribe () + "Should return oai-transcribe script path for openai-api backend." + (test-transcription-script-path-setup) + (unwind-protect + (progn + (setq cj/transcribe-backend 'openai-api) + (let ((result (cj/--transcription-script-path))) + (should (stringp result)) + (should (string-suffix-p "scripts/oai-transcribe" result)) + (should (string-prefix-p (expand-file-name user-emacs-directory) result)))) + (test-transcription-script-path-teardown))) + +(ert-deftest test-transcription-config--transcription-script-path-normal-assemblyai-returns-assemblyai-transcribe () + "Should return assemblyai-transcribe script path for assemblyai backend." + (test-transcription-script-path-setup) + (unwind-protect + (progn + (setq cj/transcribe-backend 'assemblyai) + (let ((result (cj/--transcription-script-path))) + (should (stringp result)) + (should (string-suffix-p "scripts/assemblyai-transcribe" result)) + (should (string-prefix-p (expand-file-name user-emacs-directory) result)))) + (test-transcription-script-path-teardown))) + +(ert-deftest test-transcription-config--transcription-script-path-normal-local-whisper-returns-local-whisper () + "Should return local-whisper script path for local-whisper backend." + (test-transcription-script-path-setup) + (unwind-protect + (progn + (setq cj/transcribe-backend 'local-whisper) + (let ((result (cj/--transcription-script-path))) + (should (stringp result)) + (should (string-suffix-p "scripts/local-whisper" result)) + (should (string-prefix-p (expand-file-name user-emacs-directory) result)))) + (test-transcription-script-path-teardown))) + +(ert-deftest test-transcription-config--transcription-script-path-normal-returns-absolute-path () + "Should return absolute path starting with user-emacs-directory." + (test-transcription-script-path-setup) + (unwind-protect + (progn + (setq cj/transcribe-backend 'openai-api) + (let ((result (cj/--transcription-script-path))) + (should (file-name-absolute-p result)) + (should (string-prefix-p "/" result)))) + (test-transcription-script-path-teardown))) + +;;; Boundary Cases + +(ert-deftest test-transcription-config--transcription-script-path-boundary-path-format-consistent () + "Should return paths in consistent format across backends." + (test-transcription-script-path-setup) + (unwind-protect + (let (paths) + (dolist (backend '(openai-api assemblyai local-whisper)) + (setq cj/transcribe-backend backend) + (push (cj/--transcription-script-path) paths)) + ;; All paths should have same structure: <emacs-dir>/scripts/<name> + (should (= (length paths) 3)) + (should (seq-every-p (lambda (p) (string-match-p "/scripts/[^/]+$" p)) paths))) + (test-transcription-script-path-teardown))) + +(provide 'test-transcription-config--transcription-script-path) +;;; test-transcription-config--transcription-script-path.el ends here diff --git a/tests/test-transcription-counter.el b/tests/test-transcription-counter.el new file mode 100644 index 00000000..dd4df7dc --- /dev/null +++ b/tests/test-transcription-counter.el @@ -0,0 +1,103 @@ +;;; test-transcription-counter.el --- Tests for active transcription counting -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/--count-active-transcriptions and modeline integration +;; Categories: Normal cases, Boundary cases + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'transcription-config) + +;; ----------------------------- Normal Cases ---------------------------------- + +(ert-deftest test-cj/--count-active-transcriptions-empty () + "Test count when no transcriptions are active." + (let ((cj/transcriptions-list '())) + (should (= 0 (cj/--count-active-transcriptions))))) + +(ert-deftest test-cj/--count-active-transcriptions-one-running () + "Test count with one running transcription." + (let ((cj/transcriptions-list + '((proc1 "file1.m4a" nil running)))) + (should (= 1 (cj/--count-active-transcriptions))))) + +(ert-deftest test-cj/--count-active-transcriptions-multiple-running () + "Test count with multiple running transcriptions." + (let ((cj/transcriptions-list + '((proc1 "file1.m4a" nil running) + (proc2 "file2.m4a" nil running) + (proc3 "file3.m4a" nil running)))) + (should (= 3 (cj/--count-active-transcriptions))))) + +(ert-deftest test-cj/--count-active-transcriptions-mixed-status () + "Test count excludes completed/errored transcriptions." + (let ((cj/transcriptions-list + '((proc1 "file1.m4a" nil running) + (proc2 "file2.m4a" nil complete) + (proc3 "file3.m4a" nil running) + (proc4 "file4.m4a" nil error)))) + (should (= 2 (cj/--count-active-transcriptions))))) + +;; ----------------------------- Boundary Cases -------------------------------- + +(ert-deftest test-cj/--count-active-transcriptions-only-complete () + "Test count when all transcriptions are complete." + (let ((cj/transcriptions-list + '((proc1 "file1.m4a" nil complete) + (proc2 "file2.m4a" nil complete)))) + (should (= 0 (cj/--count-active-transcriptions))))) + +(ert-deftest test-cj/--count-active-transcriptions-only-error () + "Test count when all transcriptions errored." + (let ((cj/transcriptions-list + '((proc1 "file1.m4a" nil error) + (proc2 "file2.m4a" nil error)))) + (should (= 0 (cj/--count-active-transcriptions))))) + +;; ----------------------------- Modeline Tests -------------------------------- + +(ert-deftest test-cj/--transcription-modeline-string-none-active () + "Test modeline string when no transcriptions active." + (let ((cj/transcriptions-list '())) + (should-not (cj/--transcription-modeline-string)))) + +(ert-deftest test-cj/--transcription-modeline-string-one-active () + "Test modeline string with one active transcription." + (let ((cj/transcriptions-list + '((proc1 "file1.m4a" nil running)))) + (let ((result (cj/--transcription-modeline-string))) + (should result) + (should (string-match-p "⏺1" result))))) + +(ert-deftest test-cj/--transcription-modeline-string-multiple-active () + "Test modeline string with multiple active transcriptions." + (let ((cj/transcriptions-list + '((proc1 "file1.m4a" nil running) + (proc2 "file2.m4a" nil running) + (proc3 "file3.m4a" nil running)))) + (let ((result (cj/--transcription-modeline-string))) + (should result) + (should (string-match-p "⏺3" result))))) + +(ert-deftest test-cj/--transcription-modeline-string-has-help-echo () + "Test that modeline string has help-echo property." + (let ((cj/transcriptions-list + '((proc1 "file1.m4a" nil running)))) + (let ((result (cj/--transcription-modeline-string))) + (should (get-text-property 0 'help-echo result))))) + +(ert-deftest test-cj/--transcription-modeline-string-has-face () + "Test that modeline string has warning face." + (let ((cj/transcriptions-list + '((proc1 "file1.m4a" nil running)))) + (let ((result (cj/--transcription-modeline-string))) + (should (eq 'warning (get-text-property 0 'face result)))))) + +(provide 'test-transcription-counter) +;;; test-transcription-counter.el ends here diff --git a/tests/test-transcription-duration.el b/tests/test-transcription-duration.el new file mode 100644 index 00000000..4f4e9a75 --- /dev/null +++ b/tests/test-transcription-duration.el @@ -0,0 +1,63 @@ +;;; test-transcription-duration.el --- Tests for duration calculation -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/--transcription-duration function +;; Categories: Normal cases, Boundary cases + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'transcription-config) + +;; ----------------------------- Normal Cases ---------------------------------- + +(ert-deftest test-cj/--transcription-duration-zero-seconds () + "Test duration calculation for current time (should be 00:00)." + (let ((now (current-time))) + (should (string= (cj/--transcription-duration now) "00:00")))) + +(ert-deftest test-cj/--transcription-duration-30-seconds () + "Test duration calculation for 30 seconds ago." + (let ((start-time (time-subtract (current-time) (seconds-to-time 30)))) + (should (string= (cj/--transcription-duration start-time) "00:30")))) + +(ert-deftest test-cj/--transcription-duration-1-minute () + "Test duration calculation for 1 minute ago." + (let ((start-time (time-subtract (current-time) (seconds-to-time 60)))) + (should (string= (cj/--transcription-duration start-time) "01:00")))) + +(ert-deftest test-cj/--transcription-duration-2-minutes-30-seconds () + "Test duration calculation for 2:30 ago." + (let ((start-time (time-subtract (current-time) (seconds-to-time 150)))) + (should (string= (cj/--transcription-duration start-time) "02:30")))) + +(ert-deftest test-cj/--transcription-duration-10-minutes () + "Test duration calculation for 10 minutes ago." + (let ((start-time (time-subtract (current-time) (seconds-to-time 600)))) + (should (string= (cj/--transcription-duration start-time) "10:00")))) + +;; ----------------------------- Boundary Cases -------------------------------- + +(ert-deftest test-cj/--transcription-duration-59-seconds () + "Test duration just before 1 minute." + (let ((start-time (time-subtract (current-time) (seconds-to-time 59)))) + (should (string= (cj/--transcription-duration start-time) "00:59")))) + +(ert-deftest test-cj/--transcription-duration-1-hour () + "Test duration for 1 hour (60 minutes)." + (let ((start-time (time-subtract (current-time) (seconds-to-time 3600)))) + (should (string= (cj/--transcription-duration start-time) "60:00")))) + +(ert-deftest test-cj/--transcription-duration-format () + "Test that duration is always in MM:SS format with zero-padding." + (let ((start-time (time-subtract (current-time) (seconds-to-time 65)))) + (let ((result (cj/--transcription-duration start-time))) + (should (string-match-p "^[0-9][0-9]:[0-9][0-9]$" result))))) + +(provide 'test-transcription-duration) +;;; test-transcription-duration.el ends here diff --git a/tests/test-transcription-log-cleanup.el b/tests/test-transcription-log-cleanup.el new file mode 100644 index 00000000..251e5ef9 --- /dev/null +++ b/tests/test-transcription-log-cleanup.el @@ -0,0 +1,49 @@ +;;; test-transcription-log-cleanup.el --- Tests for log cleanup logic -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/--should-keep-log function +;; Categories: Normal cases, Boundary cases + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'transcription-config) + +;; ----------------------------- Normal Cases ---------------------------------- + +(ert-deftest test-cj/--should-keep-log-success-keep-disabled () + "Test that logs are deleted on success when keep-log is nil." + (let ((cj/transcription-keep-log-when-done nil)) + (should-not (cj/--should-keep-log t)))) + +(ert-deftest test-cj/--should-keep-log-success-keep-enabled () + "Test that logs are kept on success when keep-log is t." + (let ((cj/transcription-keep-log-when-done t)) + (should (cj/--should-keep-log t)))) + +(ert-deftest test-cj/--should-keep-log-error-keep-disabled () + "Test that logs are always kept on error, even if keep-log is nil." + (let ((cj/transcription-keep-log-when-done nil)) + (should (cj/--should-keep-log nil)))) + +(ert-deftest test-cj/--should-keep-log-error-keep-enabled () + "Test that logs are kept on error when keep-log is t." + (let ((cj/transcription-keep-log-when-done t)) + (should (cj/--should-keep-log nil)))) + +;; ----------------------------- Boundary Cases -------------------------------- + +(ert-deftest test-cj/--should-keep-log-default-behavior () + "Test default behavior (should not keep on success)." + ;; Default is nil based on defcustom + (let ((cj/transcription-keep-log-when-done nil)) + (should-not (cj/--should-keep-log t)) + (should (cj/--should-keep-log nil)))) + +(provide 'test-transcription-log-cleanup) +;;; test-transcription-log-cleanup.el ends here diff --git a/tests/test-transcription-paths.el b/tests/test-transcription-paths.el new file mode 100644 index 00000000..69dc27e7 --- /dev/null +++ b/tests/test-transcription-paths.el @@ -0,0 +1,85 @@ +;;; test-transcription-paths.el --- Tests for transcription file path logic -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/--transcription-output-files and cj/--transcription-script-path +;; Categories: Normal cases, Boundary cases, Error cases + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'transcription-config) + +;; ----------------------------- Normal Cases ---------------------------------- + +(ert-deftest test-cj/--transcription-output-files-simple () + "Test output file paths for simple filename." + (let ((result (cj/--transcription-output-files "meeting.m4a"))) + (should (string= (car result) "meeting.txt")) + (should (string= (cdr result) "meeting.log")))) + +(ert-deftest test-cj/--transcription-output-files-with-path () + "Test output file paths with full path." + (let ((result (cj/--transcription-output-files "/home/user/audio/podcast.mp3"))) + (should (string= (car result) "/home/user/audio/podcast.txt")) + (should (string= (cdr result) "/home/user/audio/podcast.log")))) + +(ert-deftest test-cj/--transcription-output-files-different-extensions () + "Test output files for various audio extensions." + (dolist (ext '("m4a" "mp3" "wav" "flac" "ogg")) + (let* ((input (format "audio.%s" ext)) + (result (cj/--transcription-output-files input))) + (should (string= (car result) "audio.txt")) + (should (string= (cdr result) "audio.log"))))) + +;; ----------------------------- Boundary Cases -------------------------------- + +(ert-deftest test-cj/--transcription-output-files-multiple-dots () + "Test output files for filename with multiple dots." + (let ((result (cj/--transcription-output-files "meeting.2025-11-04.final.m4a"))) + (should (string= (car result) "meeting.2025-11-04.final.txt")) + (should (string= (cdr result) "meeting.2025-11-04.final.log")))) + +(ert-deftest test-cj/--transcription-output-files-no-extension () + "Test output files for filename without extension." + (let ((result (cj/--transcription-output-files "meeting"))) + (should (string= (car result) "meeting.txt")) + (should (string= (cdr result) "meeting.log")))) + +(ert-deftest test-cj/--transcription-output-files-spaces-in-name () + "Test output files for filename with spaces." + (let ((result (cj/--transcription-output-files "team meeting 2025.m4a"))) + (should (string= (car result) "team meeting 2025.txt")) + (should (string= (cdr result) "team meeting 2025.log")))) + +(ert-deftest test-cj/--transcription-output-files-special-chars () + "Test output files for filename with special characters." + (let ((result (cj/--transcription-output-files "meeting_(final).m4a"))) + (should (string= (car result) "meeting_(final).txt")) + (should (string= (cdr result) "meeting_(final).log")))) + +;; ----------------------------- Script Path Tests ----------------------------- + +(ert-deftest test-cj/--transcription-script-path-local-whisper () + "Test script path for local-whisper backend." + (let ((cj/transcribe-backend 'local-whisper)) + (should (string-suffix-p "scripts/local-whisper" + (cj/--transcription-script-path))))) + +(ert-deftest test-cj/--transcription-script-path-openai-api () + "Test script path for openai-api backend." + (let ((cj/transcribe-backend 'openai-api)) + (should (string-suffix-p "scripts/oai-transcribe" + (cj/--transcription-script-path))))) + +(ert-deftest test-cj/--transcription-script-path-absolute () + "Test that script path is absolute." + (let ((path (cj/--transcription-script-path))) + (should (file-name-absolute-p path)))) + +(provide 'test-transcription-paths) +;;; test-transcription-paths.el ends here diff --git a/tests/test-undead-buffers-kill-all-other-buffers-and-windows.el b/tests/test-undead-buffers-kill-all-other-buffers-and-windows.el new file mode 100644 index 00000000..dcd08e96 --- /dev/null +++ b/tests/test-undead-buffers-kill-all-other-buffers-and-windows.el @@ -0,0 +1,159 @@ +;;; test-undead-buffers-kill-all-other-buffers-and-windows.el --- Tests for cj/kill-all-other-buffers-and-windows -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/kill-all-other-buffers-and-windows function from undead-buffers.el + +;;; Code: + +(require 'ert) +(require 'undead-buffers) +(require 'testutil-general) + +;;; Setup and Teardown + +(defun test-kill-all-other-buffers-and-windows-setup () + "Setup for kill-all-other-buffers-and-windows tests." + (cj/create-test-base-dir) + (delete-other-windows)) + +(defun test-kill-all-other-buffers-and-windows-teardown () + "Teardown for kill-all-other-buffers-and-windows tests." + (delete-other-windows) + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-kill-all-other-buffers-and-windows-should-kill-regular-buffers () + "Should kill all regular buffers except current." + (test-kill-all-other-buffers-and-windows-setup) + (unwind-protect + (let ((main (current-buffer)) + (buf1 (generate-new-buffer "*test-regular-1*")) + (buf2 (generate-new-buffer "*test-regular-2*"))) + (unwind-protect + (progn + (should (buffer-live-p buf1)) + (should (buffer-live-p buf2)) + (cj/kill-all-other-buffers-and-windows) + (should (buffer-live-p main)) + (should-not (buffer-live-p buf1)) + (should-not (buffer-live-p buf2))) + (when (buffer-live-p buf1) (kill-buffer buf1)) + (when (buffer-live-p buf2) (kill-buffer buf2)))) + (test-kill-all-other-buffers-and-windows-teardown))) + +(ert-deftest test-kill-all-other-buffers-and-windows-should-bury-undead-buffers () + "Should bury undead buffers instead of killing them." + (test-kill-all-other-buffers-and-windows-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list)) + (main (current-buffer)) + (buf1 (generate-new-buffer "*test-undead-1*")) + (buf2 (generate-new-buffer "*test-undead-2*"))) + (unwind-protect + (progn + (add-to-list 'cj/undead-buffer-list "*test-undead-1*") + (add-to-list 'cj/undead-buffer-list "*test-undead-2*") + (cj/kill-all-other-buffers-and-windows) + (should (buffer-live-p main)) + (should (buffer-live-p buf1)) + (should (buffer-live-p buf2))) + (setq cj/undead-buffer-list orig) + (when (buffer-live-p buf1) (kill-buffer buf1)) + (when (buffer-live-p buf2) (kill-buffer buf2)))) + (test-kill-all-other-buffers-and-windows-teardown))) + +(ert-deftest test-kill-all-other-buffers-and-windows-should-keep-current-buffer () + "Should always keep the current buffer alive." + (test-kill-all-other-buffers-and-windows-setup) + (unwind-protect + (let ((main (current-buffer))) + (cj/kill-all-other-buffers-and-windows) + (should (buffer-live-p main)) + (should (eq main (current-buffer)))) + (test-kill-all-other-buffers-and-windows-teardown))) + +(ert-deftest test-kill-all-other-buffers-and-windows-should-delete-all-other-windows () + "Should delete all windows except current." + (test-kill-all-other-buffers-and-windows-setup) + (unwind-protect + (progn + (split-window) + (split-window) + (should (> (length (window-list)) 1)) + (cj/kill-all-other-buffers-and-windows) + (should (one-window-p))) + (test-kill-all-other-buffers-and-windows-teardown))) + +;;; Boundary Cases + +(ert-deftest test-kill-all-other-buffers-and-windows-mixed-undead-and-regular-buffers () + "With mix of undead and regular buffers, should handle both correctly." + (test-kill-all-other-buffers-and-windows-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list)) + (main (current-buffer)) + (regular (generate-new-buffer "*test-regular*")) + (undead (generate-new-buffer "*test-undead*"))) + (unwind-protect + (progn + (add-to-list 'cj/undead-buffer-list "*test-undead*") + (cj/kill-all-other-buffers-and-windows) + (should (buffer-live-p main)) + (should-not (buffer-live-p regular)) + (should (buffer-live-p undead))) + (setq cj/undead-buffer-list orig) + (when (buffer-live-p regular) (kill-buffer regular)) + (when (buffer-live-p undead) (kill-buffer undead)))) + (test-kill-all-other-buffers-and-windows-teardown))) + +(ert-deftest test-kill-all-other-buffers-and-windows-all-undead-buffers-should-bury-all () + "When all other buffers are undead, should bury all of them." + (test-kill-all-other-buffers-and-windows-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list)) + (main (current-buffer)) + (undead1 (generate-new-buffer "*test-all-undead-1*")) + (undead2 (generate-new-buffer "*test-all-undead-2*")) + (undead3 (generate-new-buffer "*test-all-undead-3*"))) + (unwind-protect + (progn + (add-to-list 'cj/undead-buffer-list "*test-all-undead-1*") + (add-to-list 'cj/undead-buffer-list "*test-all-undead-2*") + (add-to-list 'cj/undead-buffer-list "*test-all-undead-3*") + (cj/kill-all-other-buffers-and-windows) + (should (buffer-live-p main)) + (should (buffer-live-p undead1)) + (should (buffer-live-p undead2)) + (should (buffer-live-p undead3))) + (setq cj/undead-buffer-list orig) + (when (buffer-live-p undead1) (kill-buffer undead1)) + (when (buffer-live-p undead2) (kill-buffer undead2)) + (when (buffer-live-p undead3) (kill-buffer undead3)))) + (test-kill-all-other-buffers-and-windows-teardown))) + +(ert-deftest test-kill-all-other-buffers-and-windows-should-prompt-for-modified-buffers () + "Should call cj/save-some-buffers to handle modified buffers." + (test-kill-all-other-buffers-and-windows-setup) + (unwind-protect + (let ((main (current-buffer)) + (file (cj/create-temp-test-file-with-content "original")) + save-called) + ;; Mock cj/save-some-buffers to track if it's called + (cl-letf (((symbol-function 'cj/save-some-buffers) + (lambda (&optional arg) + (setq save-called t)))) + (let ((buf (find-file-noselect file))) + (unwind-protect + (progn + (with-current-buffer buf + (insert "modified")) + (cj/kill-all-other-buffers-and-windows) + (should save-called)) + (when (buffer-live-p buf) + (set-buffer-modified-p nil) + (kill-buffer buf)))))) + (test-kill-all-other-buffers-and-windows-teardown))) + +(provide 'test-undead-buffers-kill-all-other-buffers-and-windows) +;;; test-undead-buffers-kill-all-other-buffers-and-windows.el ends here diff --git a/tests/test-undead-buffers-kill-buffer-and-window.el b/tests/test-undead-buffers-kill-buffer-and-window.el new file mode 100644 index 00000000..b49969f6 --- /dev/null +++ b/tests/test-undead-buffers-kill-buffer-and-window.el @@ -0,0 +1,112 @@ +;;; test-undead-buffers-kill-buffer-and-window.el --- Tests for cj/kill-buffer-and-window -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/kill-buffer-and-window function from undead-buffers.el + +;;; Code: + +(require 'ert) +(require 'undead-buffers) +(require 'testutil-general) + +;;; Setup and Teardown + +(defun test-kill-buffer-and-window-setup () + "Setup for kill-buffer-and-window tests." + (cj/create-test-base-dir) + (delete-other-windows)) + +(defun test-kill-buffer-and-window-teardown () + "Teardown for kill-buffer-and-window tests." + (delete-other-windows) + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-kill-buffer-and-window-multiple-windows-should-delete-window-and-kill-buffer () + "With multiple windows, should delete window and kill buffer." + (test-kill-buffer-and-window-setup) + (unwind-protect + (let ((buf (generate-new-buffer "*test-multi*"))) + (unwind-protect + (progn + (split-window) + (switch-to-buffer buf) + (let ((win (selected-window))) + (cj/kill-buffer-and-window) + (should-not (window-live-p win)) + (should-not (buffer-live-p buf)))) + (when (buffer-live-p buf) (kill-buffer buf)))) + (test-kill-buffer-and-window-teardown))) + +(ert-deftest test-kill-buffer-and-window-multiple-windows-undead-buffer-should-delete-window-and-bury () + "With multiple windows, undead buffer should be buried and window deleted." + (test-kill-buffer-and-window-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list)) + (buf (generate-new-buffer "*test-undead-multi*"))) + (unwind-protect + (progn + (add-to-list 'cj/undead-buffer-list "*test-undead-multi*") + (split-window) + (switch-to-buffer buf) + (let ((win (selected-window))) + (cj/kill-buffer-and-window) + (should-not (window-live-p win)) + (should (buffer-live-p buf)))) + (setq cj/undead-buffer-list orig) + (when (buffer-live-p buf) (kill-buffer buf)))) + (test-kill-buffer-and-window-teardown))) + +;;; Boundary Cases + +(ert-deftest test-kill-buffer-and-window-single-window-should-only-kill-buffer () + "With single window, should only kill buffer, not delete window." + (test-kill-buffer-and-window-setup) + (unwind-protect + (let ((buf (generate-new-buffer "*test-single*"))) + (unwind-protect + (progn + (switch-to-buffer buf) + (should (one-window-p)) + (cj/kill-buffer-and-window) + (should (one-window-p)) + (should-not (buffer-live-p buf))) + (when (buffer-live-p buf) (kill-buffer buf)))) + (test-kill-buffer-and-window-teardown))) + +(ert-deftest test-kill-buffer-and-window-single-window-undead-buffer-should-only-bury () + "With single window, undead buffer should only be buried." + (test-kill-buffer-and-window-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list)) + (buf (generate-new-buffer "*test-undead-single*"))) + (unwind-protect + (progn + (add-to-list 'cj/undead-buffer-list "*test-undead-single*") + (switch-to-buffer buf) + (should (one-window-p)) + (cj/kill-buffer-and-window) + (should (one-window-p)) + (should (buffer-live-p buf))) + (setq cj/undead-buffer-list orig) + (when (buffer-live-p buf) (kill-buffer buf)))) + (test-kill-buffer-and-window-teardown))) + +(ert-deftest test-kill-buffer-and-window-two-windows-should-leave-one () + "With two windows, should leave one window after deletion." + (test-kill-buffer-and-window-setup) + (unwind-protect + (let ((buf (generate-new-buffer "*test-two*"))) + (unwind-protect + (progn + (split-window) + (set-window-buffer (selected-window) buf) + (should (= 2 (length (window-list)))) + (cj/kill-buffer-and-window) + (should (= 1 (length (window-list))))) + (when (buffer-live-p buf) (kill-buffer buf)))) + (test-kill-buffer-and-window-teardown))) + +(provide 'test-undead-buffers-kill-buffer-and-window) +;;; test-undead-buffers-kill-buffer-and-window.el ends here diff --git a/tests/test-undead-buffers-kill-buffer-or-bury-alive.el b/tests/test-undead-buffers-kill-buffer-or-bury-alive.el new file mode 100644 index 00000000..60b776e4 --- /dev/null +++ b/tests/test-undead-buffers-kill-buffer-or-bury-alive.el @@ -0,0 +1,138 @@ +;;; test-undead-buffers-kill-buffer-or-bury-alive.el --- Tests for cj/kill-buffer-or-bury-alive -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/kill-buffer-or-bury-alive function from undead-buffers.el + +;;; Code: + +(require 'ert) +(require 'undead-buffers) +(require 'testutil-general) + +;;; Setup and Teardown + +(defun test-kill-buffer-or-bury-alive-setup () + "Setup for kill-buffer-or-bury-alive tests." + (cj/create-test-base-dir)) + +(defun test-kill-buffer-or-bury-alive-teardown () + "Teardown for kill-buffer-or-bury-alive tests." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-kill-buffer-or-bury-alive-regular-buffer-should-kill () + "Killing a regular buffer not in undead list should kill it." + (test-kill-buffer-or-bury-alive-setup) + (unwind-protect + (let ((buf (generate-new-buffer "*test-regular*"))) + (should (buffer-live-p buf)) + (cj/kill-buffer-or-bury-alive buf) + (should-not (buffer-live-p buf))) + (test-kill-buffer-or-bury-alive-teardown))) + +(ert-deftest test-kill-buffer-or-bury-alive-undead-buffer-should-bury () + "Killing an undead buffer should bury it instead." + (test-kill-buffer-or-bury-alive-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list)) + (buf (generate-new-buffer "*test-undead*"))) + (unwind-protect + (progn + (add-to-list 'cj/undead-buffer-list "*test-undead*") + (should (buffer-live-p buf)) + (cj/kill-buffer-or-bury-alive buf) + (should (buffer-live-p buf))) + (setq cj/undead-buffer-list orig) + (when (buffer-live-p buf) (kill-buffer buf)))) + (test-kill-buffer-or-bury-alive-teardown))) + +(ert-deftest test-kill-buffer-or-bury-alive-with-prefix-arg-should-add-to-undead-list () + "Calling with prefix arg should add buffer to undead list." + (test-kill-buffer-or-bury-alive-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list)) + (buf (generate-new-buffer "*test-prefix*"))) + (unwind-protect + (progn + (with-current-buffer buf + (let ((current-prefix-arg '(4))) + (cj/kill-buffer-or-bury-alive buf))) + (should (member "*test-prefix*" cj/undead-buffer-list)) + (should (buffer-live-p buf))) + (setq cj/undead-buffer-list orig) + (when (buffer-live-p buf) (kill-buffer buf)))) + (test-kill-buffer-or-bury-alive-teardown))) + +(ert-deftest test-kill-buffer-or-bury-alive-scratch-buffer-should-bury () + "The *scratch* buffer (in default list) should be buried." + (test-kill-buffer-or-bury-alive-setup) + (unwind-protect + (let ((scratch (get-buffer-create "*scratch*"))) + (should (buffer-live-p scratch)) + (cj/kill-buffer-or-bury-alive scratch) + (should (buffer-live-p scratch))) + (test-kill-buffer-or-bury-alive-teardown))) + +;;; Boundary Cases + +(ert-deftest test-kill-buffer-or-bury-alive-buffer-by-name-string-should-work () + "Passing buffer name as string should work." + (test-kill-buffer-or-bury-alive-setup) + (unwind-protect + (let ((buf (generate-new-buffer "*test-string*"))) + (should (buffer-live-p buf)) + (cj/kill-buffer-or-bury-alive "*test-string*") + (should-not (buffer-live-p buf))) + (test-kill-buffer-or-bury-alive-teardown))) + +(ert-deftest test-kill-buffer-or-bury-alive-buffer-by-buffer-object-should-work () + "Passing buffer object should work." + (test-kill-buffer-or-bury-alive-setup) + (unwind-protect + (let ((buf (generate-new-buffer "*test-object*"))) + (should (buffer-live-p buf)) + (cj/kill-buffer-or-bury-alive buf) + (should-not (buffer-live-p buf))) + (test-kill-buffer-or-bury-alive-teardown))) + +(ert-deftest test-kill-buffer-or-bury-alive-modified-undead-buffer-should-bury-without-prompt () + "Modified undead buffer should be buried without save prompt." + (test-kill-buffer-or-bury-alive-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list)) + (buf (generate-new-buffer "*test-modified*"))) + (unwind-protect + (progn + (add-to-list 'cj/undead-buffer-list "*test-modified*") + (with-current-buffer buf + (insert "some text") + (set-buffer-modified-p t)) + (cj/kill-buffer-or-bury-alive buf) + (should (buffer-live-p buf))) + (setq cj/undead-buffer-list orig) + (when (buffer-live-p buf) + (set-buffer-modified-p nil) + (kill-buffer buf)))) + (test-kill-buffer-or-bury-alive-teardown))) + +;;; Error Cases + +(ert-deftest test-kill-buffer-or-bury-alive-nonexistent-buffer-should-error () + "Passing a non-existent buffer name should error." + (test-kill-buffer-or-bury-alive-setup) + (unwind-protect + (should-error (cj/kill-buffer-or-bury-alive "*nonexistent-buffer-xyz*")) + (test-kill-buffer-or-bury-alive-teardown))) + +(ert-deftest test-kill-buffer-or-bury-alive-killed-buffer-object-should-error () + "Passing a killed buffer object should error." + (test-kill-buffer-or-bury-alive-setup) + (unwind-protect + (let ((buf (generate-new-buffer "*test-killed*"))) + (kill-buffer buf) + (should-error (cj/kill-buffer-or-bury-alive buf))) + (test-kill-buffer-or-bury-alive-teardown))) + +(provide 'test-undead-buffers-kill-buffer-or-bury-alive) +;;; test-undead-buffers-kill-buffer-or-bury-alive.el ends here diff --git a/tests/test-undead-buffers-kill-other-window.el b/tests/test-undead-buffers-kill-other-window.el new file mode 100644 index 00000000..e9371a0f --- /dev/null +++ b/tests/test-undead-buffers-kill-other-window.el @@ -0,0 +1,123 @@ +;;; test-undead-buffers-kill-other-window.el --- Tests for cj/kill-other-window -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/kill-other-window function from undead-buffers.el + +;;; Code: + +(require 'ert) +(require 'undead-buffers) +(require 'testutil-general) + +;;; Setup and Teardown + +(defun test-kill-other-window-setup () + "Setup for kill-other-window tests." + (cj/create-test-base-dir) + (delete-other-windows)) + +(defun test-kill-other-window-teardown () + "Teardown for kill-other-window tests." + (delete-other-windows) + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-kill-other-window-two-windows-should-delete-other-and-kill-buffer () + "With two windows, should delete other window and kill its buffer." + (test-kill-other-window-setup) + (unwind-protect + (let ((buf1 (current-buffer)) + (buf2 (generate-new-buffer "*test-other*"))) + (unwind-protect + (progn + (split-window) + (let ((win1 (selected-window)) + (win2 (next-window))) + (set-window-buffer win2 buf2) + (select-window win1) + (cj/kill-other-window) + (should-not (window-live-p win2)) + (should-not (buffer-live-p buf2)))) + (when (buffer-live-p buf2) (kill-buffer buf2)))) + (test-kill-other-window-teardown))) + +(ert-deftest test-kill-other-window-two-windows-undead-buffer-should-delete-other-and-bury () + "With two windows, undead buffer in other window should be buried." + (test-kill-other-window-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list)) + (buf1 (current-buffer)) + (buf2 (generate-new-buffer "*test-undead-other*"))) + (unwind-protect + (progn + (add-to-list 'cj/undead-buffer-list "*test-undead-other*") + (split-window) + (let ((win1 (selected-window)) + (win2 (next-window))) + (set-window-buffer win2 buf2) + (select-window win1) + (cj/kill-other-window) + (should-not (window-live-p win2)) + (should (buffer-live-p buf2)))) + (setq cj/undead-buffer-list orig) + (when (buffer-live-p buf2) (kill-buffer buf2)))) + (test-kill-other-window-teardown))) + +;;; Boundary Cases + +(ert-deftest test-kill-other-window-single-window-should-only-kill-buffer () + "With single window, should only kill the current buffer." + (test-kill-other-window-setup) + (unwind-protect + (let ((buf (generate-new-buffer "*test-single-other*"))) + (unwind-protect + (progn + (switch-to-buffer buf) + (should (one-window-p)) + (cj/kill-other-window) + (should (one-window-p)) + (should-not (buffer-live-p buf))) + (when (buffer-live-p buf) (kill-buffer buf)))) + (test-kill-other-window-teardown))) + +(ert-deftest test-kill-other-window-three-windows-should-delete-one () + "With three windows, should delete one window." + (test-kill-other-window-setup) + (unwind-protect + (let ((buf1 (current-buffer)) + (buf2 (generate-new-buffer "*test-three-1*")) + (buf3 (generate-new-buffer "*test-three-2*"))) + (unwind-protect + (progn + (split-window) + (split-window) + (set-window-buffer (nth 1 (window-list)) buf2) + (set-window-buffer (nth 2 (window-list)) buf3) + (select-window (car (window-list))) + (should (= 3 (length (window-list)))) + (cj/kill-other-window) + (should (= 2 (length (window-list))))) + (when (buffer-live-p buf2) (kill-buffer buf2)) + (when (buffer-live-p buf3) (kill-buffer buf3)))) + (test-kill-other-window-teardown))) + +(ert-deftest test-kill-other-window-wraps-to-first-window-correctly () + "Should correctly cycle through windows with other-window." + (test-kill-other-window-setup) + (unwind-protect + (let ((buf1 (current-buffer)) + (buf2 (generate-new-buffer "*test-wrap*"))) + (unwind-protect + (progn + (split-window) + (let ((win2 (next-window))) + (set-window-buffer win2 buf2) + (select-window (car (window-list))) + (cj/kill-other-window) + (should-not (window-live-p win2)))) + (when (buffer-live-p buf2) (kill-buffer buf2)))) + (test-kill-other-window-teardown))) + +(provide 'test-undead-buffers-kill-other-window) +;;; test-undead-buffers-kill-other-window.el ends here diff --git a/tests/test-undead-buffers-make-buffer-undead.el b/tests/test-undead-buffers-make-buffer-undead.el new file mode 100644 index 00000000..823bb56e --- /dev/null +++ b/tests/test-undead-buffers-make-buffer-undead.el @@ -0,0 +1,134 @@ +;;; test-undead-buffers-make-buffer-undead.el --- Tests for cj/make-buffer-undead -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/make-buffer-undead function from undead-buffers.el + +;;; Code: + +(require 'ert) +(require 'undead-buffers) +(require 'testutil-general) + +;;; Setup and Teardown + +(defun test-make-buffer-undead-setup () + "Setup for make-buffer-undead tests." + (cj/create-test-base-dir)) + +(defun test-make-buffer-undead-teardown () + "Teardown for make-buffer-undead tests." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-make-buffer-undead-valid-name-should-add-to-list () + "Adding a valid buffer name should add it to the undead buffer list." + (test-make-buffer-undead-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list))) + (unwind-protect + (progn + (cj/make-buffer-undead "*test-buffer*") + (should (member "*test-buffer*" cj/undead-buffer-list))) + (setq cj/undead-buffer-list orig))) + (test-make-buffer-undead-teardown))) + +(ert-deftest test-make-buffer-undead-existing-name-should-not-duplicate () + "Adding an existing buffer name should not create duplicates." + (test-make-buffer-undead-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list))) + (unwind-protect + (progn + (cj/make-buffer-undead "*test-dup*") + (cj/make-buffer-undead "*test-dup*") + (should (= 1 (cl-count "*test-dup*" cj/undead-buffer-list :test #'string=)))) + (setq cj/undead-buffer-list orig))) + (test-make-buffer-undead-teardown))) + +(ert-deftest test-make-buffer-undead-multiple-additions-should-preserve-order () + "Adding multiple buffer names should preserve order." + (test-make-buffer-undead-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list))) + (unwind-protect + (progn + (cj/make-buffer-undead "*first*") + (cj/make-buffer-undead "*second*") + (cj/make-buffer-undead "*third*") + (let ((added-items (seq-drop cj/undead-buffer-list (length orig)))) + (should (equal added-items '("*first*" "*second*" "*third*"))))) + (setq cj/undead-buffer-list orig))) + (test-make-buffer-undead-teardown))) + +;;; Boundary Cases + +(ert-deftest test-make-buffer-undead-whitespace-only-name-should-add () + "Adding a whitespace-only name should succeed." + (test-make-buffer-undead-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list))) + (unwind-protect + (progn + (cj/make-buffer-undead " ") + (should (member " " cj/undead-buffer-list))) + (setq cj/undead-buffer-list orig))) + (test-make-buffer-undead-teardown))) + +(ert-deftest test-make-buffer-undead-very-long-name-should-add () + "Adding a very long buffer name should succeed." + (test-make-buffer-undead-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list)) + (long-name (make-string 1000 ?x))) + (unwind-protect + (progn + (cj/make-buffer-undead long-name) + (should (member long-name cj/undead-buffer-list))) + (setq cj/undead-buffer-list orig))) + (test-make-buffer-undead-teardown))) + +(ert-deftest test-make-buffer-undead-unicode-name-should-add () + "Adding a buffer name with Unicode characters should succeed." + (test-make-buffer-undead-setup) + (unwind-protect + (let ((orig (copy-sequence cj/undead-buffer-list))) + (unwind-protect + (progn + (cj/make-buffer-undead "*test-🚀-buffer*") + (should (member "*test-🚀-buffer*" cj/undead-buffer-list))) + (setq cj/undead-buffer-list orig))) + (test-make-buffer-undead-teardown))) + +;;; Error Cases + +(ert-deftest test-make-buffer-undead-empty-string-should-error () + "Passing an empty string should signal an error." + (test-make-buffer-undead-setup) + (unwind-protect + (should-error (cj/make-buffer-undead "")) + (test-make-buffer-undead-teardown))) + +(ert-deftest test-make-buffer-undead-nil-should-error () + "Passing nil should signal an error." + (test-make-buffer-undead-setup) + (unwind-protect + (should-error (cj/make-buffer-undead nil)) + (test-make-buffer-undead-teardown))) + +(ert-deftest test-make-buffer-undead-number-should-error () + "Passing a number should signal an error." + (test-make-buffer-undead-setup) + (unwind-protect + (should-error (cj/make-buffer-undead 42)) + (test-make-buffer-undead-teardown))) + +(ert-deftest test-make-buffer-undead-symbol-should-error () + "Passing a symbol should signal an error." + (test-make-buffer-undead-setup) + (unwind-protect + (should-error (cj/make-buffer-undead 'some-symbol)) + (test-make-buffer-undead-teardown))) + +(provide 'test-undead-buffers-make-buffer-undead) +;;; test-undead-buffers-make-buffer-undead.el ends here diff --git a/tests/test-undead-buffers-undead-buffer-p.el b/tests/test-undead-buffers-undead-buffer-p.el new file mode 100644 index 00000000..107256c9 --- /dev/null +++ b/tests/test-undead-buffers-undead-buffer-p.el @@ -0,0 +1,106 @@ +;;; test-undead-buffers-undead-buffer-p.el --- Tests for cj/undead-buffer-p -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/undead-buffer-p function from undead-buffers.el + +;;; Code: + +(require 'ert) +(require 'undead-buffers) +(require 'testutil-general) + +;;; Setup and Teardown + +(defun test-undead-buffer-p-setup () + "Setup for undead-buffer-p tests." + (cj/create-test-base-dir)) + +(defun test-undead-buffer-p-teardown () + "Teardown for undead-buffer-p tests." + (cj/delete-test-base-dir)) + +;;; Normal Cases + +(ert-deftest test-undead-buffer-p-modified-file-buffer-should-return-true () + "A modified file-backed buffer not in undead list should return t." + (test-undead-buffer-p-setup) + (unwind-protect + (let* ((file (cj/create-temp-test-file-with-content "test content")) + (buf (find-file-noselect file))) + (unwind-protect + (progn + (with-current-buffer buf + (insert "more content") + (should (cj/undead-buffer-p)))) + (when (buffer-live-p buf) + (set-buffer-modified-p nil) + (kill-buffer buf)))) + (test-undead-buffer-p-teardown))) + +(ert-deftest test-undead-buffer-p-undead-modified-file-buffer-should-return-nil () + "A modified file-backed undead buffer should return nil." + (test-undead-buffer-p-setup) + (unwind-protect + (let* ((orig (copy-sequence cj/undead-buffer-list)) + (file (cj/create-temp-test-file-with-content "test content")) + (buf (find-file-noselect file))) + (unwind-protect + (progn + (add-to-list 'cj/undead-buffer-list (buffer-name buf)) + (with-current-buffer buf + (insert "more content") + (should-not (cj/undead-buffer-p)))) + (setq cj/undead-buffer-list orig) + (when (buffer-live-p buf) + (set-buffer-modified-p nil) + (kill-buffer buf)))) + (test-undead-buffer-p-teardown))) + +(ert-deftest test-undead-buffer-p-scratch-buffer-should-return-nil () + "The *scratch* buffer should return nil (it's undead)." + (test-undead-buffer-p-setup) + (unwind-protect + (with-current-buffer "*scratch*" + (should-not (cj/undead-buffer-p))) + (test-undead-buffer-p-teardown))) + +;;; Boundary Cases + +(ert-deftest test-undead-buffer-p-unmodified-file-buffer-should-return-nil () + "An unmodified file buffer should return nil." + (test-undead-buffer-p-setup) + (unwind-protect + (let* ((file (cj/create-temp-test-file-with-content "test content")) + (buf (find-file-noselect file))) + (unwind-protect + (with-current-buffer buf + (should-not (cj/undead-buffer-p))) + (when (buffer-live-p buf) + (kill-buffer buf)))) + (test-undead-buffer-p-teardown))) + +(ert-deftest test-undead-buffer-p-modified-buffer-without-file-should-return-nil () + "A modified buffer without a backing file should return nil." + (test-undead-buffer-p-setup) + (unwind-protect + (let ((buf (generate-new-buffer "*test-no-file*"))) + (unwind-protect + (with-current-buffer buf + (insert "content") + (set-buffer-modified-p t) + (should-not (cj/undead-buffer-p))) + (when (buffer-live-p buf) + (set-buffer-modified-p nil) + (kill-buffer buf)))) + (test-undead-buffer-p-teardown))) + +(ert-deftest test-undead-buffer-p-temporary-buffer-should-return-nil () + "A temporary buffer should return nil." + (test-undead-buffer-p-setup) + (unwind-protect + (with-temp-buffer + (should-not (cj/undead-buffer-p))) + (test-undead-buffer-p-teardown))) + +(provide 'test-undead-buffers-undead-buffer-p) +;;; test-undead-buffers-undead-buffer-p.el ends here diff --git a/tests/test-undead-buffers.el b/tests/test-undead-buffers.el new file mode 100644 index 00000000..d08649b7 --- /dev/null +++ b/tests/test-undead-buffers.el @@ -0,0 +1,117 @@ +;;; test-undead-buffers.el --- -*- coding: utf-8; lexical-binding: t; -*- + +;;; Commentary: +;; ERT tests for undead-buffers.el. +;; Exercises kill vs bury decisions driven by cj/undead-buffer-list +;; and window-management helpers. +;; Coverage: +;; - cj/kill-buffer-or-bury-alive: kills non-listed buffers; buries listed; C-u adds to list +;; - cj/kill-buffer-and-window: deletes selected window, then kill/bury buffer as appropriate +;; - cj/kill-other-window: deletes the other window, then kill/bury that buffer +;; - cj/kill-all-other-buffers-and-windows: keeps only current window/buffer +;; Tests isolate state with temporary buffers/windows and restore cj/undead-buffer-list. +;; Note: bury-buffer does not delete windows; tests assert buffer liveness, not window removal. + +;;; 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/undead-buffer-list'." + (let* ((buf (generate-new-buffer "test-not-in-list")) + (orig (copy-sequence cj/undead-buffer-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/undead-buffer-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/undead-buffer-list)) + win-was) + (unwind-protect + (progn + (add-to-list 'cj/undead-buffer-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/undead-buffer-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/undead-buffer-list))) + (unwind-protect + (progn + (let ((current-prefix-arg '(4))) + (cj/kill-buffer-or-bury-alive (buffer-name buf))) + (should (member (buffer-name buf) cj/undead-buffer-list))) + (setq cj/undead-buffer-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/undead-buffer-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/undead-buffer-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/undead-buffer-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/undead-buffer-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/undead-buffer-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/undead-buffer-list orig) + (when (buffer-live-p extra) (kill-buffer extra)))) + +(provide 'test-undead-buffers) +;;; test-undead-buffers.el ends here. diff --git a/tests/test-video-audio-recording-check-ffmpeg.el b/tests/test-video-audio-recording-check-ffmpeg.el new file mode 100644 index 00000000..5c264b64 --- /dev/null +++ b/tests/test-video-audio-recording-check-ffmpeg.el @@ -0,0 +1,46 @@ +;;; test-video-audio-recording-check-ffmpeg.el --- Tests for cj/recording-check-ffmpeg -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/recording-check-ffmpeg function. +;; Tests detection of ffmpeg availability. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Normal Cases + +(ert-deftest test-video-audio-recording-check-ffmpeg-normal-ffmpeg-found-returns-t () + "Test that function returns t when ffmpeg is found." + (cl-letf (((symbol-function 'executable-find) + (lambda (cmd) + (when (equal cmd "ffmpeg") "/usr/bin/ffmpeg")))) + (let ((result (cj/recording-check-ffmpeg))) + (should (eq t result))))) + +;;; Error Cases + +(ert-deftest test-video-audio-recording-check-ffmpeg-error-ffmpeg-not-found-signals-error () + "Test that function signals user-error when ffmpeg is not found." + (cl-letf (((symbol-function 'executable-find) + (lambda (_cmd) nil))) + (should-error (cj/recording-check-ffmpeg) :type 'user-error))) + +(ert-deftest test-video-audio-recording-check-ffmpeg-error-message-mentions-pacman () + "Test that error message includes installation command." + (cl-letf (((symbol-function 'executable-find) + (lambda (_cmd) nil))) + (condition-case err + (cj/recording-check-ffmpeg) + (user-error + (should (string-match-p "pacman -S ffmpeg" (error-message-string err))))))) + +(provide 'test-video-audio-recording-check-ffmpeg) +;;; test-video-audio-recording-check-ffmpeg.el ends here diff --git a/tests/test-video-audio-recording-ffmpeg-functions.el b/tests/test-video-audio-recording-ffmpeg-functions.el new file mode 100644 index 00000000..e82614e2 --- /dev/null +++ b/tests/test-video-audio-recording-ffmpeg-functions.el @@ -0,0 +1,361 @@ +;;; test-video-audio-recording-ffmpeg-functions.el --- Tests for ffmpeg recording functions -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/ffmpeg-record-video, cj/ffmpeg-record-audio, +;; cj/video-recording-stop, and cj/audio-recording-stop functions. +;; Tests process creation, sentinel attachment, and cleanup. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub directory variables +(defvar video-recordings-dir "/tmp/video-recordings/") +(defvar audio-recordings-dir "/tmp/audio-recordings/") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Setup and Teardown + +(defun test-ffmpeg-setup () + "Reset all variables before each test." + (setq cj/video-recording-ffmpeg-process nil) + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/recording-mic-device "test-mic-device") + (setq cj/recording-system-device "test-monitor-device") + (setq cj/recording-mic-boost 2.0) + (setq cj/recording-system-volume 0.5)) + +(defun test-ffmpeg-teardown () + "Clean up after each test." + (when cj/video-recording-ffmpeg-process + (ignore-errors (delete-process cj/video-recording-ffmpeg-process))) + (when cj/audio-recording-ffmpeg-process + (ignore-errors (delete-process cj/audio-recording-ffmpeg-process))) + (setq cj/video-recording-ffmpeg-process nil) + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/recording-mic-device nil) + (setq cj/recording-system-device nil)) + +;;; Video Recording - Normal Cases + +(ert-deftest test-video-audio-recording-ffmpeg-record-video-normal-creates-process () + "Test that video recording creates a process." + (test-ffmpeg-setup) + (unwind-protect + (let ((process-created nil)) + (cl-letf (((symbol-function 'start-process-shell-command) + (lambda (_name _buffer _command) + (setq process-created t) + (make-process :name "fake-video" :command '("sleep" "1000"))))) + (cj/ffmpeg-record-video video-recordings-dir) + (should process-created) + (should cj/video-recording-ffmpeg-process))) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-ffmpeg-record-video-normal-attaches-sentinel () + "Test that video recording attaches sentinel to process." + (test-ffmpeg-setup) + (unwind-protect + (let ((sentinel-attached nil)) + (cl-letf (((symbol-function 'start-process-shell-command) + (lambda (_name _buffer _command) + (make-process :name "fake-video" :command '("sleep" "1000")))) + ((symbol-function 'set-process-sentinel) + (lambda (_proc sentinel) + (should (eq sentinel #'cj/recording-process-sentinel)) + (setq sentinel-attached t)))) + (cj/ffmpeg-record-video video-recordings-dir) + (should sentinel-attached))) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-ffmpeg-record-video-normal-updates-modeline () + "Test that video recording triggers modeline update." + (test-ffmpeg-setup) + (unwind-protect + (let ((update-called nil)) + (cl-letf (((symbol-function 'start-process-shell-command) + (lambda (_name _buffer _command) + (make-process :name "fake-video" :command '("sleep" "1000")))) + ((symbol-function 'force-mode-line-update) + (lambda (&optional _all) (setq update-called t)))) + (cj/ffmpeg-record-video video-recordings-dir) + (should update-called))) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-ffmpeg-record-video-normal-uses-device-settings () + "Test that video recording uses configured devices and volume settings." + (test-ffmpeg-setup) + (unwind-protect + (let ((command nil)) + (cl-letf (((symbol-function 'start-process-shell-command) + (lambda (_name _buffer cmd) + (setq command cmd) + (make-process :name "fake-video" :command '("sleep" "1000"))))) + (cj/ffmpeg-record-video video-recordings-dir) + (should (string-match-p "test-mic-device" command)) + (should (string-match-p "test-monitor-device" command)) + (should (string-match-p "2\\.0" command)) ; mic boost + (should (string-match-p "0\\.5" command)))) ; system volume + (test-ffmpeg-teardown))) + +;;; Audio Recording - Normal Cases + +(ert-deftest test-video-audio-recording-ffmpeg-record-audio-normal-creates-process () + "Test that audio recording creates a process." + (test-ffmpeg-setup) + (unwind-protect + (let ((process-created nil)) + (cl-letf (((symbol-function 'start-process-shell-command) + (lambda (_name _buffer _command) + (setq process-created t) + (make-process :name "fake-audio" :command '("sleep" "1000"))))) + (cj/ffmpeg-record-audio audio-recordings-dir) + (should process-created) + (should cj/audio-recording-ffmpeg-process))) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-ffmpeg-record-audio-normal-attaches-sentinel () + "Test that audio recording attaches sentinel to process." + (test-ffmpeg-setup) + (unwind-protect + (let ((sentinel-attached nil)) + (cl-letf (((symbol-function 'start-process-shell-command) + (lambda (_name _buffer _command) + (make-process :name "fake-audio" :command '("sleep" "1000")))) + ((symbol-function 'set-process-sentinel) + (lambda (_proc sentinel) + (should (eq sentinel #'cj/recording-process-sentinel)) + (setq sentinel-attached t)))) + (cj/ffmpeg-record-audio audio-recordings-dir) + (should sentinel-attached))) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-ffmpeg-record-audio-normal-updates-modeline () + "Test that audio recording triggers modeline update." + (test-ffmpeg-setup) + (unwind-protect + (let ((update-called nil)) + (cl-letf (((symbol-function 'start-process-shell-command) + (lambda (_name _buffer _command) + (make-process :name "fake-audio" :command '("sleep" "1000")))) + ((symbol-function 'force-mode-line-update) + (lambda (&optional _all) (setq update-called t)))) + (cj/ffmpeg-record-audio audio-recordings-dir) + (should update-called))) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-ffmpeg-record-audio-normal-creates-m4a-file () + "Test that audio recording creates .m4a file." + (test-ffmpeg-setup) + (unwind-protect + (let ((command nil)) + (cl-letf (((symbol-function 'start-process-shell-command) + (lambda (_name _buffer cmd) + (setq command cmd) + (make-process :name "fake-audio" :command '("sleep" "1000"))))) + (cj/ffmpeg-record-audio audio-recordings-dir) + (should (string-match-p "\\.m4a" command)))) + (test-ffmpeg-teardown))) + +;;; Stop Functions - Normal Cases + +(ert-deftest test-video-audio-recording-video-stop-normal-interrupts-process () + "Test that stopping video recording interrupts the process." + (test-ffmpeg-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-video" :command '("sleep" "1000"))) + (interrupt-called nil)) + (setq cj/video-recording-ffmpeg-process fake-process) + (cl-letf (((symbol-function 'interrupt-process) + (lambda (_proc) (setq interrupt-called t)))) + (cj/video-recording-stop) + (should interrupt-called)) + (delete-process fake-process)) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-video-stop-normal-clears-variable () + "Test that stopping video recording clears the process variable." + (test-ffmpeg-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-video" :command '("sleep" "1000")))) + (setq cj/video-recording-ffmpeg-process fake-process) + (cj/video-recording-stop) + (should (null cj/video-recording-ffmpeg-process)) + (delete-process fake-process)) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-video-stop-normal-updates-modeline () + "Test that stopping video recording updates modeline." + (test-ffmpeg-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-video" :command '("sleep" "1000"))) + (update-called nil)) + (setq cj/video-recording-ffmpeg-process fake-process) + (cl-letf (((symbol-function 'force-mode-line-update) + (lambda (&optional _all) (setq update-called t)))) + (cj/video-recording-stop) + (should update-called)) + (delete-process fake-process)) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-audio-stop-normal-interrupts-process () + "Test that stopping audio recording interrupts the process." + (test-ffmpeg-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sleep" "1000"))) + (interrupt-called nil)) + (setq cj/audio-recording-ffmpeg-process fake-process) + (cl-letf (((symbol-function 'interrupt-process) + (lambda (_proc) (setq interrupt-called t)))) + (cj/audio-recording-stop) + (should interrupt-called)) + (delete-process fake-process)) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-audio-stop-normal-clears-variable () + "Test that stopping audio recording clears the process variable." + (test-ffmpeg-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sleep" "1000")))) + (setq cj/audio-recording-ffmpeg-process fake-process) + (cj/audio-recording-stop) + (should (null cj/audio-recording-ffmpeg-process)) + (delete-process fake-process)) + (test-ffmpeg-teardown))) + +;;; Boundary Cases + +(ert-deftest test-video-audio-recording-video-stop-boundary-no-process-displays-message () + "Test that stopping when no video recording shows message." + (test-ffmpeg-setup) + (unwind-protect + (let ((message-text nil)) + (setq cj/video-recording-ffmpeg-process nil) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq message-text (apply #'format fmt args))))) + (cj/video-recording-stop) + (should (string-match-p "No video recording" message-text)))) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-audio-stop-boundary-no-process-displays-message () + "Test that stopping when no audio recording shows message." + (test-ffmpeg-setup) + (unwind-protect + (let ((message-text nil)) + (setq cj/audio-recording-ffmpeg-process nil) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq message-text (apply #'format fmt args))))) + (cj/audio-recording-stop) + (should (string-match-p "No audio recording" message-text)))) + (test-ffmpeg-teardown))) + +;;; Error Cases + +(ert-deftest test-video-audio-recording-video-stop-error-interrupt-process-fails () + "Test that video stop handles interrupt-process failure gracefully." + (test-ffmpeg-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-video" :command '("sleep" "1000"))) + (error-raised nil)) + (setq cj/video-recording-ffmpeg-process fake-process) + (cl-letf (((symbol-function 'interrupt-process) + (lambda (_proc) (error "Interrupt failed")))) + ;; Should handle the error without crashing + (condition-case err + (cj/video-recording-stop) + (error (setq error-raised t))) + ;; Error should propagate (function doesn't catch it) + (should error-raised)) + (delete-process fake-process)) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-audio-stop-error-interrupt-process-fails () + "Test that audio stop handles interrupt-process failure gracefully." + (test-ffmpeg-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sleep" "1000"))) + (error-raised nil)) + (setq cj/audio-recording-ffmpeg-process fake-process) + (cl-letf (((symbol-function 'interrupt-process) + (lambda (_proc) (error "Interrupt failed")))) + ;; Should handle the error without crashing + (condition-case err + (cj/audio-recording-stop) + (error (setq error-raised t))) + ;; Error should propagate (function doesn't catch it) + (should error-raised)) + (delete-process fake-process)) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-video-stop-error-dead-process-raises-error () + "Test that video stop raises error if process is already dead. +This documents current behavior - interrupt-process on dead process errors. +The sentinel should clear the variable before this happens in practice." + (test-ffmpeg-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-video" :command '("sleep" "1000")))) + (setq cj/video-recording-ffmpeg-process fake-process) + ;; Kill process before calling stop + (delete-process fake-process) + (sit-for 0.1) + ;; Calling stop on dead process raises error + (should-error (cj/video-recording-stop))) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-audio-stop-error-dead-process-raises-error () + "Test that audio stop raises error if process is already dead. +This documents current behavior - interrupt-process on dead process errors. +The sentinel should clear the variable before this happens in practice." + (test-ffmpeg-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sleep" "1000")))) + (setq cj/audio-recording-ffmpeg-process fake-process) + ;; Kill process before calling stop + (delete-process fake-process) + (sit-for 0.1) + ;; Calling stop on dead process raises error + (should-error (cj/audio-recording-stop))) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-ffmpeg-record-video-boundary-skips-if-already-recording () + "Test that video recording skips if already in progress." + (test-ffmpeg-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-video" :command '("sleep" "1000"))) + (start-called nil)) + (setq cj/video-recording-ffmpeg-process fake-process) + (cl-letf (((symbol-function 'start-process-shell-command) + (lambda (_name _buffer _command) + (setq start-called t) + (make-process :name "fake-video2" :command '("sleep" "1000"))))) + (cj/ffmpeg-record-video video-recordings-dir) + ;; Should NOT start a new process + (should-not start-called)) + (delete-process fake-process)) + (test-ffmpeg-teardown))) + +(ert-deftest test-video-audio-recording-ffmpeg-record-audio-boundary-skips-if-already-recording () + "Test that audio recording skips if already in progress." + (test-ffmpeg-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sleep" "1000"))) + (start-called nil)) + (setq cj/audio-recording-ffmpeg-process fake-process) + (cl-letf (((symbol-function 'start-process-shell-command) + (lambda (_name _buffer _command) + (setq start-called t) + (make-process :name "fake-audio2" :command '("sleep" "1000"))))) + (cj/ffmpeg-record-audio audio-recordings-dir) + ;; Should NOT start a new process + (should-not start-called)) + (delete-process fake-process)) + (test-ffmpeg-teardown))) + +(provide 'test-video-audio-recording-ffmpeg-functions) +;;; test-video-audio-recording-ffmpeg-functions.el ends here diff --git a/tests/test-video-audio-recording-friendly-state.el b/tests/test-video-audio-recording-friendly-state.el new file mode 100644 index 00000000..91b47998 --- /dev/null +++ b/tests/test-video-audio-recording-friendly-state.el @@ -0,0 +1,65 @@ +;;; test-video-audio-recording-friendly-state.el --- Tests for cj/recording-friendly-state -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/recording-friendly-state function. +;; Tests conversion of technical pactl state names to user-friendly labels. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Normal Cases + +(ert-deftest test-video-audio-recording-friendly-state-normal-suspended-returns-ready () + "Test that SUSPENDED state converts to Ready." + (should (string= "Ready" (cj/recording-friendly-state "SUSPENDED")))) + +(ert-deftest test-video-audio-recording-friendly-state-normal-running-returns-active () + "Test that RUNNING state converts to Active." + (should (string= "Active" (cj/recording-friendly-state "RUNNING")))) + +(ert-deftest test-video-audio-recording-friendly-state-normal-idle-returns-ready () + "Test that IDLE state converts to Ready." + (should (string= "Ready" (cj/recording-friendly-state "IDLE")))) + +;;; Boundary Cases + +(ert-deftest test-video-audio-recording-friendly-state-boundary-empty-string-returns-empty () + "Test that empty string passes through unchanged." + (should (string= "" (cj/recording-friendly-state "")))) + +(ert-deftest test-video-audio-recording-friendly-state-boundary-lowercase-suspended-returns-unchanged () + "Test that lowercase 'suspended' is not converted (case-sensitive)." + (should (string= "suspended" (cj/recording-friendly-state "suspended")))) + +(ert-deftest test-video-audio-recording-friendly-state-boundary-mixed-case-returns-unchanged () + "Test that mixed case 'Running' passes through unchanged." + (should (string= "Running" (cj/recording-friendly-state "Running")))) + +;;; Error Cases + +(ert-deftest test-video-audio-recording-friendly-state-error-unknown-state-returns-unchanged () + "Test that unknown state passes through unchanged." + (should (string= "UNKNOWN" (cj/recording-friendly-state "UNKNOWN")))) + +(ert-deftest test-video-audio-recording-friendly-state-error-random-string-returns-unchanged () + "Test that random string passes through unchanged." + (should (string= "foobar" (cj/recording-friendly-state "foobar")))) + +(ert-deftest test-video-audio-recording-friendly-state-error-numeric-string-returns-unchanged () + "Test that numeric string passes through unchanged." + (should (string= "12345" (cj/recording-friendly-state "12345")))) + +(ert-deftest test-video-audio-recording-friendly-state-error-special-chars-returns-unchanged () + "Test that string with special characters passes through unchanged." + (should (string= "!@#$%" (cj/recording-friendly-state "!@#$%")))) + +(provide 'test-video-audio-recording-friendly-state) +;;; test-video-audio-recording-friendly-state.el ends here diff --git a/tests/test-video-audio-recording-get-devices.el b/tests/test-video-audio-recording-get-devices.el new file mode 100644 index 00000000..ba7d95b9 --- /dev/null +++ b/tests/test-video-audio-recording-get-devices.el @@ -0,0 +1,190 @@ +;;; test-video-audio-recording-get-devices.el --- Tests for cj/recording-get-devices -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/recording-get-devices function. +;; Tests device prompting and validation workflow. +;; +;; NOTE: This function was refactored to use interactive prompts instead of +;; auto-detection. It now prompts the user with y-or-n-p and calls either +;; cj/recording-quick-setup-for-calls or cj/recording-select-devices. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Setup and Teardown + +(defun test-get-devices-setup () + "Reset device variables before each test." + (setq cj/recording-mic-device nil) + (setq cj/recording-system-device nil)) + +(defun test-get-devices-teardown () + "Clean up device variables after each test." + (setq cj/recording-mic-device nil) + (setq cj/recording-system-device nil)) + +;;; Normal Cases + +(ert-deftest test-video-audio-recording-get-devices-normal-returns-preset-devices () + "Test that already-configured devices are returned without prompting." + (test-get-devices-setup) + (unwind-protect + (progn + (setq cj/recording-mic-device "preset-mic") + (setq cj/recording-system-device "preset-monitor") + (let ((result (cj/recording-get-devices))) + (should (consp result)) + (should (equal "preset-mic" (car result))) + (should (equal "preset-monitor" (cdr result))))) + (test-get-devices-teardown))) + +(ert-deftest test-video-audio-recording-get-devices-normal-prompts-when-not-configured () + "Test that function prompts user when devices not configured." + (test-get-devices-setup) + (unwind-protect + (let ((prompt-called nil)) + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (_prompt) (setq prompt-called t) t)) + ((symbol-function 'cj/recording-quick-setup-for-calls) + (lambda () + (setq cj/recording-mic-device "quick-mic") + (setq cj/recording-system-device "quick-monitor")))) + (cj/recording-get-devices) + (should prompt-called))) + (test-get-devices-teardown))) + +(ert-deftest test-video-audio-recording-get-devices-normal-calls-quick-setup-on-yes () + "Test that function calls quick setup when user answers yes." + (test-get-devices-setup) + (unwind-protect + (let ((quick-setup-called nil)) + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (_prompt) t)) + ((symbol-function 'cj/recording-quick-setup-for-calls) + (lambda () + (setq quick-setup-called t) + (setq cj/recording-mic-device "quick-mic") + (setq cj/recording-system-device "quick-monitor")))) + (cj/recording-get-devices) + (should quick-setup-called))) + (test-get-devices-teardown))) + +(ert-deftest test-video-audio-recording-get-devices-normal-calls-select-devices-on-no () + "Test that function calls manual selection when user answers no." + (test-get-devices-setup) + (unwind-protect + (let ((select-called nil)) + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (_prompt) nil)) + ((symbol-function 'cj/recording-select-devices) + (lambda () + (setq select-called t) + (setq cj/recording-mic-device "manual-mic") + (setq cj/recording-system-device "manual-monitor")))) + (cj/recording-get-devices) + (should select-called))) + (test-get-devices-teardown))) + +(ert-deftest test-video-audio-recording-get-devices-normal-returns-cons-cell () + "Test that function returns (mic . monitor) cons cell." + (test-get-devices-setup) + (unwind-protect + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (_prompt) t)) + ((symbol-function 'cj/recording-quick-setup-for-calls) + (lambda () + (setq cj/recording-mic-device "test-mic") + (setq cj/recording-system-device "test-monitor")))) + (let ((result (cj/recording-get-devices))) + (should (consp result)) + (should (equal "test-mic" (car result))) + (should (equal "test-monitor" (cdr result))))) + (test-get-devices-teardown))) + +;;; Boundary Cases + +(ert-deftest test-video-audio-recording-get-devices-boundary-only-mic-set-prompts () + "Test that function prompts even when only mic is set." + (test-get-devices-setup) + (unwind-protect + (progn + (setq cj/recording-mic-device "preset-mic") + (setq cj/recording-system-device nil) + (let ((prompt-called nil)) + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (_prompt) (setq prompt-called t) t)) + ((symbol-function 'cj/recording-quick-setup-for-calls) + (lambda () + (setq cj/recording-mic-device "new-mic") + (setq cj/recording-system-device "new-monitor")))) + (cj/recording-get-devices) + (should prompt-called)))) + (test-get-devices-teardown))) + +(ert-deftest test-video-audio-recording-get-devices-boundary-only-monitor-set-prompts () + "Test that function prompts even when only monitor is set." + (test-get-devices-setup) + (unwind-protect + (progn + (setq cj/recording-mic-device nil) + (setq cj/recording-system-device "preset-monitor") + (let ((prompt-called nil)) + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (_prompt) (setq prompt-called t) t)) + ((symbol-function 'cj/recording-quick-setup-for-calls) + (lambda () + (setq cj/recording-mic-device "new-mic") + (setq cj/recording-system-device "new-monitor")))) + (cj/recording-get-devices) + (should prompt-called)))) + (test-get-devices-teardown))) + +;;; Error Cases + +(ert-deftest test-video-audio-recording-get-devices-error-setup-fails-signals-error () + "Test that function signals error when setup fails to set devices." + (test-get-devices-setup) + (unwind-protect + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (_prompt) t)) + ((symbol-function 'cj/recording-quick-setup-for-calls) + (lambda () nil))) ;; Setup fails - doesn't set devices + (should-error (cj/recording-get-devices) :type 'user-error)) + (test-get-devices-teardown))) + +(ert-deftest test-video-audio-recording-get-devices-error-message-mentions-setup-commands () + "Test that error message guides user to setup commands." + (test-get-devices-setup) + (unwind-protect + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (_prompt) t)) + ((symbol-function 'cj/recording-quick-setup-for-calls) + (lambda () nil))) + (condition-case err + (cj/recording-get-devices) + (user-error + (should (string-match-p "C-; r c" (error-message-string err))) + (should (string-match-p "C-; r s" (error-message-string err)))))) + (test-get-devices-teardown))) + +(ert-deftest test-video-audio-recording-get-devices-error-select-devices-fails () + "Test that function signals error when manual selection fails." + (test-get-devices-setup) + (unwind-protect + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (_prompt) nil)) + ((symbol-function 'cj/recording-select-devices) + (lambda () nil))) ;; Manual selection fails + (should-error (cj/recording-get-devices) :type 'user-error)) + (test-get-devices-teardown))) + +(provide 'test-video-audio-recording-get-devices) +;;; test-video-audio-recording-get-devices.el ends here diff --git a/tests/test-video-audio-recording-group-devices-by-hardware.el b/tests/test-video-audio-recording-group-devices-by-hardware.el new file mode 100644 index 00000000..0abe5f6c --- /dev/null +++ b/tests/test-video-audio-recording-group-devices-by-hardware.el @@ -0,0 +1,194 @@ +;;; test-video-audio-recording-group-devices-by-hardware.el --- Tests for cj/recording-group-devices-by-hardware -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/recording-group-devices-by-hardware function. +;; Tests grouping of audio sources by physical hardware device. +;; Critical test: Bluetooth MAC address normalization (colons vs underscores). +;; +;; This function is used by the quick setup command to automatically pair +;; microphone and monitor devices from the same hardware. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Test Fixtures Helper + +(defun test-load-fixture (filename) + "Load fixture file FILENAME from tests/fixtures directory." + (let ((fixture-path (expand-file-name + (concat "tests/fixtures/" filename) + user-emacs-directory))) + (with-temp-buffer + (insert-file-contents fixture-path) + (buffer-string)))) + +;;; Normal Cases + +(ert-deftest test-video-audio-recording-group-devices-by-hardware-normal-all-types-grouped () + "Test grouping of all three device types (built-in, USB, Bluetooth). +This is the key test validating the complete grouping logic." + (let ((output (test-load-fixture "pactl-output-normal.txt"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let ((result (cj/recording-group-devices-by-hardware))) + (should (listp result)) + (should (= 3 (length result))) + ;; Check that we have all three device types + (let ((names (mapcar #'car result))) + (should (member "Built-in Laptop Audio" names)) + (should (member "Bluetooth Headset" names)) + (should (member "Jabra SPEAK 510 USB" names))) + ;; Verify each device has both mic and monitor + (dolist (device result) + (should (stringp (car device))) ; friendly name + (should (stringp (cadr device))) ; mic device + (should (stringp (cddr device))) ; monitor device + (should-not (string-suffix-p ".monitor" (cadr device))) ; mic not monitor + (should (string-suffix-p ".monitor" (cddr device)))))))) ; monitor has suffix + +(ert-deftest test-video-audio-recording-group-devices-by-hardware-normal-built-in-paired () + "Test that built-in laptop audio devices are correctly paired." + (let ((output (test-load-fixture "pactl-output-normal.txt"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let* ((result (cj/recording-group-devices-by-hardware)) + (built-in (assoc "Built-in Laptop Audio" result))) + (should built-in) + (should (string-match-p "pci-0000_00_1f" (cadr built-in))) + (should (string-match-p "pci-0000_00_1f" (cddr built-in))) + (should (equal "alsa_input.pci-0000_00_1f.3.analog-stereo" (cadr built-in))) + (should (equal "alsa_output.pci-0000_00_1f.3.analog-stereo.monitor" (cddr built-in))))))) + +(ert-deftest test-video-audio-recording-group-devices-by-hardware-normal-usb-paired () + "Test that USB devices (Jabra) are correctly paired." + (let ((output (test-load-fixture "pactl-output-normal.txt"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let* ((result (cj/recording-group-devices-by-hardware)) + (jabra (assoc "Jabra SPEAK 510 USB" result))) + (should jabra) + (should (string-match-p "Jabra" (cadr jabra))) + (should (string-match-p "Jabra" (cddr jabra))))))) + +(ert-deftest test-video-audio-recording-group-devices-by-hardware-normal-bluetooth-paired () + "Test that Bluetooth devices are correctly paired. +CRITICAL: Tests MAC address normalization (colons in input, underscores in output)." + (let ((output (test-load-fixture "pactl-output-normal.txt"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let* ((result (cj/recording-group-devices-by-hardware)) + (bluetooth (assoc "Bluetooth Headset" result))) + (should bluetooth) + ;; Input has colons: bluez_input.00:1B:66:C0:91:6D + (should (equal "bluez_input.00:1B:66:C0:91:6D" (cadr bluetooth))) + ;; Output has underscores: bluez_output.00_1B_66_C0_91_6D.1.monitor + ;; But they should still be grouped together (MAC address normalized) + (should (equal "bluez_output.00_1B_66_C0_91_6D.1.monitor" (cddr bluetooth))))))) + +;;; Boundary Cases + +(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-empty-returns-empty () + "Test that empty pactl output returns empty list." + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) ""))) + (let ((result (cj/recording-group-devices-by-hardware))) + (should (listp result)) + (should (null result))))) + +(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-only-inputs-returns-empty () + "Test that only input devices (no monitors) returns empty list. +Devices must have BOTH mic and monitor to be included." + (let ((output (test-load-fixture "pactl-output-inputs-only.txt"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let ((result (cj/recording-group-devices-by-hardware))) + (should (listp result)) + (should (null result)))))) + +(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-only-monitors-returns-empty () + "Test that only monitor devices (no inputs) returns empty list." + (let ((output (test-load-fixture "pactl-output-monitors-only.txt"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let ((result (cj/recording-group-devices-by-hardware))) + (should (listp result)) + (should (null result)))))) + +(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-single-complete-device () + "Test that single device with both mic and monitor is returned." + (let ((output "50\talsa_input.pci-0000_00_1f.3.analog-stereo\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n49\talsa_output.pci-0000_00_1f.3.analog-stereo.monitor\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n")) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let ((result (cj/recording-group-devices-by-hardware))) + (should (= 1 (length result))) + (should (equal "Built-in Laptop Audio" (caar result))))))) + +(ert-deftest test-video-audio-recording-group-devices-by-hardware-boundary-mixed-complete-incomplete () + "Test that only devices with BOTH mic and monitor are included. +Incomplete devices (only mic or only monitor) are filtered out." + (let ((output (concat + ;; Complete device (built-in) + "50\talsa_input.pci-0000_00_1f.3.analog-stereo\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" + "49\talsa_output.pci-0000_00_1f.3.analog-stereo.monitor\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" + ;; Incomplete: USB mic with no monitor + "100\talsa_input.usb-device.mono-fallback\tPipeWire\ts16le 1ch 16000Hz\tSUSPENDED\n" + ;; Incomplete: Bluetooth monitor with no mic + "81\tbluez_output.AA_BB_CC_DD_EE_FF.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let ((result (cj/recording-group-devices-by-hardware))) + ;; Only the complete built-in device should be returned + (should (= 1 (length result))) + (should (equal "Built-in Laptop Audio" (caar result))))))) + +;;; Error Cases + +(ert-deftest test-video-audio-recording-group-devices-by-hardware-error-malformed-output-returns-empty () + "Test that malformed pactl output returns empty list." + (let ((output (test-load-fixture "pactl-output-malformed.txt"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let ((result (cj/recording-group-devices-by-hardware))) + (should (listp result)) + (should (null result)))))) + +(ert-deftest test-video-audio-recording-group-devices-by-hardware-error-unknown-device-type () + "Test that unknown device types get generic 'USB Audio Device' name." + (let ((output (concat + "100\talsa_input.usb-unknown_device-00.analog-stereo\tPipeWire\ts16le 2ch 16000Hz\tSUSPENDED\n" + "99\talsa_output.usb-unknown_device-00.analog-stereo.monitor\tPipeWire\ts16le 2ch 48000Hz\tSUSPENDED\n"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let ((result (cj/recording-group-devices-by-hardware))) + (should (= 1 (length result))) + ;; Should get generic USB name (not matching Jabra pattern) + (should (equal "USB Audio Device" (caar result))))))) + +(ert-deftest test-video-audio-recording-group-devices-by-hardware-error-bluetooth-mac-case-variations () + "Test that Bluetooth MAC addresses work with different formatting. +Tests the normalization logic handles various MAC address formats." + (let ((output (concat + ;; Input with colons (typical) + "79\tbluez_input.AA:BB:CC:DD:EE:FF\tPipeWire\tfloat32le 1ch 48000Hz\tSUSPENDED\n" + ;; Output with underscores (typical) + "81\tbluez_output.AA_BB_CC_DD_EE_FF.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) output))) + (let ((result (cj/recording-group-devices-by-hardware))) + (should (= 1 (length result))) + (should (equal "Bluetooth Headset" (caar result))) + ;; Verify both devices paired despite different MAC formats + (let ((device (car result))) + (should (string-match-p "AA:BB:CC" (cadr device))) + (should (string-match-p "AA_BB_CC" (cddr device)))))))) + +(provide 'test-video-audio-recording-group-devices-by-hardware) +;;; test-video-audio-recording-group-devices-by-hardware.el ends here diff --git a/tests/test-video-audio-recording-modeline-indicator.el b/tests/test-video-audio-recording-modeline-indicator.el new file mode 100644 index 00000000..f7f3bbff --- /dev/null +++ b/tests/test-video-audio-recording-modeline-indicator.el @@ -0,0 +1,134 @@ +;;; test-video-audio-recording-modeline-indicator.el --- Tests for cj/recording-modeline-indicator -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/recording-modeline-indicator function. +;; Tests modeline indicator display based on active recording processes. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Setup and Teardown + +(defun test-modeline-indicator-setup () + "Reset process variables before each test." + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/video-recording-ffmpeg-process nil)) + +(defun test-modeline-indicator-teardown () + "Clean up process variables after each test." + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/video-recording-ffmpeg-process nil)) + +;;; Normal Cases + +(ert-deftest test-video-audio-recording-modeline-indicator-normal-no-processes-returns-empty () + "Test that indicator returns empty string when no processes are active." + (test-modeline-indicator-setup) + (unwind-protect + (let ((result (cj/recording-modeline-indicator))) + (should (stringp result)) + (should (equal "" result))) + (test-modeline-indicator-teardown))) + +(ert-deftest test-video-audio-recording-modeline-indicator-normal-audio-only-shows-audio () + "Test that indicator shows audio when only audio process is active." + (test-modeline-indicator-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sleep" "1000")))) + (setq cj/audio-recording-ffmpeg-process fake-process) + (let ((result (cj/recording-modeline-indicator))) + (should (equal " 🔴Audio " result))) + (delete-process fake-process)) + (test-modeline-indicator-teardown))) + +(ert-deftest test-video-audio-recording-modeline-indicator-normal-video-only-shows-video () + "Test that indicator shows video when only video process is active." + (test-modeline-indicator-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-video" :command '("sleep" "1000")))) + (setq cj/video-recording-ffmpeg-process fake-process) + (let ((result (cj/recording-modeline-indicator))) + (should (equal " 🔴Video " result))) + (delete-process fake-process)) + (test-modeline-indicator-teardown))) + +(ert-deftest test-video-audio-recording-modeline-indicator-normal-both-shows-combined () + "Test that indicator shows A+V when both processes are active." + (test-modeline-indicator-setup) + (unwind-protect + (let ((audio-proc (make-process :name "test-audio" :command '("sleep" "1000"))) + (video-proc (make-process :name "test-video" :command '("sleep" "1000")))) + (setq cj/audio-recording-ffmpeg-process audio-proc) + (setq cj/video-recording-ffmpeg-process video-proc) + (let ((result (cj/recording-modeline-indicator))) + (should (equal " 🔴A+V " result))) + (delete-process audio-proc) + (delete-process video-proc)) + (test-modeline-indicator-teardown))) + +;;; Boundary Cases + +(ert-deftest test-video-audio-recording-modeline-indicator-boundary-dead-audio-process-returns-empty () + "Test that indicator returns empty string when audio process variable is set but process is dead." + (test-modeline-indicator-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sleep" "1000")))) + (setq cj/audio-recording-ffmpeg-process fake-process) + ;; Kill the process + (delete-process fake-process) + ;; Wait for process to be fully dead + (sit-for 0.1) + (let ((result (cj/recording-modeline-indicator))) + (should (equal "" result)))) + (test-modeline-indicator-teardown))) + +(ert-deftest test-video-audio-recording-modeline-indicator-boundary-dead-video-process-returns-empty () + "Test that indicator returns empty string when video process variable is set but process is dead." + (test-modeline-indicator-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-video" :command '("sleep" "1000")))) + (setq cj/video-recording-ffmpeg-process fake-process) + ;; Kill the process + (delete-process fake-process) + ;; Wait for process to be fully dead + (sit-for 0.1) + (let ((result (cj/recording-modeline-indicator))) + (should (equal "" result)))) + (test-modeline-indicator-teardown))) + +(ert-deftest test-video-audio-recording-modeline-indicator-boundary-one-dead-one-alive-shows-alive () + "Test that only the alive process shows when one is dead and one is alive." + (test-modeline-indicator-setup) + (unwind-protect + (let ((dead-proc (make-process :name "test-dead" :command '("sleep" "1000"))) + (alive-proc (make-process :name "test-alive" :command '("sleep" "1000")))) + (setq cj/audio-recording-ffmpeg-process dead-proc) + (setq cj/video-recording-ffmpeg-process alive-proc) + (delete-process dead-proc) + (sit-for 0.1) + (let ((result (cj/recording-modeline-indicator))) + (should (equal " 🔴Video " result))) + (delete-process alive-proc)) + (test-modeline-indicator-teardown))) + +(ert-deftest test-video-audio-recording-modeline-indicator-boundary-nil-process-variables () + "Test that nil process variables are handled gracefully." + (test-modeline-indicator-setup) + (unwind-protect + (progn + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/video-recording-ffmpeg-process nil) + (let ((result (cj/recording-modeline-indicator))) + (should (equal "" result)))) + (test-modeline-indicator-teardown))) + +(provide 'test-video-audio-recording-modeline-indicator) +;;; test-video-audio-recording-modeline-indicator.el ends here diff --git a/tests/test-video-audio-recording-parse-pactl-output.el b/tests/test-video-audio-recording-parse-pactl-output.el new file mode 100644 index 00000000..db49a897 --- /dev/null +++ b/tests/test-video-audio-recording-parse-pactl-output.el @@ -0,0 +1,157 @@ +;;; test-video-audio-recording-parse-pactl-output.el --- Tests for cj/recording--parse-pactl-output -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/recording--parse-pactl-output function. +;; Tests parsing of pactl sources output into structured data. +;; Uses fixture files with sample pactl output for reproducible testing. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Test Fixtures Helper + +(defun test-load-fixture (filename) + "Load fixture file FILENAME from tests/fixtures directory." + (let ((fixture-path (expand-file-name + (concat "tests/fixtures/" filename) + user-emacs-directory))) + (with-temp-buffer + (insert-file-contents fixture-path) + (buffer-string)))) + +;;; Normal Cases + +(ert-deftest test-video-audio-recording-parse-pactl-output-normal-all-devices-returns-list () + "Test parsing normal pactl output with all device types." + (let* ((output (test-load-fixture "pactl-output-normal.txt")) + (result (cj/recording--parse-pactl-output output))) + (should (listp result)) + (should (= 6 (length result))) + ;; Check first device (built-in monitor) + (should (equal '("alsa_output.pci-0000_00_1f.3.analog-stereo.monitor" + "PipeWire" + "SUSPENDED") + (nth 0 result))) + ;; Check Bluetooth input + (should (equal '("bluez_input.00:1B:66:C0:91:6D" + "PipeWire" + "SUSPENDED") + (nth 2 result))) + ;; Check USB device + (should (equal '("alsa_input.usb-0b0e_Jabra_SPEAK_510_USB_1C48F9C067D5020A00-00.mono-fallback" + "PipeWire" + "SUSPENDED") + (nth 5 result))))) + +(ert-deftest test-video-audio-recording-parse-pactl-output-normal-single-device-returns-list () + "Test parsing output with single device." + (let* ((output (test-load-fixture "pactl-output-single.txt")) + (result (cj/recording--parse-pactl-output output))) + (should (listp result)) + (should (= 1 (length result))) + (should (equal '("alsa_input.pci-0000_00_1f.3.analog-stereo" + "PipeWire" + "SUSPENDED") + (car result))))) + +(ert-deftest test-video-audio-recording-parse-pactl-output-normal-monitors-only-returns-list () + "Test parsing output with only monitor devices." + (let* ((output (test-load-fixture "pactl-output-monitors-only.txt")) + (result (cj/recording--parse-pactl-output output))) + (should (listp result)) + (should (= 3 (length result))) + ;; All should end with .monitor + (dolist (device result) + (should (string-suffix-p ".monitor" (car device)))))) + +(ert-deftest test-video-audio-recording-parse-pactl-output-normal-inputs-only-returns-list () + "Test parsing output with only input devices." + (let* ((output (test-load-fixture "pactl-output-inputs-only.txt")) + (result (cj/recording--parse-pactl-output output))) + (should (listp result)) + (should (= 3 (length result))) + ;; None should end with .monitor + (dolist (device result) + (should-not (string-suffix-p ".monitor" (car device)))))) + +;;; Boundary Cases + +(ert-deftest test-video-audio-recording-parse-pactl-output-boundary-empty-string-returns-empty-list () + "Test parsing empty string returns empty list." + (let ((result (cj/recording--parse-pactl-output ""))) + (should (listp result)) + (should (null result)))) + +(ert-deftest test-video-audio-recording-parse-pactl-output-boundary-empty-file-returns-empty-list () + "Test parsing empty file returns empty list." + (let* ((output (test-load-fixture "pactl-output-empty.txt")) + (result (cj/recording--parse-pactl-output output))) + (should (listp result)) + (should (null result)))) + +(ert-deftest test-video-audio-recording-parse-pactl-output-boundary-whitespace-only-returns-empty-list () + "Test parsing whitespace-only string returns empty list." + (let ((result (cj/recording--parse-pactl-output " \n\t\n "))) + (should (listp result)) + (should (null result)))) + +(ert-deftest test-video-audio-recording-parse-pactl-output-boundary-single-newline-returns-empty-list () + "Test parsing single newline returns empty list." + (let ((result (cj/recording--parse-pactl-output "\n"))) + (should (listp result)) + (should (null result)))) + +(ert-deftest test-video-audio-recording-parse-pactl-output-boundary-device-with-running-state-parsed () + "Test that RUNNING state (not just SUSPENDED) is parsed correctly." + (let* ((output "81\tbluez_output.00_1B_66_C0_91_6D.1.monitor\tPipeWire\ts24le 2ch 48000Hz\tRUNNING\n") + (result (cj/recording--parse-pactl-output output))) + (should (= 1 (length result))) + (should (equal "RUNNING" (nth 2 (car result)))))) + +(ert-deftest test-video-audio-recording-parse-pactl-output-boundary-device-with-idle-state-parsed () + "Test that IDLE state is parsed correctly." + (let* ((output "50\talsa_input.pci-0000_00_1f.3.analog-stereo\tPipeWire\ts32le 2ch 48000Hz\tIDLE\n") + (result (cj/recording--parse-pactl-output output))) + (should (= 1 (length result))) + (should (equal "IDLE" (nth 2 (car result)))))) + +;;; Error Cases + +(ert-deftest test-video-audio-recording-parse-pactl-output-error-malformed-lines-ignored () + "Test that malformed lines are silently ignored." + (let* ((output (test-load-fixture "pactl-output-malformed.txt")) + (result (cj/recording--parse-pactl-output output))) + (should (listp result)) + (should (null result)))) ; All lines malformed, so empty list + +(ert-deftest test-video-audio-recording-parse-pactl-output-error-mixed-valid-invalid-returns-valid () + "Test that mix of valid and invalid lines returns only valid ones." + (let* ((output (concat "50\talsa_input.pci-0000_00_1f.3.analog-stereo\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" + "This is invalid\n" + "79\tbluez_input.00:1B:66:C0:91:6D\tPipeWire\tfloat32le 1ch 48000Hz\tSUSPENDED\n" + "Also invalid\n")) + (result (cj/recording--parse-pactl-output output))) + (should (= 2 (length result))) + (should (equal "alsa_input.pci-0000_00_1f.3.analog-stereo" (car (nth 0 result)))) + (should (equal "bluez_input.00:1B:66:C0:91:6D" (car (nth 1 result)))))) + +(ert-deftest test-video-audio-recording-parse-pactl-output-error-missing-fields-ignored () + "Test that lines with missing fields are ignored." + (let* ((output "50\tincomplete-line\tPipeWire\n") ; Missing state and format + (result (cj/recording--parse-pactl-output output))) + (should (null result)))) + +(ert-deftest test-video-audio-recording-parse-pactl-output-error-nil-input-returns-error () + "Test that nil input signals an error." + (should-error (cj/recording--parse-pactl-output nil))) + +(provide 'test-video-audio-recording-parse-pactl-output) +;;; test-video-audio-recording-parse-pactl-output.el ends here diff --git a/tests/test-video-audio-recording-parse-sources.el b/tests/test-video-audio-recording-parse-sources.el new file mode 100644 index 00000000..d6d445b5 --- /dev/null +++ b/tests/test-video-audio-recording-parse-sources.el @@ -0,0 +1,98 @@ +;;; test-video-audio-recording-parse-sources.el --- Tests for cj/recording-parse-sources -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/recording-parse-sources function. +;; Tests the wrapper that calls pactl and delegates to internal parser. +;; Mocks shell-command-to-string to avoid system dependencies. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Test Fixtures Helper + +(defun test-load-fixture (filename) + "Load fixture file FILENAME from tests/fixtures directory." + (let ((fixture-path (expand-file-name + (concat "tests/fixtures/" filename) + user-emacs-directory))) + (with-temp-buffer + (insert-file-contents fixture-path) + (buffer-string)))) + +;;; Normal Cases + +(ert-deftest test-video-audio-recording-parse-sources-normal-calls-pactl-and-parses () + "Test that parse-sources calls shell command and returns parsed list." + (let ((fixture-output (test-load-fixture "pactl-output-normal.txt"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) fixture-output))) + (let ((result (cj/recording-parse-sources))) + (should (listp result)) + (should (= 6 (length result))) + ;; Verify it returns structured data + (should (equal "alsa_output.pci-0000_00_1f.3.analog-stereo.monitor" + (car (nth 0 result)))) + (should (equal "PipeWire" (nth 1 (nth 0 result)))) + (should (equal "SUSPENDED" (nth 2 (nth 0 result)))))))) + +(ert-deftest test-video-audio-recording-parse-sources-normal-single-device-returns-list () + "Test parse-sources with single device." + (let ((fixture-output (test-load-fixture "pactl-output-single.txt"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) fixture-output))) + (let ((result (cj/recording-parse-sources))) + (should (listp result)) + (should (= 1 (length result))))))) + +;;; Boundary Cases + +(ert-deftest test-video-audio-recording-parse-sources-boundary-empty-output-returns-empty-list () + "Test that empty pactl output returns empty list." + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) ""))) + (let ((result (cj/recording-parse-sources))) + (should (listp result)) + (should (null result))))) + +(ert-deftest test-video-audio-recording-parse-sources-boundary-whitespace-output-returns-empty-list () + "Test that whitespace-only output returns empty list." + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) " \n\t\n "))) + (let ((result (cj/recording-parse-sources))) + (should (listp result)) + (should (null result))))) + +;;; Error Cases + +(ert-deftest test-video-audio-recording-parse-sources-error-malformed-output-returns-empty-list () + "Test that malformed output is handled gracefully." + (let ((fixture-output (test-load-fixture "pactl-output-malformed.txt"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) fixture-output))) + (let ((result (cj/recording-parse-sources))) + (should (listp result)) + (should (null result)))))) + +(ert-deftest test-video-audio-recording-parse-sources-error-mixed-valid-invalid-returns-valid-only () + "Test that mix of valid and invalid lines returns only valid entries." + (let ((mixed-output (concat + "50\talsa_input.pci-0000_00_1f.3.analog-stereo\tPipeWire\ts32le 2ch 48000Hz\tSUSPENDED\n" + "invalid line\n" + "79\tbluez_input.00:1B:66:C0:91:6D\tPipeWire\tfloat32le 1ch 48000Hz\tRUNNING\n"))) + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) mixed-output))) + (let ((result (cj/recording-parse-sources))) + (should (= 2 (length result))) + (should (equal "alsa_input.pci-0000_00_1f.3.analog-stereo" (car (nth 0 result)))) + (should (equal "bluez_input.00:1B:66:C0:91:6D" (car (nth 1 result)))))))) + +(provide 'test-video-audio-recording-parse-sources) +;;; test-video-audio-recording-parse-sources.el ends here diff --git a/tests/test-video-audio-recording-process-sentinel.el b/tests/test-video-audio-recording-process-sentinel.el new file mode 100644 index 00000000..37a7f94d --- /dev/null +++ b/tests/test-video-audio-recording-process-sentinel.el @@ -0,0 +1,190 @@ +;;; test-video-audio-recording-process-sentinel.el --- Tests for cj/recording-process-sentinel -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/recording-process-sentinel function. +;; Tests process cleanup and modeline update when recording processes exit. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Setup and Teardown + +(defun test-sentinel-setup () + "Reset process variables before each test." + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/video-recording-ffmpeg-process nil)) + +(defun test-sentinel-teardown () + "Clean up process variables after each test." + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/video-recording-ffmpeg-process nil)) + +;;; Normal Cases + +(ert-deftest test-video-audio-recording-process-sentinel-normal-audio-exit-clears-variable () + "Test that sentinel clears audio process variable when process exits." + (test-sentinel-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sh" "-c" "exit 0")))) + (setq cj/audio-recording-ffmpeg-process fake-process) + ;; Mock process-status to return 'exit + (cl-letf (((symbol-function 'process-status) + (lambda (_proc) 'exit))) + ;; Call sentinel with exit status + (cj/recording-process-sentinel fake-process "finished\n") + ;; Variable should be cleared + (should (null cj/audio-recording-ffmpeg-process)))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-normal-video-exit-clears-variable () + "Test that sentinel clears video process variable when process exits." + (test-sentinel-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-video" :command '("sh" "-c" "exit 0")))) + (setq cj/video-recording-ffmpeg-process fake-process) + ;; Mock process-status to return 'exit + (cl-letf (((symbol-function 'process-status) + (lambda (_proc) 'exit))) + ;; Call sentinel with exit status + (cj/recording-process-sentinel fake-process "finished\n") + ;; Variable should be cleared + (should (null cj/video-recording-ffmpeg-process)))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-normal-signal-status-clears-variable () + "Test that sentinel clears variable on signal status (killed)." + (test-sentinel-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sleep" "1000")))) + (setq cj/audio-recording-ffmpeg-process fake-process) + (delete-process fake-process) + ;; Call sentinel with signal status + (cj/recording-process-sentinel fake-process "killed\n") + ;; Variable should be cleared + (should (null cj/audio-recording-ffmpeg-process))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-normal-modeline-update-called () + "Test that sentinel triggers modeline update." + (test-sentinel-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sh" "-c" "exit 0"))) + (update-called nil)) + (setq cj/audio-recording-ffmpeg-process fake-process) + ;; Mock force-mode-line-update to track if it's called + (cl-letf (((symbol-function 'force-mode-line-update) + (lambda (&optional _all) (setq update-called t)))) + (cj/recording-process-sentinel fake-process "finished\n") + (should update-called))) + (test-sentinel-teardown))) + +;;; Boundary Cases + +(ert-deftest test-video-audio-recording-process-sentinel-boundary-run-status-ignored () + "Test that sentinel ignores processes in 'run status (still running)." + (test-sentinel-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sleep" "1000")))) + (setq cj/audio-recording-ffmpeg-process fake-process) + ;; Mock process-status to return 'run + (cl-letf (((symbol-function 'process-status) + (lambda (_proc) 'run))) + (cj/recording-process-sentinel fake-process "run") + ;; Variable should NOT be cleared + (should (eq fake-process cj/audio-recording-ffmpeg-process))) + (delete-process fake-process)) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-boundary-open-status-ignored () + "Test that sentinel ignores processes in 'open status." + (test-sentinel-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sleep" "1000")))) + (setq cj/audio-recording-ffmpeg-process fake-process) + (cl-letf (((symbol-function 'process-status) + (lambda (_proc) 'open))) + (cj/recording-process-sentinel fake-process "open") + ;; Variable should NOT be cleared + (should (eq fake-process cj/audio-recording-ffmpeg-process))) + (delete-process fake-process)) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-boundary-event-trimmed () + "Test that event string is trimmed in message." + (test-sentinel-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sh" "-c" "exit 0"))) + (message-text nil)) + (setq cj/audio-recording-ffmpeg-process fake-process) + ;; Mock message to capture output + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq message-text (apply #'format fmt args))))) + (cj/recording-process-sentinel fake-process " finished \n") + ;; Message should contain trimmed event + (should (string-match-p "finished" message-text)) + ;; Should not have extra whitespace + (should-not (string-match-p " finished " message-text)))) + (test-sentinel-teardown))) + +;;; Error Cases + +(ert-deftest test-video-audio-recording-process-sentinel-error-unknown-process-ignored () + "Test that sentinel handles unknown process (not audio or video) gracefully." + (test-sentinel-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-unknown" :command '("sh" "-c" "exit 0"))) + (audio-proc (make-process :name "test-audio" :command '("sleep" "1000"))) + (video-proc (make-process :name "test-video" :command '("sleep" "1000")))) + (setq cj/audio-recording-ffmpeg-process audio-proc) + (setq cj/video-recording-ffmpeg-process video-proc) + ;; Call sentinel with unknown process + (cj/recording-process-sentinel fake-process "finished\n") + ;; Audio and video variables should NOT be cleared + (should (eq audio-proc cj/audio-recording-ffmpeg-process)) + (should (eq video-proc cj/video-recording-ffmpeg-process)) + (delete-process audio-proc) + (delete-process video-proc)) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-error-nil-event-handled () + "Test that sentinel handles nil event string gracefully." + (test-sentinel-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sh" "-c" "exit 0")))) + (setq cj/audio-recording-ffmpeg-process fake-process) + ;; Mock process-status to return 'exit + (cl-letf (((symbol-function 'process-status) + (lambda (_proc) 'exit))) + ;; Should not crash with nil event (string-trim will error, but that's caught) + ;; The function uses string-trim without protection, so this will error + ;; Testing that it doesn't crash means we expect an error + (should-error + (cj/recording-process-sentinel fake-process nil)))) + (test-sentinel-teardown))) + +(ert-deftest test-video-audio-recording-process-sentinel-error-empty-event-handled () + "Test that sentinel handles empty event string gracefully." + (test-sentinel-setup) + (unwind-protect + (let ((fake-process (make-process :name "test-audio" :command '("sh" "-c" "exit 0")))) + (setq cj/audio-recording-ffmpeg-process fake-process) + ;; Mock process-status to return 'exit + (cl-letf (((symbol-function 'process-status) + (lambda (_proc) 'exit))) + ;; Empty string is fine - string-trim handles it + ;; No error should be raised + (cj/recording-process-sentinel fake-process "") + ;; Variable should be cleared + (should (null cj/audio-recording-ffmpeg-process)))) + (test-sentinel-teardown))) + +(provide 'test-video-audio-recording-process-sentinel) +;;; test-video-audio-recording-process-sentinel.el ends here diff --git a/tests/test-video-audio-recording-quick-setup-for-calls.el b/tests/test-video-audio-recording-quick-setup-for-calls.el new file mode 100644 index 00000000..0d3fe53a --- /dev/null +++ b/tests/test-video-audio-recording-quick-setup-for-calls.el @@ -0,0 +1,144 @@ +;;; test-video-audio-recording-quick-setup-for-calls.el --- Tests for cj/recording-quick-setup-for-calls -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/recording-quick-setup-for-calls function. +;; Tests quick device setup workflow for call recording. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Setup and Teardown + +(defun test-quick-setup-setup () + "Reset device variables before each test." + (setq cj/recording-mic-device nil) + (setq cj/recording-system-device nil)) + +(defun test-quick-setup-teardown () + "Clean up device variables after each test." + (setq cj/recording-mic-device nil) + (setq cj/recording-system-device nil)) + +;;; Normal Cases + +(ert-deftest test-video-audio-recording-quick-setup-for-calls-normal-sets-both-devices () + "Test that function sets both mic and system device variables." + (test-quick-setup-setup) + (unwind-protect + (let ((grouped-devices '(("Bluetooth Headset" . ("bluez_input.00:1B:66" . "bluez_output.00_1B_66.monitor"))))) + (cl-letf (((symbol-function 'cj/recording-group-devices-by-hardware) + (lambda () grouped-devices)) + ((symbol-function 'completing-read) + (lambda (_prompt _choices &rest _args) "Bluetooth Headset"))) + (cj/recording-quick-setup-for-calls) + (should (equal "bluez_input.00:1B:66" cj/recording-mic-device)) + (should (equal "bluez_output.00_1B_66.monitor" cj/recording-system-device)))) + (test-quick-setup-teardown))) + +(ert-deftest test-video-audio-recording-quick-setup-for-calls-normal-presents-friendly-names () + "Test that function presents friendly device names to user." + (test-quick-setup-setup) + (unwind-protect + (let ((grouped-devices '(("Jabra SPEAK 510 USB" . ("usb-input" . "usb-monitor")) + ("Built-in Laptop Audio" . ("pci-input" . "pci-monitor")))) + (presented-choices nil)) + (cl-letf (((symbol-function 'cj/recording-group-devices-by-hardware) + (lambda () grouped-devices)) + ((symbol-function 'completing-read) + (lambda (_prompt choices &rest _args) + (setq presented-choices choices) + (car choices)))) + (cj/recording-quick-setup-for-calls) + (should (member "Jabra SPEAK 510 USB" presented-choices)) + (should (member "Built-in Laptop Audio" presented-choices)))) + (test-quick-setup-teardown))) + +(ert-deftest test-video-audio-recording-quick-setup-for-calls-normal-displays-confirmation () + "Test that function displays confirmation message with device details." + (test-quick-setup-setup) + (unwind-protect + (let ((grouped-devices '(("Bluetooth Headset" . ("bluez_input.00:1B:66" . "bluez_output.00_1B_66.monitor")))) + (message-text nil)) + (cl-letf (((symbol-function 'cj/recording-group-devices-by-hardware) + (lambda () grouped-devices)) + ((symbol-function 'completing-read) + (lambda (_prompt _choices &rest _args) "Bluetooth Headset")) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq message-text (apply #'format fmt args))))) + (cj/recording-quick-setup-for-calls) + (should (string-match-p "Call recording ready" message-text)) + (should (string-match-p "Bluetooth Headset" message-text)))) + (test-quick-setup-teardown))) + +;;; Boundary Cases + +(ert-deftest test-video-audio-recording-quick-setup-for-calls-boundary-single-device-no-prompt () + "Test that with single device, selection still happens." + (test-quick-setup-setup) + (unwind-protect + (let ((grouped-devices '(("Built-in Laptop Audio" . ("pci-input" . "pci-monitor"))))) + (cl-letf (((symbol-function 'cj/recording-group-devices-by-hardware) + (lambda () grouped-devices)) + ((symbol-function 'completing-read) + (lambda (_prompt _choices &rest _args) "Built-in Laptop Audio"))) + (cj/recording-quick-setup-for-calls) + (should (equal "pci-input" cj/recording-mic-device)) + (should (equal "pci-monitor" cj/recording-system-device)))) + (test-quick-setup-teardown))) + +(ert-deftest test-video-audio-recording-quick-setup-for-calls-boundary-device-name-with-special-chars () + "Test that device names with special characters are handled correctly." + (test-quick-setup-setup) + (unwind-protect + (let ((grouped-devices '(("Device (USB-C)" . ("special-input" . "special-monitor"))))) + (cl-letf (((symbol-function 'cj/recording-group-devices-by-hardware) + (lambda () grouped-devices)) + ((symbol-function 'completing-read) + (lambda (_prompt _choices &rest _args) "Device (USB-C)"))) + (cj/recording-quick-setup-for-calls) + (should (equal "special-input" cj/recording-mic-device)) + (should (equal "special-monitor" cj/recording-system-device)))) + (test-quick-setup-teardown))) + +;;; Error Cases + +(ert-deftest test-video-audio-recording-quick-setup-for-calls-error-no-devices-signals-error () + "Test that function signals user-error when no complete devices are found." + (test-quick-setup-setup) + (unwind-protect + (cl-letf (((symbol-function 'cj/recording-group-devices-by-hardware) + (lambda () nil))) + (should-error (cj/recording-quick-setup-for-calls) :type 'user-error)) + (test-quick-setup-teardown))) + +(ert-deftest test-video-audio-recording-quick-setup-for-calls-error-message-mentions-both-devices () + "Test that error message mentions need for both mic and monitor." + (test-quick-setup-setup) + (unwind-protect + (cl-letf (((symbol-function 'cj/recording-group-devices-by-hardware) + (lambda () nil))) + (condition-case err + (cj/recording-quick-setup-for-calls) + (user-error + (should (string-match-p "both mic and monitor" (error-message-string err)))))) + (test-quick-setup-teardown))) + +(ert-deftest test-video-audio-recording-quick-setup-for-calls-error-empty-device-list () + "Test that empty device list from grouping is handled gracefully." + (test-quick-setup-setup) + (unwind-protect + (cl-letf (((symbol-function 'cj/recording-group-devices-by-hardware) + (lambda () '()))) + (should-error (cj/recording-quick-setup-for-calls) :type 'user-error)) + (test-quick-setup-teardown))) + +(provide 'test-video-audio-recording-quick-setup-for-calls) +;;; test-video-audio-recording-quick-setup-for-calls.el ends here diff --git a/tests/test-video-audio-recording-select-device.el b/tests/test-video-audio-recording-select-device.el new file mode 100644 index 00000000..53b1e665 --- /dev/null +++ b/tests/test-video-audio-recording-select-device.el @@ -0,0 +1,165 @@ +;;; test-video-audio-recording-select-device.el --- Tests for cj/recording-select-device -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/recording-select-device function. +;; Tests interactive device selection with filtering. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Normal Cases + +(ert-deftest test-video-audio-recording-select-device-normal-returns-selected-mic () + "Test that function returns selected microphone device." + (let ((sources '(("alsa_input.pci-device" "PipeWire" "SUSPENDED") + ("alsa_output.pci-device.monitor" "PipeWire" "SUSPENDED")))) + (cl-letf (((symbol-function 'cj/recording-parse-sources) + (lambda () sources)) + ((symbol-function 'completing-read) + (lambda (_prompt choices &rest _args) + ;; Select the first choice + (caar choices)))) + (let ((result (cj/recording-select-device "Select mic: " 'mic))) + (should (stringp result)) + (should (equal "alsa_input.pci-device" result)))))) + +(ert-deftest test-video-audio-recording-select-device-normal-returns-selected-monitor () + "Test that function returns selected monitor device." + (let ((sources '(("alsa_input.pci-device" "PipeWire" "SUSPENDED") + ("alsa_output.pci-device.monitor" "PipeWire" "SUSPENDED")))) + (cl-letf (((symbol-function 'cj/recording-parse-sources) + (lambda () sources)) + ((symbol-function 'completing-read) + (lambda (_prompt choices &rest _args) + (caar choices)))) + (let ((result (cj/recording-select-device "Select monitor: " 'monitor))) + (should (stringp result)) + (should (equal "alsa_output.pci-device.monitor" result)))))) + +(ert-deftest test-video-audio-recording-select-device-normal-filters-monitors-for-mic () + "Test that function filters out monitor devices when selecting mic." + (let ((sources '(("alsa_input.pci-device" "PipeWire" "SUSPENDED") + ("alsa_output.pci-device.monitor" "PipeWire" "SUSPENDED") + ("bluez_input.00:1B:66" "PipeWire" "RUNNING"))) + (presented-choices nil)) + (cl-letf (((symbol-function 'cj/recording-parse-sources) + (lambda () sources)) + ((symbol-function 'completing-read) + (lambda (_prompt choices &rest _args) + (setq presented-choices choices) + (caar choices)))) + (cj/recording-select-device "Select mic: " 'mic) + ;; Should have 2 mic devices (not the monitor) + (should (= 2 (length presented-choices))) + (should-not (cl-some (lambda (choice) (string-match-p "\\.monitor" (car choice))) + presented-choices))))) + +(ert-deftest test-video-audio-recording-select-device-normal-filters-non-monitors-for-monitor () + "Test that function filters out non-monitor devices when selecting monitor." + (let ((sources '(("alsa_input.pci-device" "PipeWire" "SUSPENDED") + ("alsa_output.pci-device.monitor" "PipeWire" "SUSPENDED") + ("bluez_output.00_1B_66.1.monitor" "PipeWire" "RUNNING"))) + (presented-choices nil)) + (cl-letf (((symbol-function 'cj/recording-parse-sources) + (lambda () sources)) + ((symbol-function 'completing-read) + (lambda (_prompt choices &rest _args) + (setq presented-choices choices) + (caar choices)))) + (cj/recording-select-device "Select monitor: " 'monitor) + ;; Should have 2 monitor devices (not the input) + (should (= 2 (length presented-choices))) + (should (cl-every (lambda (choice) (string-match-p "\\.monitor" (car choice))) + presented-choices))))) + +(ert-deftest test-video-audio-recording-select-device-normal-shows-friendly-state () + "Test that function shows friendly state in choices." + (let ((sources '(("alsa_input.pci-device" "PipeWire" "SUSPENDED"))) + (presented-choices nil)) + (cl-letf (((symbol-function 'cj/recording-parse-sources) + (lambda () sources)) + ((symbol-function 'completing-read) + (lambda (_prompt choices &rest _args) + (setq presented-choices choices) + (caar choices)))) + (cj/recording-select-device "Select mic: " 'mic) + ;; Choice should contain "Ready" (friendly for SUSPENDED) + (should (string-match-p "Ready" (caar presented-choices)))))) + +;;; Boundary Cases + +(ert-deftest test-video-audio-recording-select-device-boundary-single-device () + "Test that function works with single device." + (let ((sources '(("alsa_input.pci-device" "PipeWire" "SUSPENDED")))) + (cl-letf (((symbol-function 'cj/recording-parse-sources) + (lambda () sources)) + ((symbol-function 'completing-read) + (lambda (_prompt choices &rest _args) + (caar choices)))) + (let ((result (cj/recording-select-device "Select mic: " 'mic))) + (should (equal "alsa_input.pci-device" result)))))) + +(ert-deftest test-video-audio-recording-select-device-boundary-multiple-states () + "Test that function handles devices in different states." + (let ((sources '(("alsa_input.device1" "PipeWire" "SUSPENDED") + ("alsa_input.device2" "PipeWire" "RUNNING") + ("alsa_input.device3" "PipeWire" "IDLE"))) + (presented-choices nil)) + (cl-letf (((symbol-function 'cj/recording-parse-sources) + (lambda () sources)) + ((symbol-function 'completing-read) + (lambda (_prompt choices &rest _args) + (setq presented-choices choices) + (caar choices)))) + (cj/recording-select-device "Select mic: " 'mic) + ;; All three should be presented + (should (= 3 (length presented-choices))) + ;; Check that friendly states appear + (let ((choice-text (mapconcat #'car presented-choices " "))) + (should (string-match-p "Ready\\|Active" choice-text)))))) + +;;; Error Cases + +(ert-deftest test-video-audio-recording-select-device-error-no-mic-devices-signals-error () + "Test that function signals user-error when no mic devices found." + (let ((sources '(("alsa_output.pci-device.monitor" "PipeWire" "SUSPENDED")))) + (cl-letf (((symbol-function 'cj/recording-parse-sources) + (lambda () sources))) + (should-error (cj/recording-select-device "Select mic: " 'mic) :type 'user-error)))) + +(ert-deftest test-video-audio-recording-select-device-error-no-monitor-devices-signals-error () + "Test that function signals user-error when no monitor devices found." + (let ((sources '(("alsa_input.pci-device" "PipeWire" "SUSPENDED")))) + (cl-letf (((symbol-function 'cj/recording-parse-sources) + (lambda () sources))) + (should-error (cj/recording-select-device "Select monitor: " 'monitor) :type 'user-error)))) + +(ert-deftest test-video-audio-recording-select-device-error-empty-source-list () + "Test that function signals user-error when source list is empty." + (cl-letf (((symbol-function 'cj/recording-parse-sources) + (lambda () nil))) + (should-error (cj/recording-select-device "Select mic: " 'mic) :type 'user-error))) + +(ert-deftest test-video-audio-recording-select-device-error-message-mentions-device-type () + "Test that error message mentions the device type being searched for." + (cl-letf (((symbol-function 'cj/recording-parse-sources) + (lambda () nil))) + (condition-case err + (cj/recording-select-device "Select mic: " 'mic) + (user-error + (should (string-match-p "input" (error-message-string err))))) + (condition-case err + (cj/recording-select-device "Select monitor: " 'monitor) + (user-error + (should (string-match-p "monitor" (error-message-string err))))))) + +(provide 'test-video-audio-recording-select-device) +;;; test-video-audio-recording-select-device.el ends here diff --git a/tests/test-video-audio-recording-test-mic.el b/tests/test-video-audio-recording-test-mic.el new file mode 100644 index 00000000..5aa794bb --- /dev/null +++ b/tests/test-video-audio-recording-test-mic.el @@ -0,0 +1,147 @@ +;;; test-video-audio-recording-test-mic.el --- Tests for cj/recording-test-mic -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/recording-test-mic function. +;; Tests microphone testing functionality. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Setup and Teardown + +(defun test-mic-setup () + "Reset device variables before each test." + (setq cj/recording-mic-device nil)) + +(defun test-mic-teardown () + "Clean up device variables after each test." + (setq cj/recording-mic-device nil)) + +;;; Normal Cases + +(ert-deftest test-video-audio-recording-test-mic-normal-creates-temp-wav-file () + "Test that function creates temp file with .wav extension." + (test-mic-setup) + (unwind-protect + (progn + (setq cj/recording-mic-device "test-mic-device") + (let ((temp-file nil)) + ;; Mock make-temp-file to capture filename + (cl-letf (((symbol-function 'make-temp-file) + (lambda (prefix _dir-flag suffix) + (setq temp-file (concat prefix "12345" suffix)) + temp-file)) + ((symbol-function 'shell-command) + (lambda (_cmd) 0))) + (cj/recording-test-mic) + (should (string-match-p "\\.wav$" temp-file))))) + (test-mic-teardown))) + +(ert-deftest test-video-audio-recording-test-mic-normal-runs-ffmpeg-command () + "Test that function runs ffmpeg command with configured mic device." + (test-mic-setup) + (unwind-protect + (progn + (setq cj/recording-mic-device "test-mic-device") + (let ((commands nil)) + ;; Mock shell-command to capture all commands + (cl-letf (((symbol-function 'shell-command) + (lambda (cmd) (push cmd commands) 0))) + (cj/recording-test-mic) + (should (= 2 (length commands))) + ;; First command should be ffmpeg (stored last in list due to push) + (let ((ffmpeg-cmd (cadr commands))) + (should (stringp ffmpeg-cmd)) + (should (string-match-p "ffmpeg" ffmpeg-cmd)) + (should (string-match-p "test-mic-device" ffmpeg-cmd)) + (should (string-match-p "-t 5" ffmpeg-cmd)))))) + (test-mic-teardown))) + +(ert-deftest test-video-audio-recording-test-mic-normal-runs-ffplay-for-playback () + "Test that function runs ffplay for playback." + (test-mic-setup) + (unwind-protect + (progn + (setq cj/recording-mic-device "test-mic-device") + (let ((commands nil)) + ;; Capture all shell commands + (cl-letf (((symbol-function 'shell-command) + (lambda (cmd) (push cmd commands) 0))) + (cj/recording-test-mic) + (should (= 2 (length commands))) + ;; Second command should be ffplay + (should (string-match-p "ffplay" (car commands))) + (should (string-match-p "-autoexit" (car commands)))))) + (test-mic-teardown))) + +(ert-deftest test-video-audio-recording-test-mic-normal-displays-messages () + "Test that function displays appropriate messages to user." + (test-mic-setup) + (unwind-protect + (progn + (setq cj/recording-mic-device "test-mic-device") + (let ((messages nil)) + ;; Capture messages + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (push (apply #'format fmt args) messages))) + ((symbol-function 'shell-command) + (lambda (_cmd) 0))) + (cj/recording-test-mic) + (should (>= (length messages) 3)) + ;; Check for recording message + (should (cl-some (lambda (msg) (string-match-p "Recording.*SPEAK NOW" msg)) messages)) + ;; Check for playback message + (should (cl-some (lambda (msg) (string-match-p "Playing back" msg)) messages)) + ;; Check for complete message + (should (cl-some (lambda (msg) (string-match-p "complete" msg)) messages))))) + (test-mic-teardown))) + +;;; Error Cases + +(ert-deftest test-video-audio-recording-test-mic-error-no-mic-configured-signals-error () + "Test that function signals user-error when mic device is not configured." + (test-mic-setup) + (unwind-protect + (progn + (setq cj/recording-mic-device nil) + (should-error (cj/recording-test-mic) :type 'user-error)) + (test-mic-teardown))) + +(ert-deftest test-video-audio-recording-test-mic-error-message-mentions-setup () + "Test that error message guides user to run setup." + (test-mic-setup) + (unwind-protect + (progn + (setq cj/recording-mic-device nil) + (condition-case err + (cj/recording-test-mic) + (user-error + (should (string-match-p "C-; r c" (error-message-string err)))))) + (test-mic-teardown))) + +(ert-deftest test-video-audio-recording-test-mic-error-ffmpeg-failure-handled () + "Test that ffmpeg command failure is handled gracefully." + (test-mic-setup) + (unwind-protect + (progn + (setq cj/recording-mic-device "test-mic-device") + ;; Mock shell-command to fail + (cl-letf (((symbol-function 'shell-command) + (lambda (_cmd) 1))) ;; Non-zero exit code + ;; Should complete without crashing (ffmpeg errors are ignored) + ;; No error is raised - function just completes + (cj/recording-test-mic) + ;; Test passes if we get here + (should t))) + (test-mic-teardown))) + +(provide 'test-video-audio-recording-test-mic) +;;; test-video-audio-recording-test-mic.el ends here diff --git a/tests/test-video-audio-recording-test-monitor.el b/tests/test-video-audio-recording-test-monitor.el new file mode 100644 index 00000000..f1476577 --- /dev/null +++ b/tests/test-video-audio-recording-test-monitor.el @@ -0,0 +1,148 @@ +;;; test-video-audio-recording-test-monitor.el --- Tests for cj/recording-test-monitor -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/recording-test-monitor function. +;; Tests system audio monitor testing functionality. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Setup and Teardown + +(defun test-monitor-setup () + "Reset device variables before each test." + (setq cj/recording-system-device nil)) + +(defun test-monitor-teardown () + "Clean up device variables after each test." + (setq cj/recording-system-device nil)) + +;;; Normal Cases + +(ert-deftest test-video-audio-recording-test-monitor-normal-creates-temp-wav-file () + "Test that function creates temp file with .wav extension." + (test-monitor-setup) + (unwind-protect + (progn + (setq cj/recording-system-device "test-monitor-device") + (let ((temp-file nil)) + ;; Mock make-temp-file to capture filename + (cl-letf (((symbol-function 'make-temp-file) + (lambda (prefix _dir-flag suffix) + (setq temp-file (concat prefix "12345" suffix)) + temp-file)) + ((symbol-function 'shell-command) + (lambda (_cmd) 0))) + (cj/recording-test-monitor) + (should (string-match-p "monitor-test-" temp-file)) + (should (string-match-p "\\.wav$" temp-file))))) + (test-monitor-teardown))) + +(ert-deftest test-video-audio-recording-test-monitor-normal-runs-ffmpeg-command () + "Test that function runs ffmpeg command with configured monitor device." + (test-monitor-setup) + (unwind-protect + (progn + (setq cj/recording-system-device "test-monitor-device") + (let ((commands nil)) + ;; Mock shell-command to capture all commands + (cl-letf (((symbol-function 'shell-command) + (lambda (cmd) (push cmd commands) 0))) + (cj/recording-test-monitor) + (should (= 2 (length commands))) + ;; First command should be ffmpeg (stored last in list due to push) + (let ((ffmpeg-cmd (cadr commands))) + (should (stringp ffmpeg-cmd)) + (should (string-match-p "ffmpeg" ffmpeg-cmd)) + (should (string-match-p "test-monitor-device" ffmpeg-cmd)) + (should (string-match-p "-t 5" ffmpeg-cmd)))))) + (test-monitor-teardown))) + +(ert-deftest test-video-audio-recording-test-monitor-normal-runs-ffplay-for-playback () + "Test that function runs ffplay for playback." + (test-monitor-setup) + (unwind-protect + (progn + (setq cj/recording-system-device "test-monitor-device") + (let ((commands nil)) + ;; Capture all shell commands + (cl-letf (((symbol-function 'shell-command) + (lambda (cmd) (push cmd commands) 0))) + (cj/recording-test-monitor) + (should (= 2 (length commands))) + ;; Second command should be ffplay + (should (string-match-p "ffplay" (car commands))) + (should (string-match-p "-autoexit" (car commands)))))) + (test-monitor-teardown))) + +(ert-deftest test-video-audio-recording-test-monitor-normal-displays-messages () + "Test that function displays appropriate messages to user." + (test-monitor-setup) + (unwind-protect + (progn + (setq cj/recording-system-device "test-monitor-device") + (let ((messages nil)) + ;; Capture messages + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (push (apply #'format fmt args) messages))) + ((symbol-function 'shell-command) + (lambda (_cmd) 0))) + (cj/recording-test-monitor) + (should (>= (length messages) 3)) + ;; Check for recording message + (should (cl-some (lambda (msg) (string-match-p "Recording.*PLAY SOMETHING" msg)) messages)) + ;; Check for playback message + (should (cl-some (lambda (msg) (string-match-p "Playing back" msg)) messages)) + ;; Check for complete message + (should (cl-some (lambda (msg) (string-match-p "complete" msg)) messages))))) + (test-monitor-teardown))) + +;;; Error Cases + +(ert-deftest test-video-audio-recording-test-monitor-error-no-monitor-configured-signals-error () + "Test that function signals user-error when monitor device is not configured." + (test-monitor-setup) + (unwind-protect + (progn + (setq cj/recording-system-device nil) + (should-error (cj/recording-test-monitor) :type 'user-error)) + (test-monitor-teardown))) + +(ert-deftest test-video-audio-recording-test-monitor-error-message-mentions-setup () + "Test that error message guides user to run setup." + (test-monitor-setup) + (unwind-protect + (progn + (setq cj/recording-system-device nil) + (condition-case err + (cj/recording-test-monitor) + (user-error + (should (string-match-p "C-; r c" (error-message-string err)))))) + (test-monitor-teardown))) + +(ert-deftest test-video-audio-recording-test-monitor-error-ffmpeg-failure-handled () + "Test that ffmpeg command failure is handled gracefully." + (test-monitor-setup) + (unwind-protect + (progn + (setq cj/recording-system-device "test-monitor-device") + ;; Mock shell-command to fail + (cl-letf (((symbol-function 'shell-command) + (lambda (_cmd) 1))) ;; Non-zero exit code + ;; Should complete without crashing (ffmpeg errors are ignored) + ;; No error is raised - function just completes + (cj/recording-test-monitor) + ;; Test passes if we get here + (should t))) + (test-monitor-teardown))) + +(provide 'test-video-audio-recording-test-monitor) +;;; test-video-audio-recording-test-monitor.el ends here diff --git a/tests/test-video-audio-recording-toggle-functions.el b/tests/test-video-audio-recording-toggle-functions.el new file mode 100644 index 00000000..2355ab4f --- /dev/null +++ b/tests/test-video-audio-recording-toggle-functions.el @@ -0,0 +1,185 @@ +;;; test-video-audio-recording-toggle-functions.el --- Tests for toggle functions -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for cj/video-recording-toggle and cj/audio-recording-toggle functions. +;; Tests start/stop toggle behavior for recording processes. + +;;; Code: + +(require 'ert) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Stub directory variables +(defvar video-recordings-dir "/tmp/video-recordings/") +(defvar audio-recordings-dir "/tmp/audio-recordings/") + +;; Now load the actual production module +(require 'video-audio-recording) + +;;; Setup and Teardown + +(defun test-toggle-setup () + "Reset process variables before each test." + (setq cj/video-recording-ffmpeg-process nil) + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/recording-mic-device "test-mic") + (setq cj/recording-system-device "test-monitor")) + +(defun test-toggle-teardown () + "Clean up process variables after each test." + (when cj/video-recording-ffmpeg-process + (ignore-errors (delete-process cj/video-recording-ffmpeg-process))) + (when cj/audio-recording-ffmpeg-process + (ignore-errors (delete-process cj/audio-recording-ffmpeg-process))) + (setq cj/video-recording-ffmpeg-process nil) + (setq cj/audio-recording-ffmpeg-process nil) + (setq cj/recording-mic-device nil) + (setq cj/recording-system-device nil)) + +;;; Video Toggle - Normal Cases + +(ert-deftest test-video-audio-recording-video-toggle-normal-starts-when-not-recording () + "Test that video toggle starts recording when not currently recording." + (test-toggle-setup) + (unwind-protect + (let ((start-called nil)) + (cl-letf (((symbol-function 'cj/ffmpeg-record-video) + (lambda (_dir) (setq start-called t)))) + (cj/video-recording-toggle nil) + (should start-called))) + (test-toggle-teardown))) + +(ert-deftest test-video-audio-recording-video-toggle-normal-stops-when-recording () + "Test that video toggle stops recording when currently recording." + (test-toggle-setup) + (unwind-protect + (let ((stop-called nil) + (fake-process (make-process :name "test-video" :command '("sleep" "1000")))) + (setq cj/video-recording-ffmpeg-process fake-process) + (cl-letf (((symbol-function 'cj/video-recording-stop) + (lambda () (setq stop-called t)))) + (cj/video-recording-toggle nil) + (should stop-called)) + (ignore-errors (delete-process fake-process))) + (test-toggle-teardown))) + +(ert-deftest test-video-audio-recording-video-toggle-normal-uses-default-directory () + "Test that video toggle uses default directory when no prefix arg." + (test-toggle-setup) + (unwind-protect + (let ((recorded-dir nil)) + (cl-letf (((symbol-function 'cj/ffmpeg-record-video) + (lambda (dir) (setq recorded-dir dir)))) + (cj/video-recording-toggle nil) + (should (equal video-recordings-dir recorded-dir)))) + (test-toggle-teardown))) + +(ert-deftest test-video-audio-recording-video-toggle-normal-prompts-for-location-with-prefix () + "Test that video toggle prompts for location with prefix arg." + (test-toggle-setup) + (unwind-protect + (let ((prompt-called nil) + (recorded-dir nil)) + (cl-letf (((symbol-function 'read-directory-name) + (lambda (_prompt) (setq prompt-called t) "/custom/path/")) + ((symbol-function 'file-directory-p) + (lambda (_dir) t)) ; Directory exists + ((symbol-function 'cj/ffmpeg-record-video) + (lambda (dir) (setq recorded-dir dir)))) + (cj/video-recording-toggle t) + (should prompt-called) + (should (equal "/custom/path/" recorded-dir)))) + (test-toggle-teardown))) + +;;; Audio Toggle - Normal Cases + +(ert-deftest test-video-audio-recording-audio-toggle-normal-starts-when-not-recording () + "Test that audio toggle starts recording when not currently recording." + (test-toggle-setup) + (unwind-protect + (let ((start-called nil)) + (cl-letf (((symbol-function 'cj/ffmpeg-record-audio) + (lambda (_dir) (setq start-called t)))) + (cj/audio-recording-toggle nil) + (should start-called))) + (test-toggle-teardown))) + +(ert-deftest test-video-audio-recording-audio-toggle-normal-stops-when-recording () + "Test that audio toggle stops recording when currently recording." + (test-toggle-setup) + (unwind-protect + (let ((stop-called nil) + (fake-process (make-process :name "test-audio" :command '("sleep" "1000")))) + (setq cj/audio-recording-ffmpeg-process fake-process) + (cl-letf (((symbol-function 'cj/audio-recording-stop) + (lambda () (setq stop-called t)))) + (cj/audio-recording-toggle nil) + (should stop-called)) + (ignore-errors (delete-process fake-process))) + (test-toggle-teardown))) + +(ert-deftest test-video-audio-recording-audio-toggle-normal-uses-default-directory () + "Test that audio toggle uses default directory when no prefix arg." + (test-toggle-setup) + (unwind-protect + (let ((recorded-dir nil)) + (cl-letf (((symbol-function 'cj/ffmpeg-record-audio) + (lambda (dir) (setq recorded-dir dir)))) + (cj/audio-recording-toggle nil) + (should (equal audio-recordings-dir recorded-dir)))) + (test-toggle-teardown))) + +(ert-deftest test-video-audio-recording-audio-toggle-normal-prompts-for-location-with-prefix () + "Test that audio toggle prompts for location with prefix arg." + (test-toggle-setup) + (unwind-protect + (let ((prompt-called nil) + (recorded-dir nil)) + (cl-letf (((symbol-function 'read-directory-name) + (lambda (_prompt) (setq prompt-called t) "/custom/path/")) + ((symbol-function 'file-directory-p) + (lambda (_dir) t)) ; Directory exists + ((symbol-function 'cj/ffmpeg-record-audio) + (lambda (dir) (setq recorded-dir dir)))) + (cj/audio-recording-toggle t) + (should prompt-called) + (should (equal "/custom/path/" recorded-dir)))) + (test-toggle-teardown))) + +;;; Boundary Cases + +(ert-deftest test-video-audio-recording-video-toggle-boundary-creates-directory () + "Test that video toggle creates directory if it doesn't exist." + (test-toggle-setup) + (unwind-protect + (let ((mkdir-called nil)) + (cl-letf (((symbol-function 'file-directory-p) + (lambda (_dir) nil)) + ((symbol-function 'make-directory) + (lambda (_dir _parents) (setq mkdir-called t))) + ((symbol-function 'cj/ffmpeg-record-video) + (lambda (_dir) nil))) + (cj/video-recording-toggle nil) + (should mkdir-called))) + (test-toggle-teardown))) + +(ert-deftest test-video-audio-recording-audio-toggle-boundary-creates-directory () + "Test that audio toggle creates directory if it doesn't exist." + (test-toggle-setup) + (unwind-protect + (let ((mkdir-called nil)) + (cl-letf (((symbol-function 'file-directory-p) + (lambda (_dir) nil)) + ((symbol-function 'make-directory) + (lambda (_dir _parents) (setq mkdir-called t))) + ((symbol-function 'cj/ffmpeg-record-audio) + (lambda (_dir) nil))) + (cj/audio-recording-toggle nil) + (should mkdir-called))) + (test-toggle-teardown))) + +(provide 'test-video-audio-recording-toggle-functions) +;;; test-video-audio-recording-toggle-functions.el ends here |