diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/ss-capture-tests.el | 176 | ||||
| -rw-r--r-- | tests/ss-crm-tests.el | 92 | ||||
| -rw-r--r-- | tests/ss-org-tests.el | 88 |
3 files changed, 0 insertions, 356 deletions
diff --git a/tests/ss-capture-tests.el b/tests/ss-capture-tests.el deleted file mode 100644 index 006c90d..0000000 --- a/tests/ss-capture-tests.el +++ /dev/null @@ -1,176 +0,0 @@ -;;; ss-capture-tests.el --- Tests for ss-capture -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Focused ERT coverage for journal capture structure helpers. - -;;; Code: - -(add-to-list 'load-path (expand-file-name "../lisp" (file-name-directory load-file-name))) - -(require 'cl-lib) -(require 'ert) -(require 'ss-capture) -(require 'ss-org) - -(ert-deftest ss-jump-back-restores-previous-location-and-enables-forward () - (let ((ss-navigation-back-stack nil) - (ss-navigation-forward-stack nil) - (buffer-a (generate-new-buffer " *ss-nav-a*")) - (buffer-b (generate-new-buffer " *ss-nav-b*"))) - (unwind-protect - (save-window-excursion - (with-current-buffer buffer-a - (insert "alpha") - (goto-char 3)) - (with-current-buffer buffer-b - (insert "bravo") - (goto-char 5)) - (switch-to-buffer buffer-a) - (ss-navigation-push-current-location) - (switch-to-buffer buffer-b) - (should (ss-jump-back)) - (should (eq (current-buffer) buffer-a)) - (should (= (point) 3)) - (should (ss-jump-forward)) - (should (eq (current-buffer) buffer-b)) - (should (= (point) 5))) - (kill-buffer buffer-a) - (kill-buffer buffer-b)))) - -(ert-deftest ss-navigation-push-current-location-clears-forward-after-back () - (let ((ss-navigation-back-stack nil) - (ss-navigation-forward-stack nil) - (buffer-a (generate-new-buffer " *ss-nav-a*")) - (buffer-b (generate-new-buffer " *ss-nav-b*"))) - (unwind-protect - (save-window-excursion - (with-current-buffer buffer-a - (insert "alpha") - (goto-char 2)) - (with-current-buffer buffer-b - (insert "bravo") - (goto-char 4)) - (switch-to-buffer buffer-a) - (ss-navigation-push-current-location) - (switch-to-buffer buffer-b) - (should (ss-jump-back)) - (should ss-navigation-forward-stack) - (ss-navigation-push-current-location) - (should-not ss-navigation-forward-stack)) - (kill-buffer buffer-a) - (kill-buffer buffer-b)))) - -(ert-deftest ss-navigation-record-jump-skips-noop-movements () - (let ((ss-navigation-back-stack nil) - (ss-navigation-forward-stack nil)) - (with-temp-buffer - (switch-to-buffer (current-buffer)) - (insert "alpha") - (goto-char 2) - (ss-navigation--record-jump (lambda () nil)) - (should-not ss-navigation-back-stack) - (should-not ss-navigation-forward-stack)))) - -(ert-deftest ss-journal-ensure-day-sections-adds-all-standard-sections () - (with-temp-buffer - (org-mode) - (insert "#+title: Journal\n" - "#+startup: overview\n\n" - "* 2026\n" - "** 2026-04-08 Wednesday\n" - "*** Tasks\n" - "**** TODO Existing\n\n" - "** 2026-04-09 Thursday\n") - (goto-char (point-min)) - (re-search-forward "^\\*\\* 2026-04-09 Thursday$") - (goto-char (match-beginning 0)) - (ss-journal-ensure-day-sections) - (should (string-match-p - (regexp-quote - "** 2026-04-09 Thursday\n*** Tasks\n*** Notes\n*** Meetings\n") - (buffer-string))))) - -(ert-deftest ss-open-journal-narrows-to-today-when-entry-exists () - (let* ((file (make-temp-file "ss-journal" nil ".org")) - (ss-journal-file file) - (test-time (encode-time 0 0 12 9 4 2026))) - (unwind-protect - (cl-letf (((symbol-function 'current-time) - (lambda () - test-time))) - (with-temp-file file - (insert "#+title: Journal\n" - "* 2026\n" - "** 2026-04-09 Thursday\n" - "*** Notes\n")) - (ss-open-journal) - (should (buffer-narrowed-p)) - (should (equal (org-get-outline-path t) - '("2026" "2026-04-09 Thursday"))) - (should (looking-at-p "^\\*\\* 2026-04-09 Thursday$"))) - (when-let ((buffer (get-file-buffer file))) - (kill-buffer buffer)) - (when (file-exists-p file) - (delete-file file))))) - -(ert-deftest ss-open-journal-reveals-folded-today-subtree () - (let* ((file (make-temp-file "ss-journal" nil ".org")) - (ss-journal-file file) - (test-time (encode-time 0 0 12 9 4 2026))) - (unwind-protect - (cl-letf (((symbol-function 'current-time) - (lambda () - test-time))) - (with-temp-file file - (insert "#+title: Journal\n" - "* 2026\n" - "** 2026-04-09 Thursday\n" - "*** Notes\n" - "Body\n")) - (with-current-buffer (find-file-noselect file) - (org-overview)) - (ss-open-journal) - (should (buffer-narrowed-p)) - (should-not - (save-excursion - (goto-char (point-min)) - (re-search-forward "^\\*\\*\\* Notes$" nil t) - (invisible-p (point)))) - (should-not - (save-excursion - (goto-char (point-min)) - (re-search-forward "^Body$" nil t) - (invisible-p (point))))) - (when-let ((buffer (get-file-buffer file))) - (kill-buffer buffer)) - (when (file-exists-p file) - (delete-file file))))) - -(ert-deftest ss-open-journal-creates-missing-today-entry-with-standard-sections () - (let* ((file (make-temp-file "ss-journal" nil ".org")) - (ss-journal-file file) - (test-time (encode-time 0 0 12 9 4 2026))) - (unwind-protect - (cl-letf (((symbol-function 'current-time) - (lambda () - test-time))) - (with-temp-file file - (insert "#+title: Journal\n" - "* 2026\n" - "** 2026-04-08 Wednesday\n" - "*** Notes\n")) - (ss-open-journal) - (should (buffer-narrowed-p)) - (should (equal (org-get-outline-path t) - '("2026" "2026-04-09 Thursday"))) - (should (string-match-p - (regexp-quote - "** 2026-04-09 Thursday\n*** Tasks\n*** Notes\n*** Meetings\n") - (buffer-string)))) - (when-let ((buffer (get-file-buffer file))) - (kill-buffer buffer)) - (when (file-exists-p file) - (delete-file file))))) - -;;; ss-capture-tests.el ends here diff --git a/tests/ss-crm-tests.el b/tests/ss-crm-tests.el deleted file mode 100644 index bc88ee4..0000000 --- a/tests/ss-crm-tests.el +++ /dev/null @@ -1,92 +0,0 @@ -;;; ss-crm-tests.el --- Tests for ss-crm -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Focused ERT coverage for CRM lookup and prompt helpers. - -;;; Code: - -(add-to-list 'load-path (expand-file-name "../lisp" (file-name-directory load-file-name))) - -(require 'ert) -(require 'cl-lib) -(require 'ss-crm) - -(ert-deftest ss-crm-known-property-values-sorts-and-deduplicates () - (cl-letf (((symbol-function 'ss-crm-entries) - (lambda () - (list (list :role "Engineer") - (list :role " engineer ") - (list :role "Architect") - (list :role "") - (list :role nil))))) - (should (equal (ss-crm-known-property-values "ROLE") - '(" engineer " "Architect" "Engineer"))))) - -(ert-deftest ss-crm-known-person-names-returns-sorted-top-level-names () - (cl-letf (((symbol-function 'ss-crm-entries) - (lambda () - (list (list :name "Zoe") - (list :name "Alice") - (list :name "Bob"))))) - (should (equal (ss-crm-known-person-names) - '("Alice" "Bob" "Zoe"))))) - -(ert-deftest ss-crm-lookup-values-merges-seeded-and-derived-values () - (cl-letf (((symbol-function 'ss-crm-known-property-values) - (lambda (_property) - '("Team B" "Team A")))) - (should (equal (ss-crm-lookup-values "TEAM" '("Team A" "Team C")) - '("Team A" "Team B" "Team C"))))) - -(ert-deftest ss-crm-read-choice-returns-nil-for-none-selection () - (cl-letf (((symbol-function 'completing-read) - (lambda (&rest _args) - "[none]"))) - (should-not (ss-crm-read-choice "Role: " '("Engineer") - :allow-blank t - :allow-new t)))) - -(ert-deftest ss-crm-read-choice-warns-on-new-case-insensitive-duplicate () - (let (warning) - (cl-letf (((symbol-function 'completing-read) - (lambda (&rest _args) - "sydney")) - ((symbol-function 'yes-or-no-p) - (lambda (&rest _args) - t)) - ((symbol-function 'display-warning) - (lambda (_type message &rest _args) - (setq warning message)))) - (should (equal (ss-crm-read-choice "Location: " '("Sydney") - :allow-blank t - :allow-new t) - "sydney")) - (should (string-match-p "Sydney" warning))))) - -(ert-deftest ss-crm-read-choice-does-not-warn-for-existing-selection () - (let (warning) - (cl-letf (((symbol-function 'completing-read) - (lambda (&rest _args) - "Sydney")) - ((symbol-function 'display-warning) - (lambda (_type message &rest _args) - (setq warning message)))) - (should (equal (ss-crm-read-choice "Location: " '("Sydney" "sydney") - :allow-blank t - :allow-new t - :require-match t) - "Sydney")) - (should-not warning)))) - -(ert-deftest ss-crm-read-manager-uses-known-person-names () - (cl-letf (((symbol-function 'ss-crm-known-person-names) - (lambda () - '("Alice" "Bob"))) - ((symbol-function 'ss-crm-read-choice) - (lambda (_prompt choices &rest _plist) - choices))) - (should (equal (ss-crm-read-manager) - '("Alice" "Bob"))))) - -;;; ss-crm-tests.el ends here diff --git a/tests/ss-org-tests.el b/tests/ss-org-tests.el deleted file mode 100644 index b8e1eb5..0000000 --- a/tests/ss-org-tests.el +++ /dev/null @@ -1,88 +0,0 @@ -;;; ss-org-tests.el --- Tests for ss-org -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Focused ERT coverage for Org refile configuration. - -;;; Code: - -(add-to-list 'load-path (expand-file-name "../lisp" (file-name-directory load-file-name))) - -(require 'ert) -(require 'cl-lib) -(require 'org) -(require 'ss-org) - -(ert-deftest ss-org-configure-refile-sets-org-variables () - (let ((old-refile-targets (and (boundp 'org-refile-targets) - org-refile-targets)) - (old-refile-use-outline-path (and (boundp 'org-refile-use-outline-path) - org-refile-use-outline-path)) - (old-outline-path-complete-in-steps - (and (boundp 'org-outline-path-complete-in-steps) - org-outline-path-complete-in-steps))) - (unwind-protect - (progn - (advice-remove 'org-refile #'ss-org-refresh-agenda-files-for-refile) - (setq org-refile-targets nil - org-refile-use-outline-path nil - org-outline-path-complete-in-steps t) - (ss-org-configure-refile) - (should (equal org-refile-targets - '((org-agenda-files :regexp . "^\\*+ ")))) - (should (eq org-refile-use-outline-path 'file)) - (should-not org-outline-path-complete-in-steps)) - (setq org-refile-targets old-refile-targets - org-refile-use-outline-path old-refile-use-outline-path - org-outline-path-complete-in-steps - old-outline-path-complete-in-steps) - (advice-remove 'org-refile #'ss-org-refresh-agenda-files-for-refile)))) - -(ert-deftest ss-org-configure-refile-discovers-headings-in-agenda-files () - (let* ((file (make-temp-file "ss-org-refile-" nil ".org" - "* Alpha\n** Beta\n")) - (file-name (file-name-nondirectory file)) - (org-agenda-files (list file)) - (old-refile-targets (and (boundp 'org-refile-targets) - org-refile-targets)) - (old-refile-use-outline-path (and (boundp 'org-refile-use-outline-path) - org-refile-use-outline-path)) - (old-outline-path-complete-in-steps - (and (boundp 'org-outline-path-complete-in-steps) - org-outline-path-complete-in-steps)) - targets) - (unwind-protect - (progn - (advice-remove 'org-refile #'ss-org-refresh-agenda-files-for-refile) - (ss-org-configure-refile) - (with-current-buffer (find-file-noselect file) - (setq targets (org-refile-get-targets))) - (should (assoc (format "%s/Alpha" file-name) targets)) - (should (assoc (format "%s/Alpha/Beta" file-name) targets))) - (setq org-refile-targets old-refile-targets - org-refile-use-outline-path old-refile-use-outline-path - org-outline-path-complete-in-steps - old-outline-path-complete-in-steps) - (advice-remove 'org-refile #'ss-org-refresh-agenda-files-for-refile) - (when-let ((buffer (get-file-buffer file))) - (kill-buffer buffer)) - (delete-file file)))) - -(ert-deftest ss-org-configure-refile-adds-refresh-advice () - (unwind-protect - (progn - (advice-remove 'org-refile #'ss-org-refresh-agenda-files-for-refile) - (ss-org-configure-refile) - (should (advice-member-p #'ss-org-refresh-agenda-files-for-refile - 'org-refile))) - (advice-remove 'org-refile #'ss-org-refresh-agenda-files-for-refile))) - -(ert-deftest ss-org-refresh-agenda-files-for-refile-reuses-agenda-helper () - (let (called) - (cl-letf (((symbol-function 'ss-refresh-org-agenda-files) - (lambda (&rest _args) - (setq called t)))) - (ss-org-refresh-agenda-files-for-refile) - (should called)))) - -;;; ss-org-tests.el ends here
\ No newline at end of file |