diff options
Diffstat (limited to 'tests')
27 files changed, 535 insertions, 181 deletions
diff --git a/tests/test-calendar-sync-source-fetch-sentinel.el b/tests/test-calendar-sync-source-fetch-sentinel.el new file mode 100644 index 00000000..0b7ba1cf --- /dev/null +++ b/tests/test-calendar-sync-source-fetch-sentinel.el @@ -0,0 +1,72 @@ +;;; test-calendar-sync-source-fetch-sentinel.el --- Tests for the fetch sentinel -*- lexical-binding: t; -*- + +;;; Commentary: +;; calendar-sync--fetch-sentinel-finish is the extracted tail of the async +;; .ics fetch sentinel. The async-worker tests stub the whole fetch, so its +;; success, failure, and temp-file-cleanup branches were never exercised. +;; These tests drive the helper directly with fake success/failure inputs, +;; no live curl process. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'calendar-sync) + +(ert-deftest test-calendar-sync-fetch-sentinel-success-passes-temp-file () + "Normal: on success the callback gets the temp file and it is not deleted." + (let ((temp-file (make-temp-file "calendar-sync-sentinel-" nil ".ics")) + (buffer (generate-new-buffer " *cs-test*")) + (got 'unset)) + (unwind-protect + (progn + (calendar-sync--fetch-sentinel-finish + t "finished\n" temp-file buffer (lambda (r) (setq got r))) + (should (equal got temp-file)) + (should (file-exists-p temp-file)) + (should-not (buffer-live-p buffer))) + (when (file-exists-p temp-file) (delete-file temp-file)) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest test-calendar-sync-fetch-sentinel-failure-deletes-and-passes-nil () + "Error: on failure the temp file is deleted and the callback gets nil." + (let ((temp-file (make-temp-file "calendar-sync-sentinel-" nil ".ics")) + (buffer (generate-new-buffer " *cs-test*")) + (got 'unset) + (logged nil)) + (unwind-protect + (cl-letf (((symbol-function 'calendar-sync--log-silently) + (lambda (&rest _) (setq logged t)))) + (calendar-sync--fetch-sentinel-finish + nil "exited abnormally with code 22\n" temp-file buffer + (lambda (r) (setq got r))) + (should (null got)) + (should-not (file-exists-p temp-file)) + (should logged) + (should-not (buffer-live-p buffer))) + (when (file-exists-p temp-file) (delete-file temp-file)) + (when (buffer-live-p buffer) (kill-buffer buffer))))) + +(ert-deftest test-calendar-sync-fetch-sentinel-failure-tolerates-missing-temp-file () + "Boundary: failure with the temp file already gone does not error." + (let ((temp-file (make-temp-file "calendar-sync-sentinel-" nil ".ics")) + (got 'unset)) + (delete-file temp-file) + (cl-letf (((symbol-function 'calendar-sync--log-silently) #'ignore)) + (calendar-sync--fetch-sentinel-finish + nil "failed\n" temp-file nil (lambda (r) (setq got r))) + (should (null got))))) + +(ert-deftest test-calendar-sync-fetch-sentinel-tolerates-dead-buffer () + "Boundary: a already-dead process buffer is not touched on success." + (let ((temp-file (make-temp-file "calendar-sync-sentinel-" nil ".ics")) + (got 'unset)) + (unwind-protect + (progn + (calendar-sync--fetch-sentinel-finish + t "finished\n" temp-file nil (lambda (r) (setq got r))) + (should (equal got temp-file))) + (when (file-exists-p temp-file) (delete-file temp-file))))) + +(provide 'test-calendar-sync-source-fetch-sentinel) +;;; test-calendar-sync-source-fetch-sentinel.el ends here diff --git a/tests/test-custom-buffer-file--view-email-in-buffer.el b/tests/test-custom-buffer-file--view-email-in-buffer.el index 99e0e44d..b0209b78 100644 --- a/tests/test-custom-buffer-file--view-email-in-buffer.el +++ b/tests/test-custom-buffer-file--view-email-in-buffer.el @@ -13,6 +13,7 @@ ;;; Code: (require 'ert) +(require 'cl-lib) (require 'testutil-general) (require 'custom-buffer-file) @@ -233,5 +234,24 @@ Note: shr may insert newlines between words for wrapping." (kill-buffer))) (test-email--teardown))) +(ert-deftest test-custom-buffer-file--view-email-no-displayable-destroys-handle () + "Error: the MIME handle is destroyed even when no displayable part is found. +The `user-error' fires before cleanup, so without `unwind-protect' the dissected +handle leaks." + (test-email--setup) + (unwind-protect + (let ((eml-file (test-email--create-eml-file test-email--image-only)) + (destroy-called nil)) + (with-current-buffer (find-file-noselect eml-file) + (let ((real (symbol-function 'mm-destroy-parts))) + (cl-letf (((symbol-function 'mm-destroy-parts) + (lambda (handle) + (setq destroy-called t) + (funcall real handle)))) + (should-error (cj/view-email-in-buffer) :type 'user-error))) + (should destroy-called) + (kill-buffer))) + (test-email--teardown))) + (provide 'test-custom-buffer-file--view-email-in-buffer) ;;; test-custom-buffer-file--view-email-in-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 index 262968d6..5ee57b3a 100644 --- a/tests/test-custom-buffer-file-copy-link-to-buffer-file.el +++ b/tests/test-custom-buffer-file-copy-link-to-buffer-file.el @@ -4,7 +4,8 @@ ;; 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). +;; the kill ring. For non-file buffers, it signals a user-error, matching its +;; sibling copy commands. ;;; Code: @@ -58,12 +59,12 @@ (test-copy-link-teardown))) (ert-deftest test-copy-link-non-file-buffer () - "Should do nothing for non-file buffer without error." + "Error: a non-file buffer signals `user-error' and leaves the kill ring alone." (test-copy-link-setup) (unwind-protect (with-temp-buffer (setq kill-ring nil) - (cj/copy-link-to-buffer-file) + (should-error (cj/copy-link-to-buffer-file) :type 'user-error) (should (null kill-ring))) (test-copy-link-teardown))) @@ -195,13 +196,13 @@ (test-copy-link-teardown))) (ert-deftest test-copy-link-scratch-buffer () - "Should do nothing for *scratch* buffer." + "Error: the *scratch* buffer (no file) signals `user-error'." (test-copy-link-setup) (unwind-protect (progn (setq kill-ring nil) (with-current-buffer "*scratch*" - (cj/copy-link-to-buffer-file) + (should-error (cj/copy-link-to-buffer-file) :type 'user-error) (should (null kill-ring)))) (test-copy-link-teardown))) diff --git a/tests/test-custom-case-title-case-region.el b/tests/test-custom-case-title-case-region.el index 383ae927..82b4966a 100644 --- a/tests/test-custom-case-title-case-region.el +++ b/tests/test-custom-case-title-case-region.el @@ -60,16 +60,17 @@ an active region, and return the result." "The Art of War"))) (ert-deftest test-custom-case-title-case-region-normal-all-minor-words () - "All minor words in the skip list should be lowercased in mid-sentence." + "All minor words in the skip list should be lowercased in mid-sentence. +\"is\" is a linking verb, so it is a major word and is capitalized." (should (equal (test-title-case--on-string "go a an and as at but by for if in is nor of on or so the to yet go") - "Go a an and as at but by for if in is nor of on or so the to yet Go"))) + "Go a an and as at but by for if in Is nor of on or so the to yet Go"))) (ert-deftest test-custom-case-title-case-region-normal-four-letter-words-capitalized () "Words of four or more letters should always be capitalized. -Note: 'is' is explicitly in the minor word list, so it stays lowercase." +\"is\" is a linking verb (a major word), so it is capitalized too." (should (equal (test-title-case--on-string "this is from that with over") - "This is From That With Over"))) + "This Is From That With Over"))) (ert-deftest test-custom-case-title-case-region-normal-allcaps-input () "All-caps input should be downcased first, then title-cased." @@ -94,7 +95,16 @@ Note: 'is' is explicitly in the minor word list, so it stays lowercase." (ert-deftest test-custom-case-title-case-region-normal-question-resets () "Word immediately after a question mark should be capitalized, even if minor." (should (equal (test-title-case--on-string "really? the answer is no") - "Really? The Answer is No"))) + "Really? The Answer Is No"))) + +(ert-deftest test-custom-case-title-case-region-normal-last-word-capitalized () + "The last word is always capitalized, even a minor one." + (should (equal (test-title-case--on-string "the art of") "The Art Of"))) + +(ert-deftest test-custom-case-title-case-region-normal-period-restarts () + "A word after a sentence-ending period should be capitalized." + (should (equal (test-title-case--on-string "one. the next sentence") + "One. The Next Sentence"))) (ert-deftest test-custom-case-title-case-region-normal-hyphenated-word () "Second part of a hyphenated word should NOT be capitalized." @@ -141,7 +151,7 @@ Note: 'is' is explicitly in the minor word list, so it stays lowercase." (ert-deftest test-custom-case-title-case-region-boundary-unicode-words () "Unicode characters should pass through without error." (should (equal (test-title-case--on-string "the café is nice") - "The Café is Nice"))) + "The Café Is Nice"))) (ert-deftest test-custom-case-title-case-region-boundary-numbers-in-text () "Numbers mixed with text should not break title casing." diff --git a/tests/test-custom-comments-comment-inline-border.el b/tests/test-custom-comments-comment-inline-border.el index 78e86035..305a2c7a 100644 --- a/tests/test-custom-comments-comment-inline-border.el +++ b/tests/test-custom-comments-comment-inline-border.el @@ -120,6 +120,16 @@ Returns the buffer string for assertions." (let ((result (test-inline-border-at-column 0 ";;" "" "=" "" 10))) (should (string-match-p ";" result)))) +(ert-deftest test-inline-border-elisp-fills-exact-width-all-parities () + "Boundary: even, odd, and empty text all fill LENGTH exactly. +Even-length and empty text used to come out two columns short because the +right decoration count keyed off text-length parity instead of the remaining +width, so stacked dividers of differing text lengths misaligned." + (dolist (text '("" "X" "EVEN" "ODD" "Header")) + (let* ((result (test-inline-border-at-column 0 ";;" "" "=" text 50)) + (line (string-trim-right result "\n"))) + (should (= 50 (length line)))))) + (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))) diff --git a/tests/test-custom-comments-comment-reformat.el b/tests/test-custom-comments-comment-reformat.el index 83248aee..91b7dfe3 100644 --- a/tests/test-custom-comments-comment-reformat.el +++ b/tests/test-custom-comments-comment-reformat.el @@ -146,19 +146,12 @@ Insert CONTENT-BEFORE, select all, run cj/comment-reformat, verify EXPECTED-AFTE (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." + "Should signal `user-error' when no region is 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))))))) + (should-error (cj/comment-reformat) :type 'user-error))) (ert-deftest test-comment-reformat-elisp-read-only-buffer () "Should signal error in read-only buffer." diff --git a/tests/test-custom-datetime-all-methods.el b/tests/test-custom-datetime-all-methods.el index 62b421bd..1f31c6c4 100644 --- a/tests/test-custom-datetime-all-methods.el +++ b/tests/test-custom-datetime-all-methods.el @@ -54,9 +54,10 @@ (should (string-match-p "14:30:45" result)))) (ert-deftest test-custom-datetime-all-methods-normal-sortable-time () - "cj/insert-sortable-time should insert time with AM/PM and timezone." + "cj/insert-sortable-time should insert 24-hour time so it sorts lexically." (let ((result (test-datetime--run #'cj/insert-sortable-time))) - (should (string-match-p "02:30:45 PM" result)))) + (should (string-match-p "14:30:45" result)) + (should-not (string-match-p "PM" result)))) (ert-deftest test-custom-datetime-all-methods-normal-readable-time () "cj/insert-readable-time should insert short time with AM/PM." diff --git a/tests/test-custom-line-paragraph-duplicate-line-or-region.el b/tests/test-custom-line-paragraph-duplicate-line-or-region.el index 84f5bc2d..9e501086 100644 --- a/tests/test-custom-line-paragraph-duplicate-line-or-region.el +++ b/tests/test-custom-line-paragraph-duplicate-line-or-region.el @@ -327,6 +327,40 @@ (should (> (length (buffer-string)) (length "line one\nline two\nline three")))) (test-duplicate-line-or-region-teardown))) +(ert-deftest test-duplicate-line-or-region-mid-line-bounds-duplicate-whole-lines () + "A region ending mid-line duplicates every whole line it touches, no splits. +The old open-line loop split the mid-line-ending line instead." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "aaa\nbbb\nccc") + (transient-mark-mode 1) + (goto-char (point-min)) + (forward-char 1) ; mid first line + (set-mark (point)) + (forward-line 1) + (forward-char 2) ; mid second line + (activate-mark) + (cj/duplicate-line-or-region) + (should (string= "aaa\nbbb\naaa\nbbb\nccc" (buffer-string)))) + (test-duplicate-line-or-region-teardown))) + +(ert-deftest test-duplicate-line-or-region-ends-at-bol-no-extra-empty-line () + "A region ending at beginning-of-line duplicates only the fully-included lines. +The old open-line loop duplicated a stray empty line here." + (test-duplicate-line-or-region-setup) + (unwind-protect + (with-temp-buffer + (insert "aaa\nbbb\nccc") + (transient-mark-mode 1) + (goto-char (point-min)) + (set-mark (point)) + (forward-line 2) ; region "aaa\nbbb\n", ends at bol of ccc + (activate-mark) + (cj/duplicate-line-or-region) + (should (string= "aaa\nbbb\naaa\nbbb\nccc" (buffer-string)))) + (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) diff --git a/tests/test-custom-line-paragraph-join-line-or-region.el b/tests/test-custom-line-paragraph-join-line-or-region.el index f8738910..5d421683 100644 --- a/tests/test-custom-line-paragraph-join-line-or-region.el +++ b/tests/test-custom-line-paragraph-join-line-or-region.el @@ -62,8 +62,8 @@ (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." +(ert-deftest test-join-line-or-region-no-region-adds-newline-at-end-of-buffer () + "Without region, joining the last line adds a trailing newline at end of buffer." (test-join-line-or-region-setup) (unwind-protect (with-temp-buffer @@ -73,6 +73,20 @@ (should (string-suffix-p "\n" (buffer-string)))) (test-join-line-or-region-teardown))) +(ert-deftest test-join-line-or-region-no-region-mid-buffer-no-blank-line () + "Without region, joining a non-last line must not insert a blank line. +The trailing newline belongs only at end of buffer; adding it unconditionally +left a stray blank line between the joined line and the rest of the buffer." + (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) ; point on "line two", not the last line + (cj/join-line-or-region) + (should (string= "line one line two\nline three" (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) diff --git a/tests/test-custom-line-paragraph-jump-to-matching-paren.el b/tests/test-custom-line-paragraph-jump-to-matching-paren.el index 31853da6..bd24faed 100644 --- a/tests/test-custom-line-paragraph-jump-to-matching-paren.el +++ b/tests/test-custom-line-paragraph-jump-to-matching-paren.el @@ -83,11 +83,11 @@ POINT-POSITION is 1-indexed (1 = first character)." ;;; Normal Cases - Backward Jump (Closing to Opening) (ert-deftest test-jump-paren-backward-simple () - "Should jump backward from closing paren to opening paren." + "Should jump from a closing paren to its matching 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)))) + ;; Should end at position 1 (the matching opening paren) + (should (= 1 (test-jump-to-matching-paren "(hello)" 7)))) (ert-deftest test-jump-paren-backward-nested () "Should jump backward over nested parens from after outer closing." @@ -97,11 +97,11 @@ POINT-POSITION is 1-indexed (1 = first character)." (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." + "Should jump from an inner closing paren to its matching inner opener." ;; 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)))) + ;; Should end at position 6 (the matching inner opening paren) + (should (= 6 (test-jump-to-matching-paren "(foo (bar))" 10)))) (ert-deftest test-jump-bracket-backward () "Should jump backward from after closing bracket." @@ -145,11 +145,11 @@ POINT-POSITION is 1-indexed (1 = first character)." (should (= 1 (test-jump-to-matching-paren "(hello" 1)))) (ert-deftest test-jump-paren-unmatched-closing () - "Should move to beginning from unmatched closing paren." + "Should stay put on an unmatched closing paren (no matching opener)." ;; 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)))) + ;; There is no matching opener, so point is restored and stays at 6 + (should (= 6 (test-jump-to-matching-paren "hello)" 6)))) ;;; Boundary Cases - Empty Delimiters @@ -161,11 +161,11 @@ POINT-POSITION is 1-indexed (1 = first character)." (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." + "Should jump from the closing paren of empty parens to its opener." ;; 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)))) + ;; Should end at position 1 (the matching opening paren) + (should (= 1 (test-jump-to-matching-paren "()" 2)))) ;;; Boundary Cases - Multiple Delimiter Types diff --git a/tests/test-custom-ordering-number-lines.el b/tests/test-custom-ordering-number-lines.el index adda84f0..142e5561 100644 --- a/tests/test-custom-ordering-number-lines.el +++ b/tests/test-custom-ordering-number-lines.el @@ -122,9 +122,10 @@ Returns the transformed string." (should (string= result "1. ")))) (ert-deftest test-number-lines-empty-lines () - "Should number empty lines." + "Should number empty lines, treating the final newline as a terminator. +The old split counted the trailing newline as a spurious third line." (let ((result (test-number-lines "\n\n" "N. " nil))) - (should (string= result "1. \n2. \n3. ")))) + (should (string= result "1. \n2. \n")))) (ert-deftest test-number-lines-with-existing-numbers () "Should number lines that already have content." diff --git a/tests/test-custom-ordering-reverse-lines.el b/tests/test-custom-ordering-reverse-lines.el index 3c71362d..5b8c01ac 100644 --- a/tests/test-custom-ordering-reverse-lines.el +++ b/tests/test-custom-ordering-reverse-lines.el @@ -86,9 +86,11 @@ Returns the transformed string." (should (string= result "b\n\na")))) (ert-deftest test-reverse-lines-trailing-newline () - "Should handle trailing newline." + "Should reverse the lines and preserve the trailing newline. +The old split dropped the trailing newline into a leading empty line, +producing \"\\nline2\\nline1\"." (let ((result (test-reverse-lines "line1\nline2\n"))) - (should (string= result "\nline2\nline1")))) + (should (string= result "line2\nline1\n")))) (ert-deftest test-reverse-lines-only-newlines () "Should reverse lines that are only newlines." diff --git a/tests/test-custom-text-enclose-indent.el b/tests/test-custom-text-enclose-indent.el index e9042d35..f37d1800 100644 --- a/tests/test-custom-text-enclose-indent.el +++ b/tests/test-custom-text-enclose-indent.el @@ -43,6 +43,35 @@ Returns the transformed string." Returns the transformed string." (cj/--dedent-lines text count)) +;;; Interactive default resolution (the prefix-arg decoupling fix) + +(ert-deftest test-indent-lines-interactive-no-prefix-is-four-spaces () + "Interactive: no prefix indents by 4, spaces when `indent-tabs-mode' is nil. +The old \"p\\nP\" spec defaulted count to 1 and forced tabs on any prefix." + (with-temp-buffer + (setq-local indent-tabs-mode nil) + (insert "line") + (let ((current-prefix-arg nil)) + (call-interactively #'cj/indent-lines-in-region-or-buffer)) + (should (string= " line" (buffer-string))))) + +(ert-deftest test-indent-lines-interactive-follows-indent-tabs-mode () + "Interactive: tabs-vs-spaces follows `indent-tabs-mode', not the prefix arg." + (with-temp-buffer + (setq-local indent-tabs-mode t) + (insert "line") + (let ((current-prefix-arg nil)) + (call-interactively #'cj/indent-lines-in-region-or-buffer)) + (should (string= "\t\t\t\tline" (buffer-string))))) + +(ert-deftest test-dedent-lines-interactive-no-prefix-is-four () + "Interactive: no prefix removes up to 4 leading whitespace characters." + (with-temp-buffer + (insert " line") ; eight leading spaces + (let ((current-prefix-arg nil)) + (call-interactively #'cj/dedent-lines-in-region-or-buffer)) + (should (string= " line" (buffer-string))))) + ;;; Indent Tests - Normal Cases with Spaces (ert-deftest test-indent-single-line-4-spaces () diff --git a/tests/test-flyspell-and-abbrev.el b/tests/test-flyspell-and-abbrev.el index ef8cc637..3b494d5e 100644 --- a/tests/test-flyspell-and-abbrev.el +++ b/tests/test-flyspell-and-abbrev.el @@ -97,5 +97,27 @@ (cj/flyspell-on-for-buffer-type))) (should mode-called))) +;; --------------------------- cj/flyspell-then-abbrev ------------------------- + +(ert-deftest test-flyspell-then-abbrev-enables-mode-not-bare-rescan () + "Regression: cj/flyspell-then-abbrev routes the initial scan through +cj/flyspell-on-for-buffer-type, which enables flyspell-mode so it sticks. +The bare flyspell-buffer it replaced never turned the mode on, so the guard +never tripped and every C-' press re-scanned the whole buffer (O(buffer) per +keypress in large files)." + (let (on-called scan-called) + (cl-letf (((symbol-function 'cj/--require-spell-checker) #'ignore) + ((symbol-function 'cj/flyspell-on-for-buffer-type) + (lambda () (setq on-called t))) + ((symbol-function 'flyspell-buffer) + (lambda (&rest _) (setq scan-called t))) + ((symbol-function 'cj/flyspell-goto-previous-misspelling) + (lambda (&rest _) nil))) + (with-temp-buffer + (text-mode) + (cj/flyspell-then-abbrev nil))) + (should on-called) + (should-not scan-called))) + (provide 'test-flyspell-and-abbrev) ;;; test-flyspell-and-abbrev.el ends here diff --git a/tests/test-font-config.el b/tests/test-font-config.el index 393a7758..4df2b41a 100644 --- a/tests/test-font-config.el +++ b/tests/test-font-config.el @@ -93,5 +93,47 @@ ((symbol-function 'set-fontset-font) (lambda (&rest _) t))) (should (progn (cj/setup-emoji-fontset) t)))) +;;; cj/set-emojify-display-style + +(defvar emojify-display-style) + +(ert-deftest test-font-config-emojify-display-style-image-on-gui () + "Normal: on a GUI frame the emoji display style is `image'." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((emojify-display-style nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda (&rest _) t))) + (cj/set-emojify-display-style) + (should (eq emojify-display-style 'image))))) + +(ert-deftest test-font-config-emojify-display-style-unicode-without-gui () + "Boundary: without a GUI the emoji display style is `unicode'." + (skip-unless test-font-config--available) + (require 'font-config) + (let ((emojify-display-style nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda (&rest _) nil))) + (cj/set-emojify-display-style) + (should (eq emojify-display-style 'unicode))))) + +;;; cj/display-available-fonts + +(ert-deftest test-font-config-display-available-fonts-second-call-no-error () + "Error: a second invocation does not signal on the read-only buffer." + (skip-unless test-font-config--available) + (require 'font-config) + (cl-letf (((symbol-function 'font-family-list) + (lambda (&rest _) '("Fixture Font A" "Fixture Font B")))) + (unwind-protect + (progn + (cj/display-available-fonts) + ;; The first call ends in `special-mode' (read-only); the second must + ;; not signal when it erases and rewrites the buffer. + (cj/display-available-fonts) + (with-current-buffer "*Available Fonts*" + (should (> (buffer-size) 0)) + (should buffer-read-only))) + (when (get-buffer "*Available Fonts*") + (kill-buffer "*Available Fonts*"))))) + (provide 'test-font-config) ;;; test-font-config.el ends here diff --git a/tests/test-keyboard-compat-setup.el b/tests/test-keyboard-compat-setup.el index a3e6f441..a23e24e1 100644 --- a/tests/test-keyboard-compat-setup.el +++ b/tests/test-keyboard-compat-setup.el @@ -79,18 +79,20 @@ without the arrow-key decodings. The GUI half already frame-scopes itself." ,@body))) (defconst test-kbc--meta-shift-letters - '(?o ?m ?y ?f ?w ?e ?l ?r ?v ?h ?t ?z ?u ?d ?i ?c ?b ?k) - "The 18 letters whose M-<UPPER> form is translated to M-S-<lower> in GUI mode.") + '(?o ?m ?y ?f ?w ?e ?l ?r ?v ?h ?t ?z ?u ?d ?i ?c ?b) + "The 17 letters whose M-<UPPER> form is translated to M-S-<lower> in GUI mode.") (ert-deftest test-keyboard-compat-gui-setup-translates-spot-checks () - "Normal: in GUI mode, M-O -> M-S-o and M-K -> M-S-k (sampled)." + "Normal: in GUI mode, M-O -> M-S-o and M-B -> M-S-b (sampled). +M-K is no longer translated: show-kill-ring, its only consumer, was retired." (test-kbc--gui t (cj/keyboard-compat-gui-setup) (should (equal (lookup-key key-translation-map (kbd "M-O")) (kbd "M-S-o"))) - (should (equal (lookup-key key-translation-map (kbd "M-K")) (kbd "M-S-k"))) - (should (equal (lookup-key key-translation-map (kbd "M-D")) (kbd "M-S-d"))))) + (should (equal (lookup-key key-translation-map (kbd "M-B")) (kbd "M-S-b"))) + (should (equal (lookup-key key-translation-map (kbd "M-D")) (kbd "M-S-d"))) + (should-not (lookup-key key-translation-map (kbd "M-K"))))) -(ert-deftest test-keyboard-compat-gui-setup-translates-all-eighteen () +(ert-deftest test-keyboard-compat-gui-setup-translates-all-seventeen () "Normal: every documented M-<UPPER> maps to its M-S-<lower> form." (test-kbc--gui t (cj/keyboard-compat-gui-setup) diff --git a/tests/test-local-repository--car-member.el b/tests/test-local-repository--car-member.el deleted file mode 100644 index 30ae58c6..00000000 --- a/tests/test-local-repository--car-member.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; test-local-repository--car-member.el --- Tests for localrepo--car-member -*- lexical-binding: t -*- - -;;; Commentary: -;; Tests for `localrepo--car-member' in local-repository.el — the predicate -;; localrepo-initialize uses to check whether an archive id is already -;; registered in package-archives / package-archive-priorities. - -;;; Code: - -(require 'ert) -(require 'local-repository) - -;;; Normal Cases - -(ert-deftest test-local-repository-localrepo--car-member-found () - "Normal: VALUE present as a car returns the matching tail (non-nil)." - (should (equal (localrepo--car-member 'b '((a . 1) (b . 2) (c . 3))) - '(b c)))) - -(ert-deftest test-local-repository-localrepo--car-member-not-found () - "Normal: VALUE absent from every car returns nil." - (should-not (localrepo--car-member 'z '((a . 1) (b . 2))))) - -(ert-deftest test-local-repository-localrepo--car-member-string-car () - "Normal: car comparison uses `equal', so string keys match by value." - (should (localrepo--car-member "localrepo" - '(("gnu" . "url1") ("localrepo" . "url2"))))) - -;;; Boundary Cases - -(ert-deftest test-local-repository-localrepo--car-member-empty-list () - "Boundary: an empty list never matches." - (should-not (localrepo--car-member 'a nil))) - -(ert-deftest test-local-repository-localrepo--car-member-single-match () - "Boundary: a single-element list whose car matches returns non-nil." - (should (localrepo--car-member 'only '((only . 1))))) - -(ert-deftest test-local-repository-localrepo--car-member-single-no-match () - "Boundary: a single-element list whose car differs returns nil." - (should-not (localrepo--car-member 'x '((only . 1))))) - -(ert-deftest test-local-repository-localrepo--car-member-nil-value-with-nil-car () - "Boundary: a nil VALUE matches a cons whose car is nil." - (should (localrepo--car-member nil '((nil . 1) (a . 2))))) - -(ert-deftest test-local-repository-localrepo--car-member-nil-value-no-nil-car () - "Boundary: a nil VALUE with no nil car returns nil." - (should-not (localrepo--car-member nil '((a . 1) (b . 2))))) - -;;; Error Cases - -(ert-deftest test-local-repository-localrepo--car-member-non-cons-element () - "Error: a non-cons element makes `car' signal wrong-type-argument." - (should-error (localrepo--car-member 'x '(1 2)) :type 'wrong-type-argument)) - -(provide 'test-local-repository--car-member) -;;; test-local-repository--car-member.el ends here diff --git a/tests/test-local-repository.el b/tests/test-local-repository.el new file mode 100644 index 00000000..132f8dc4 --- /dev/null +++ b/tests/test-local-repository.el @@ -0,0 +1,32 @@ +;;; test-local-repository.el --- Tests for the local-repository update command -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/update-localrepo-repository' refreshes the checked-in local package +;; archive at `localrepo-location' (owned by early-init.el) via elpa-mirror. +;; The elpa-mirror call is mocked at the boundary. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'local-repository) + +;; localrepo-location is a defconst in early-init.el, which `make test' never +;; loads. Declare it special here so the `let' below binds it dynamically and +;; the module reads that value. +(defvar localrepo-location nil) + +(ert-deftest test-local-repository-update-targets-early-init-location () + "Normal: the mirror update targets `localrepo-location', the single archive +path early-init.el owns, not a divergent module-local copy." + (let ((localrepo-location "/tmp/test-localrepo/") + (captured nil)) + (cl-letf (((symbol-function 'elpamr-create-mirror-for-installed) + (lambda (dir &rest _) (setq captured dir)))) + (cj/update-localrepo-repository) + (should (equal captured "/tmp/test-localrepo/"))))) + +(provide 'test-local-repository) +;;; test-local-repository.el ends here diff --git a/tests/test-lorem-optimum.el b/tests/test-lorem-optimum.el index f928c972..b7d97a8e 100644 --- a/tests/test-lorem-optimum.el +++ b/tests/test-lorem-optimum.el @@ -253,5 +253,26 @@ an empty string, not an error." (let ((cj/lipsum-chain (cj/markov-chain-create))) (should (equal "" (cj/lipsum-title))))) +;;; cj/lipsum entry point + +(ert-deftest test-lipsum-returns-string-with-populated-chain () + "Normal: cj/lipsum returns a non-empty string when the chain is trained." + (let ((cj/lipsum-chain + (test-learn "Lorem ipsum dolor sit amet consectetur adipiscing elit"))) + (let ((result (cj/lipsum 5))) + (should (stringp result)) + (should (> (length result) 0))))) + +(ert-deftest test-lipsum-empty-chain-signals-user-error () + "Error: cj/lipsum on an empty chain signals a user-error naming the fix, +rather than returning nil and letting cj/lipsum-insert do (insert nil), +which raises a cryptic wrong-type error far from the cause." + (let ((cj/lipsum-chain (cj/markov-chain-create))) + (should-error (cj/lipsum 5) :type 'user-error))) + +(ert-deftest test-lipsum-is-interactive-command () + "Normal: cj/lipsum is a command, as its Commentary (M-x cj/lipsum) advertises." + (should (commandp 'cj/lipsum))) + (provide 'test-lorem-optimum) ;;; test-lorem-optimum.el ends here diff --git a/tests/test-org-contacts-config-find.el b/tests/test-org-contacts-config-find.el new file mode 100644 index 00000000..60a5e713 --- /dev/null +++ b/tests/test-org-contacts-config-find.el @@ -0,0 +1,72 @@ +;;; test-org-contacts-config-find.el --- Tests for cj/org-contacts-find -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/org-contacts-find collects contact headings (name, position, and the +;; EMAIL/PHONE annotation) before prompting, then jumps to the selected +;; heading's stored position. These tests pin the collector helper and a +;; command-level smoke test: the jump must land on the heading, never on a +;; body line that merely mentions the name. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'org) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-contacts-config) + +;;; cj/--org-contacts-collect + +(ert-deftest test-org-contacts-collect-returns-name-position-info () + "Normal: collector returns heading name, heading position, and EMAIL/PHONE." + (with-temp-buffer + (org-mode) + (insert "* Alice\n:PROPERTIES:\n:EMAIL: alice@example.com\n:END:\n" + "some body text mentioning Bob\n" + "* Bob\n:PROPERTIES:\n:PHONE: 555-1234\n:END:\n") + (let* ((alist (cj/--org-contacts-collect (current-buffer))) + (alice (assoc "Alice" alist)) + (bob (assoc "Bob" alist))) + (should (equal (length alist) 2)) + (should (equal (nth 2 alice) "alice@example.com")) + (should (equal (nth 2 bob) "555-1234")) + ;; positions land on the headings, not the body line that mentions Bob + (should (save-excursion (goto-char (nth 1 alice)) (looking-at "\\* Alice"))) + (should (save-excursion (goto-char (nth 1 bob)) (looking-at "\\* Bob")))))) + +(ert-deftest test-org-contacts-collect-empty-buffer-returns-nil () + "Boundary: a buffer with no headings yields an empty alist." + (with-temp-buffer + (org-mode) + (should (null (cj/--org-contacts-collect (current-buffer)))))) + +(ert-deftest test-org-contacts-collect-heading-without-props-has-nil-info () + "Error: a heading with no EMAIL or PHONE yields nil info." + (with-temp-buffer + (org-mode) + (insert "* Carol\n") + (let ((alist (cj/--org-contacts-collect (current-buffer)))) + (should (equal (nth 2 (assoc "Carol" alist)) nil))))) + +;;; cj/org-contacts-find + +(ert-deftest test-org-contacts-find-jumps-to-heading-not-body () + "Normal: selecting a contact jumps to its heading, not a body mention." + (let ((contacts-file (make-temp-file "org-contacts-test-" nil ".org"))) + (unwind-protect + (progn + (with-temp-file contacts-file + (insert "* Alice\n:PROPERTIES:\n:EMAIL: alice@example.com\n:END:\n" + "note: call Bob about Alice\n" + "* Bob\n:PROPERTIES:\n:PHONE: 555-1234\n:END:\n")) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) "Bob")) + ((symbol-function 'org-fold-show-entry) #'ignore) + ((symbol-function 'org-reveal) #'ignore)) + (cj/org-contacts-find) + (should (looking-at "\\* Bob")))) + (delete-file contacts-file)))) + +(provide 'test-org-contacts-config-find) +;;; test-org-contacts-config-find.el ends here diff --git a/tests/test-org-drill-config-source.el b/tests/test-org-drill-config-source.el new file mode 100644 index 00000000..ccda99ef --- /dev/null +++ b/tests/test-org-drill-config-source.el @@ -0,0 +1,31 @@ +;;; test-org-drill-config-source.el --- Tests for org-drill source selection -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--org-drill-source-keywords decides how use-package obtains org-drill: +;; a local dev checkout via :load-path when it exists, otherwise the upstream +;; repo via :vc. Without this, a machine lacking the checkout hits :demand t +;; against a nonexistent :load-path and drill fails to load entirely. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-drill-config) + +(ert-deftest test-org-drill-source-keywords-uses-load-path-when-checkout-exists () + "Normal: an existing checkout directory selects :load-path." + (let ((dir (make-temp-file "org-drill-checkout-" t))) + (unwind-protect + (should (equal (cj/--org-drill-source-keywords dir) + (list :load-path dir))) + (delete-directory dir t)))) + +(ert-deftest test-org-drill-source-keywords-falls-back-to-vc-when-absent () + "Error: a missing checkout falls back to a :vc install spec." + (let ((kws (cj/--org-drill-source-keywords "/nonexistent/org-drill-xyz"))) + (should (eq (car kws) :vc)) + (should (plist-get (nth 1 kws) :url)))) + +(provide 'test-org-drill-config-source) +;;; test-org-drill-config-source.el ends here diff --git a/tests/test-org-reveal-config-keymap.el b/tests/test-org-reveal-config-keymap.el new file mode 100644 index 00000000..17a21b19 --- /dev/null +++ b/tests/test-org-reveal-config-keymap.el @@ -0,0 +1,38 @@ +;;; test-org-reveal-config-keymap.el --- Tests for org-reveal-config prefix keymap -*- lexical-binding: t; -*- + +;;; Commentary: +;; The presentation commands are reached through `cj/reveal-map', a prefix +;; keymap registered under "C-; p" via `cj/register-prefix-map'. These +;; tests pin that structure so the module can't silently regress to raw +;; `global-set-key' calls (which carry a hidden load-order dependency on +;; keybindings.el establishing "C-;" as a prefix first). + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'keybindings) +(require 'org-reveal-config) + +(ert-deftest test-org-reveal-config-reveal-map-is-a-keymap () + "Normal: `cj/reveal-map' is a keymap." + (should (keymapp cj/reveal-map))) + +(ert-deftest test-org-reveal-config-reveal-map-bindings () + "Normal: each presentation command is reachable under `cj/reveal-map'." + (dolist (pair '(("SPC" . cj/reveal-present) + ("e" . cj/reveal-export) + ("p" . cj/reveal-preview-start) + ("s" . cj/reveal-preview-stop) + ("h" . cj/reveal-insert-header) + ("H" . cj/reveal-remove-headers) + ("n" . cj/reveal-new))) + (should (eq (keymap-lookup cj/reveal-map (car pair)) (cdr pair))))) + +(ert-deftest test-org-reveal-config-reveal-map-registered-under-p () + "Normal: `cj/reveal-map' is registered under \"p\" in `cj/custom-keymap'." + (should (eq (keymap-lookup cj/custom-keymap "p") cj/reveal-map))) + +(provide 'test-org-reveal-config-keymap) +;;; test-org-reveal-config-keymap.el ends here diff --git a/tests/test-org-roam-config-tag-and-find.el b/tests/test-org-roam-config-tag-and-find.el index f98d8af0..97a7a683 100644 --- a/tests/test-org-roam-config-tag-and-find.el +++ b/tests/test-org-roam-config-tag-and-find.el @@ -147,6 +147,17 @@ ;; The 4th arg is the subdir (should (equal (nth 3 args) "recipes/")))) +(ert-deftest test-org-roam-find-node-project-delegates-to-find-node () + "Normal: `find-node-project' uses Project tag, 'p' key, project.org template." + (let ((args nil)) + (cl-letf (((symbol-function 'cj/org-roam-find-node) + (lambda (&rest a) (setq args a)))) + (cj/org-roam-find-node-project)) + (should (equal (car args) "Project")) + (should (equal (cadr args) "p")) + ;; The 3rd arg is the template file, under the canonical roam-dir/templates/. + (should (string-suffix-p "templates/project.org" (nth 2 args))))) + ;;; cj/org-roam-node-insert-immediate (ert-deftest test-org-roam-node-insert-immediate-rebinds-templates-and-calls-insert () diff --git a/tests/test-show-kill-ring--insert-item.el b/tests/test-show-kill-ring--insert-item.el deleted file mode 100644 index a29ca75e..00000000 --- a/tests/test-show-kill-ring--insert-item.el +++ /dev/null @@ -1,73 +0,0 @@ -;;; test-show-kill-ring--insert-item.el --- Tests for show-kill-insert-item -*- lexical-binding: t -*- - -;;; Commentary: -;; Tests for `show-kill-insert-item' in show-kill-ring.el — inserts a -;; kill-ring entry into the current buffer, truncating to -;; `show-kill-max-item-size' with an ellipsis when too long. The ellipsis -;; sits inline for short items and on its own line for items wider than the -;; frame. Frame width is read at runtime so the test is environment-stable. - -;;; Code: - -(require 'ert) -(require 'show-kill-ring) - -;;; Normal Cases - -(ert-deftest test-show-kill-ring-insert-item-short-verbatim () - "Normal: an item shorter than the max is inserted unchanged." - (let ((show-kill-max-item-size 1000)) - (with-temp-buffer - (show-kill-insert-item "hello") - (should (string= (buffer-string) "hello"))))) - -(ert-deftest test-show-kill-ring-insert-item-inline-ellipsis () - "Normal: an over-max item narrower than the frame gets an inline ellipsis." - (let* ((show-kill-max-item-size 5) - (len (/ (frame-width) 2)) ; > max, < (frame-width - 5) - (item (make-string len ?b))) - (with-temp-buffer - (show-kill-insert-item item) - (should (string= (buffer-string) "bbbbb..."))))) - -;;; Boundary Cases - -(ert-deftest test-show-kill-ring-insert-item-length-equals-max-truncates () - "Boundary: length exactly equal to max truncates — the guard is (< len max)." - (let ((show-kill-max-item-size 5)) - (with-temp-buffer - (show-kill-insert-item "hello") ; length 5, equals max - (should (string= (buffer-string) "hello..."))))) - -(ert-deftest test-show-kill-ring-insert-item-wide-newline-ellipsis () - "Boundary: an item wider than the frame puts the ellipsis on its own line." - (let* ((show-kill-max-item-size 5) - (item (make-string (+ (frame-width) 10) ?a))) - (with-temp-buffer - (show-kill-insert-item item) - (should (string= (buffer-string) "aaaaa\n..."))))) - -(ert-deftest test-show-kill-ring-insert-item-max-nil-verbatim () - "Boundary: a non-numeric max disables truncation." - (let ((show-kill-max-item-size nil)) - (with-temp-buffer - (show-kill-insert-item "anything long enough to exceed nothing") - (should (string= (buffer-string) - "anything long enough to exceed nothing"))))) - -(ert-deftest test-show-kill-ring-insert-item-max-negative-verbatim () - "Boundary: a negative max disables truncation." - (let ((show-kill-max-item-size -1)) - (with-temp-buffer - (show-kill-insert-item "abc") - (should (string= (buffer-string) "abc"))))) - -(ert-deftest test-show-kill-ring-insert-item-empty-string () - "Boundary: an empty item inserts nothing and does not error." - (let ((show-kill-max-item-size 1000)) - (with-temp-buffer - (show-kill-insert-item "") - (should (string= (buffer-string) ""))))) - -(provide 'test-show-kill-ring--insert-item) -;;; test-show-kill-ring--insert-item.el ends here diff --git a/tests/test-text-config.el b/tests/test-text-config.el index 96935e1b..82dfe05e 100644 --- a/tests/test-text-config.el +++ b/tests/test-text-config.el @@ -37,5 +37,18 @@ standard boundary check." (should (eq (cj/prettify-compose-block-markers-p start end "lambda") (prettify-symbols-default-compose-p start end "lambda")))))) +(ert-deftest test-text-config-edit-indirect-bound-on-reachable-key () + "Error/regression: edit-indirect-region is bound on M-I -- the event +Meta+Shift+i actually produces -- not the unreachable M-S-i, which no +keypress generates so it silently fell through to M-i tab-to-tab-stop." + (should (eq (key-binding (kbd "M-I")) #'edit-indirect-region)) + (should-not (eq (key-binding (kbd "M-S-i")) #'edit-indirect-region))) + +(ert-deftest test-text-config-accent-uses-completion-agnostic-backend () + "Regression: C-` invokes accent-menu, which reads through the minibuffer +and so survives a Company->Corfu migration, rather than accent-company, +whose company backend would break silently once Company is gone." + (should (eq (key-binding (kbd "C-`")) #'accent-menu))) + (provide 'test-text-config) ;;; test-text-config.el ends here diff --git a/tests/test-ui-theme-persistence.el b/tests/test-ui-theme-persistence.el index 02bb105a..250b606b 100644 --- a/tests/test-ui-theme-persistence.el +++ b/tests/test-ui-theme-persistence.el @@ -32,6 +32,19 @@ "modus-vivendi"))) (delete-file file)))) +(ert-deftest test-ui-theme-write-file-contents-creates-missing-parent-dir () + "Boundary: writing into a not-yet-existing directory creates it first. +On a fresh machine `persist/' does not exist, and `file-writable-p' returns nil +for a file inside a missing directory, so the write must create the parent." + (let* ((sandbox (make-temp-file "ui-theme-sandbox-" t)) + (file (expand-file-name "persist/emacs-theme" sandbox))) + (unwind-protect + (progn + (should-not (file-directory-p (file-name-directory file))) + (should (cj/theme-write-file-contents "modus-vivendi" file)) + (should (equal (cj/theme-read-file-contents file) "modus-vivendi"))) + (delete-directory sandbox t)))) + (ert-deftest test-ui-theme-write-file-contents-uses-write-region () "Theme persistence should write directly instead of visiting the file." (let ((file (make-temp-file "ui-theme-write-region-")) diff --git a/tests/test-undead-buffers-kill-other-window.el b/tests/test-undead-buffers-kill-other-window.el index e9371a0f..000ada9b 100644 --- a/tests/test-undead-buffers-kill-other-window.el +++ b/tests/test-undead-buffers-kill-other-window.el @@ -66,8 +66,9 @@ ;;; Boundary Cases -(ert-deftest test-kill-other-window-single-window-should-only-kill-buffer () - "With single window, should only kill the current buffer." +(ert-deftest test-kill-other-window-single-window-signals-no-other-window () + "Error: with a single window, signal `user-error' and kill nothing. +There is no other window, so acting would kill the buffer being viewed." (test-kill-other-window-setup) (unwind-protect (let ((buf (generate-new-buffer "*test-single-other*"))) @@ -75,9 +76,9 @@ (progn (switch-to-buffer buf) (should (one-window-p)) - (cj/kill-other-window) + (should-error (cj/kill-other-window) :type 'user-error) (should (one-window-p)) - (should-not (buffer-live-p buf))) + (should (buffer-live-p buf))) (when (buffer-live-p buf) (kill-buffer buf)))) (test-kill-other-window-teardown))) |