diff options
Diffstat (limited to 'tests')
22 files changed, 1715 insertions, 105 deletions
diff --git a/tests/test-wttrin--add-buffer-instructions.el b/tests/test-wttrin--add-buffer-instructions.el index 4949c45..fdd7c91 100644 --- a/tests/test-wttrin--add-buffer-instructions.el +++ b/tests/test-wttrin--add-buffer-instructions.el @@ -14,6 +14,17 @@ ;;; Setup and Teardown +(defun test-wttrin--expected-footer () + "Return the footer string `wttrin--add-buffer-instructions' should produce. +Width 23 is pinned here as a literal, independent of the production +constant, so the test fails if the visible layout drifts." + (concat "\n\n" + (format "%-23s%s" "This view" "Saved locations") "\n" + (format "%-23s%s" "[a] another" "[s] save") "\n" + (format "%-23s%s" "[g] refresh" "[d] make default") "\n" + (format "%-23s%s" "[q] quit" "[r] rename") "\n" + (format "%-23s%s" "" "[x] remove"))) + (defun test-wttrin--add-buffer-instructions-setup () "Setup for add-buffer-instructions tests." (testutil-wttrin-setup)) @@ -28,7 +39,7 @@ "Test adding instructions to empty buffer." (with-temp-buffer (wttrin--add-buffer-instructions) - (should (string= "\n\nPress: [a] for another location [g] to refresh [q] to quit" + (should (string= (test-wttrin--expected-footer) (buffer-string))))) (ert-deftest test-wttrin--add-buffer-instructions-normal-with-existing-content-appends-instructions () @@ -36,7 +47,8 @@ (with-temp-buffer (insert "Weather: Sunny\nTemperature: 20°C") (wttrin--add-buffer-instructions) - (should (string= "Weather: Sunny\nTemperature: 20°C\n\nPress: [a] for another location [g] to refresh [q] to quit" + (should (string= (concat "Weather: Sunny\nTemperature: 20°C" + (test-wttrin--expected-footer)) (buffer-string))))) (ert-deftest test-wttrin--add-buffer-instructions-normal-preserves-point-moves-to-end () @@ -56,12 +68,12 @@ (wttrin--add-buffer-instructions) ;; Should add instructions again, not check if they already exist (should-not (string= first-result (buffer-string))) - ;; Check for two occurrences of "Press:" by counting matches + ;; Check for two occurrences of the header by counting matches (let ((count 0)) (with-temp-buffer (insert first-result) (goto-char (point-min)) - (while (search-forward "Press:" nil t) + (while (search-forward "This view" nil t) (setq count (1+ count)))) ;; After first call, should have 1 occurrence (should (= 1 count))) @@ -69,10 +81,28 @@ (let ((count 0)) (save-excursion (goto-char (point-min)) - (while (search-forward "Press:" nil t) + (while (search-forward "This view" nil t) (setq count (1+ count)))) (should (= 2 count)))))) +(ert-deftest test-wttrin--add-buffer-instructions-normal-key-chords-carry-key-face () + "Bracketed key chords are styled with `wttrin-key'." + (with-temp-buffer + (wttrin--add-buffer-instructions) + (goto-char (point-min)) + (search-forward "[a]") + ;; point is just after the closing bracket; the bracket char is part + ;; of the "[a]" segment + (should (eq (get-text-property (1- (point)) 'face) 'wttrin-key)))) + +(ert-deftest test-wttrin--add-buffer-instructions-normal-prose-carries-instructions-face () + "The footer prose is styled with `wttrin-instructions'." + (with-temp-buffer + (wttrin--add-buffer-instructions) + (goto-char (point-min)) + (search-forward "another") + (should (eq (get-text-property (1- (point)) 'face) 'wttrin-instructions)))) + ;;; Boundary Cases (ert-deftest test-wttrin--add-buffer-instructions-boundary-point-at-beginning-appends-at-end () @@ -81,7 +111,7 @@ (insert "Weather data here") (goto-char (point-min)) (wttrin--add-buffer-instructions) - (should (string-suffix-p "Press: [a] for another location [g] to refresh [q] to quit" + (should (string-suffix-p "[x] remove" (buffer-string))))) (ert-deftest test-wttrin--add-buffer-instructions-boundary-point-in-middle-appends-at-end () @@ -91,7 +121,7 @@ (goto-char (point-min)) (forward-line 1) (wttrin--add-buffer-instructions) - (should (string-suffix-p "Press: [a] for another location [g] to refresh [q] to quit" + (should (string-suffix-p "[x] remove" (buffer-string))))) (ert-deftest test-wttrin--add-buffer-instructions-boundary-trailing-newlines-preserves-newlines () @@ -99,7 +129,7 @@ (with-temp-buffer (insert "Weather\n\n\n") (wttrin--add-buffer-instructions) - (should (string= "Weather\n\n\n\n\nPress: [a] for another location [g] to refresh [q] to quit" + (should (string= (concat "Weather\n\n\n" (test-wttrin--expected-footer)) (buffer-string))))) (ert-deftest test-wttrin--add-buffer-instructions-boundary-very-large-buffer-appends-at-end () @@ -108,7 +138,7 @@ (insert (make-string 10000 ?x)) (wttrin--add-buffer-instructions) (goto-char (point-max)) - (should (looking-back "Press: \\[a\\] for another location \\[g\\] to refresh \\[q\\] to quit" nil)))) + (should (looking-back "\\[x\\] remove" nil)))) ;;; Error Cases @@ -134,7 +164,7 @@ (widen) (goto-char start) (forward-line 1) - (should (looking-at-p "\n\nPress:"))))) + (should (looking-at-p "\n\nThis view"))))) (provide 'test-wttrin--add-buffer-instructions) ;;; test-wttrin--add-buffer-instructions.el ends here diff --git a/tests/test-wttrin--display-weather.el b/tests/test-wttrin--display-weather.el index bca6a6c..99ea067 100644 --- a/tests/test-wttrin--display-weather.el +++ b/tests/test-wttrin--display-weather.el @@ -97,13 +97,14 @@ Weather report: Paris, France (wttrin--display-weather "Tokyo" test-wttrin--display-weather-sample-raw-data) (with-current-buffer "*wttr.in*" - (goto-char (point-max)) - (forward-line -2) - ;; Should contain help text - (should (search-forward "Press:" nil t)) - (should (search-forward "[a] for another location" nil t)) - (should (search-forward "[g] to refresh" nil t)) - (should (search-forward "[q] to quit" nil t)))) + ;; The two-column footer carries both groups; check a token from + ;; each column independently (document order mixes them). + (let ((text (buffer-string))) + (should (string-match-p "This view" text)) + (should (string-match-p "Saved locations" text)) + (should (string-match-p "\\[a\\] another" text)) + (should (string-match-p "\\[s\\] save" text)) + (should (string-match-p "\\[x\\] remove" text))))) (test-wttrin--display-weather-teardown))) ;;; Boundary Cases @@ -159,11 +160,8 @@ Empty string does not match ERROR pattern, so it's processed as data." (test-wttrin--display-weather-setup) (unwind-protect (progn - (let ((message-log-max t) - (message-displayed nil)) - (cl-letf (((symbol-function 'message) - (lambda (format-string &rest args) - (setq message-displayed (apply #'format format-string args))))) + (let ((message-log-max t)) + (testutil-wttrin-with-captured-message message-displayed (wttrin--display-weather "InvalidCity" nil) ;; Should display error message @@ -176,11 +174,8 @@ Empty string does not match ERROR pattern, so it's processed as data." (test-wttrin--display-weather-setup) (unwind-protect (progn - (let ((message-log-max t) - (message-displayed nil)) - (cl-letf (((symbol-function 'message) - (lambda (format-string &rest args) - (setq message-displayed (apply #'format format-string args))))) + (let ((message-log-max t)) + (testutil-wttrin-with-captured-message message-displayed (wttrin--display-weather "BadLocation" testutil-wttrin-sample-error-response) ;; Should display error message diff --git a/tests/test-wttrin--format-location-line.el b/tests/test-wttrin--format-location-line.el new file mode 100644 index 0000000..28a9af8 --- /dev/null +++ b/tests/test-wttrin--format-location-line.el @@ -0,0 +1,35 @@ +;;; test-wttrin--format-location-line.el --- Tests for the buffer Location line -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for `wttrin--format-location-line', the "Location: ADDRESS" line +;; shown in the weather buffer when a geolocation command supplies an address. + +;;; Code: + +(require 'ert) +(require 'wttrin) + +(ert-deftest test-wttrin--format-location-line-normal-builds-line () + "Normal: a non-empty address becomes a \"Location: ...\" line." + (let ((line (wttrin--format-location-line "Westerly, Rhode Island, USA"))) + (should (stringp line)) + (should (string-prefix-p "Location: Westerly, Rhode Island, USA" line)))) + +(ert-deftest test-wttrin--format-location-line-normal-uses-face () + "Normal: the line carries the staleness-header face." + (let ((line (wttrin--format-location-line "Westerly, RI"))) + (should (eq 'wttrin-staleness-header + (get-text-property 0 'face line))))) + +(ert-deftest test-wttrin--format-location-line-boundary-nil-returns-nil () + "Boundary: a nil address yields no line." + (should (null (wttrin--format-location-line nil)))) + +(ert-deftest test-wttrin--format-location-line-boundary-empty-returns-nil () + "Boundary: an empty address yields no line." + (should (null (wttrin--format-location-line "")))) + +(provide 'test-wttrin--format-location-line) +;;; test-wttrin--format-location-line.el ends here diff --git a/tests/test-wttrin--format-staleness-header.el b/tests/test-wttrin--format-staleness-header.el index 5658be0..7a39b9a 100644 --- a/tests/test-wttrin--format-staleness-header.el +++ b/tests/test-wttrin--format-staleness-header.el @@ -50,6 +50,18 @@ (should (string-match-p "just now" header))))) (test-wttrin--format-staleness-header-teardown))) +(ert-deftest test-wttrin--format-staleness-header-normal-carries-face () + "The returned header string is styled with `wttrin-staleness-header'." + (test-wttrin--format-staleness-header-setup) + (unwind-protect + (let ((now 1000000.0)) + (cl-letf (((symbol-function 'float-time) (lambda () now))) + (testutil-wttrin-add-to-cache "Paris" "weather data" 300) + (let ((header (wttrin--format-staleness-header "Paris"))) + (should (eq (get-text-property 0 'face header) + 'wttrin-staleness-header))))) + (test-wttrin--format-staleness-header-teardown))) + ;;; Boundary Cases (ert-deftest test-wttrin--format-staleness-header-boundary-no-cache-returns-nil () diff --git a/tests/test-wttrin--handle-fetch-callback.el b/tests/test-wttrin--handle-fetch-callback.el index d4158ac..e50c61d 100644 --- a/tests/test-wttrin--handle-fetch-callback.el +++ b/tests/test-wttrin--handle-fetch-callback.el @@ -226,12 +226,9 @@ (ert-deftest test-wttrin--handle-fetch-callback-error-network-shows-message () "Network errors should show a specific message in the echo area, not leave the user guessing." - (let ((displayed-message nil)) + (testutil-wttrin-with-captured-message displayed-message (cl-letf (((symbol-function 'wttrin--extract-response-body) - (lambda () nil)) - ((symbol-function 'message) - (lambda (fmt &rest args) - (setq displayed-message (apply #'format fmt args))))) + (lambda () nil))) (wttrin--handle-fetch-callback '(:error (error "Network unreachable")) #'ignore) @@ -240,14 +237,11 @@ not leave the user guessing." (ert-deftest test-wttrin--handle-fetch-callback-error-http-404-shows-message () "HTTP 404 should tell the user the location wasn't found." - (let ((displayed-message nil)) + (testutil-wttrin-with-captured-message displayed-message (cl-letf (((symbol-function 'wttrin--extract-response-body) (lambda () nil)) ((symbol-function 'wttrin--extract-http-status) - (lambda () 404)) - ((symbol-function 'message) - (lambda (fmt &rest args) - (setq displayed-message (apply #'format fmt args))))) + (lambda () 404))) ;; No :error in status — url-retrieve succeeded but server returned 404 (wttrin--handle-fetch-callback nil #'ignore) (should displayed-message) @@ -255,14 +249,11 @@ not leave the user guessing." (ert-deftest test-wttrin--handle-fetch-callback-error-http-500-shows-message () "HTTP 500 should tell the user the weather service had an error." - (let ((displayed-message nil)) + (testutil-wttrin-with-captured-message displayed-message (cl-letf (((symbol-function 'wttrin--extract-response-body) (lambda () nil)) ((symbol-function 'wttrin--extract-http-status) - (lambda () 500)) - ((symbol-function 'message) - (lambda (fmt &rest args) - (setq displayed-message (apply #'format fmt args))))) + (lambda () 500))) (wttrin--handle-fetch-callback nil #'ignore) (should displayed-message) (should (string-match-p "service\\|server\\|500" (downcase displayed-message)))))) diff --git a/tests/test-wttrin--mode-line-helpers.el b/tests/test-wttrin--mode-line-helpers.el index 408711b..21ac167 100644 --- a/tests/test-wttrin--mode-line-helpers.el +++ b/tests/test-wttrin--mode-line-helpers.el @@ -46,40 +46,40 @@ (should (equal (plist-get face :family) "Noto Color Emoji")) (should (equal (plist-get face :height) 1.0)))))) -(ert-deftest test-wttrin--make-emoji-icon-normal-with-foreground () - "Foreground color should be applied when specified." +(ert-deftest test-wttrin--make-emoji-icon-normal-with-face () + "A face should be applied via :inherit when specified." (let ((wttrin-mode-line-emoji-font nil)) - (let ((result (wttrin--make-emoji-icon "☀" "gray60"))) + (let ((result (wttrin--make-emoji-icon "☀" 'wttrin-mode-line-stale))) (let ((face (get-text-property 0 'face result))) - (should (equal (plist-get face :foreground) "gray60")))))) + (should (eq (plist-get face :inherit) 'wttrin-mode-line-stale)))))) -(ert-deftest test-wttrin--make-emoji-icon-normal-with-font-and-foreground () - "Both font and foreground should be applied together." +(ert-deftest test-wttrin--make-emoji-icon-normal-with-font-and-face () + "Both font and face should be applied together." (let ((wttrin-mode-line-emoji-font "Noto Color Emoji")) - (let ((result (wttrin--make-emoji-icon "⏳" "gray60"))) + (let ((result (wttrin--make-emoji-icon "⏳" 'wttrin-mode-line-stale))) (let ((face (get-text-property 0 'face result))) (should (equal (plist-get face :family) "Noto Color Emoji")) - (should (equal (plist-get face :foreground) "gray60")))))) + (should (eq (plist-get face :inherit) 'wttrin-mode-line-stale)))))) ;;; Boundary Cases -(ert-deftest test-wttrin--make-emoji-icon-boundary-nil-foreground-no-color () - "Nil foreground should not add any :foreground property when no font." +(ert-deftest test-wttrin--make-emoji-icon-boundary-nil-face-no-font () + "Nil face with no font should return a plain string." (let ((wttrin-mode-line-emoji-font nil)) (let ((result (wttrin--make-emoji-icon "☀" nil))) - ;; Without font or foreground, should be plain string + ;; Without font or face, should be plain string (should (equal result "☀"))))) -(ert-deftest test-wttrin--make-emoji-icon-boundary-nil-foreground-with-font () - "With font set and nil foreground, the face plist must omit :foreground entirely. -A literal `:foreground nil' entry triggers \"Invalid face attribute\" warnings on +(ert-deftest test-wttrin--make-emoji-icon-boundary-nil-face-with-font () + "With font set and nil face, the face plist must omit :inherit entirely. +A literal `:inherit nil' entry triggers \"Invalid face attribute\" warnings on every redisplay. `plist-member' (not `plist-get') is required: `plist-get' can't distinguish a missing key from a present key bound to nil." (let ((wttrin-mode-line-emoji-font "Noto Color Emoji")) (let* ((result (wttrin--make-emoji-icon "☀" nil)) (face (get-text-property 0 'face result))) (should (equal (plist-get face :family) "Noto Color Emoji")) - (should-not (plist-member face :foreground))))) + (should-not (plist-member face :inherit))))) ;;; -------------------------------------------------------------------------- ;;; wttrin--set-mode-line-string diff --git a/tests/test-wttrin--mode-line-update-display.el b/tests/test-wttrin--mode-line-update-display.el index 0635b5f..be066e7 100644 --- a/tests/test-wttrin--mode-line-update-display.el +++ b/tests/test-wttrin--mode-line-update-display.el @@ -170,7 +170,7 @@ (test-wttrin--mode-line-update-display-teardown))) (ert-deftest test-wttrin--mode-line-update-display-stale-emoji-dimmed () - "Stale data dims the emoji with gray foreground." + "Stale data dims the emoji via the `wttrin-mode-line-stale' face." (test-wttrin--mode-line-update-display-setup) (unwind-protect (let ((wttrin-mode-line-refresh-interval 900) @@ -178,13 +178,13 @@ (cl-letf (((symbol-function 'float-time) (lambda () 3000.0))) (setq wttrin--mode-line-cache (cons 1000.0 "Paris: X +61°F Clear")) (wttrin--mode-line-update-display) - ;; The emoji character should have a gray face + ;; The emoji character should inherit the stale face (let* ((str wttrin-mode-line-string) ;; Find the emoji position (after the space) (emoji-pos 1) (face (get-text-property emoji-pos 'face str))) (should face) - (should (equal (plist-get face :foreground) "gray60"))))) + (should (eq (plist-get face :inherit) 'wttrin-mode-line-stale))))) (test-wttrin--mode-line-update-display-teardown))) ;;; Boundary Cases @@ -223,7 +223,7 @@ trigger an emoji re-render so dimming matches the tooltip's staleness state." (wttrin--mode-line-update-display) ;; Emoji should NOT be dimmed (let ((face (get-text-property 1 'face wttrin-mode-line-string))) - (should-not (and face (equal (plist-get face :foreground) "gray60"))))) + (should-not (and face (eq (plist-get face :inherit) 'wttrin-mode-line-stale))))) ;; Time passes: data is now stale (age=2001, threshold=1800) ;; Invoke the tooltip (simulating a hover) — this should trigger a re-render @@ -233,7 +233,7 @@ trigger an emoji re-render so dimming matches the tooltip's staleness state." ;; After hover detected staleness transition, emoji should now be dimmed (let ((face (get-text-property 1 'face wttrin-mode-line-string))) (should face) - (should (equal (plist-get face :foreground) "gray60"))))) + (should (eq (plist-get face :inherit) 'wttrin-mode-line-stale))))) (test-wttrin--mode-line-update-display-teardown))) ;;; -------------------------------------------------------------------------- @@ -252,6 +252,30 @@ trigger an emoji re-render so dimming matches the tooltip's staleness state." (should wttrin-mode-line-string))) (test-wttrin--mode-line-update-display-teardown))) +(ert-deftest test-wttrin--mode-line-fetch-weather-normal-saved-name-shown-in-cache () + "Normal: a saved-name favorite caches its display name, not the resolved query. +The query (coordinates or an address) drives the fetch, but the hover tooltip +should read the friendly name the user gave the place." + (test-wttrin--mode-line-update-display-setup) + (unwind-protect + (let ((wttrin-saved-locations '(("Mom's House" . "40.71,-74.01"))) + (wttrin-favorite-location "Mom's House")) + (testutil-wttrin-mock-http-response "40.71,-74.01: ☀️ +70°F Cloudy" + (wttrin--mode-line-fetch-weather) + (should (string-prefix-p "Mom's House:" (cdr wttrin--mode-line-cache))))) + (test-wttrin--mode-line-update-display-teardown))) + +(ert-deftest test-wttrin--mode-line-fetch-weather-boundary-plain-location-unchanged () + "Boundary: a plain (non-saved) favorite still caches its own name as the prefix." + (test-wttrin--mode-line-update-display-setup) + (unwind-protect + (let ((wttrin-saved-locations nil) + (wttrin-favorite-location "Paris")) + (testutil-wttrin-mock-http-response "Paris: ☀️ +61°F Clear" + (wttrin--mode-line-fetch-weather) + (should (string-prefix-p "Paris:" (cdr wttrin--mode-line-cache))))) + (test-wttrin--mode-line-update-display-teardown))) + (ert-deftest test-wttrin--mode-line-fetch-weather-error-empty-response-keeps-previous () "Empty API response does not overwrite previous valid cache." (test-wttrin--mode-line-update-display-setup) diff --git a/tests/test-wttrin-clear-cache.el b/tests/test-wttrin-clear-cache.el index 8185c5f..784be4c 100644 --- a/tests/test-wttrin-clear-cache.el +++ b/tests/test-wttrin-clear-cache.el @@ -43,13 +43,10 @@ "User should be told the cache was cleared." (test-wttrin-clear-cache-setup) (unwind-protect - (let ((displayed-message nil)) - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) - (setq displayed-message (apply #'format fmt args))))) - (wttrin-clear-cache) - (should displayed-message) - (should (string-match-p "cache cleared" displayed-message)))) + (testutil-wttrin-with-captured-message displayed-message + (wttrin-clear-cache) + (should displayed-message) + (should (string-match-p "cache cleared" displayed-message))) (test-wttrin-clear-cache-teardown))) ;;; Boundary Cases diff --git a/tests/test-wttrin-error-types.el b/tests/test-wttrin-error-types.el new file mode 100644 index 0000000..dd3df2d --- /dev/null +++ b/tests/test-wttrin-error-types.el @@ -0,0 +1,128 @@ +;;; test-wttrin-error-types.el --- Tests for wttrin's typed error hierarchy -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the define-error hierarchy (wttrin-error and children), +;; the wttrin--error-message constructor, the wttrin-error-type accessor, +;; and the error-class tagging of the async fetch callback's error-msg. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) +(require 'testutil-wttrin) + +;;; Setup and Teardown + +(defun test-wttrin-error-types-setup () + "Setup for error-type tests." + (testutil-wttrin-setup)) + +(defun test-wttrin-error-types-teardown () + "Teardown for error-type tests." + (testutil-wttrin-teardown)) + +;;; Hierarchy + +(ert-deftest test-wttrin-error-types-normal-parent-inherits-error () + "wttrin-error is a child of the built-in error condition." + (should (memq 'error (get 'wttrin-error 'error-conditions))) + (should (memq 'wttrin-error (get 'wttrin-error 'error-conditions)))) + +(ert-deftest test-wttrin-error-types-normal-children-inherit-parent-and-error () + "Each child condition inherits both wttrin-error and error." + (dolist (child '(wttrin-invalid-input + wttrin-network-error + wttrin-not-found-error + wttrin-service-error + wttrin-parse-error)) + (let ((conds (get child 'error-conditions))) + (should (memq child conds)) + (should (memq 'wttrin-error conds)) + (should (memq 'error conds))))) + +;;; wttrin--error-message constructor + +(ert-deftest test-wttrin-error-types-normal-error-message-carries-type-property () + "wttrin--error-message returns the formatted string tagged with its type." + (let ((msg (wttrin--error-message 'wttrin-network-error "Network error"))) + (should (string= "Network error" msg)) + (should (eq 'wttrin-network-error (get-text-property 0 'wttrin-error-type msg))))) + +(ert-deftest test-wttrin-error-types-normal-error-message-formats-arguments () + "wttrin--error-message applies format arguments like `format'." + (let ((msg (wttrin--error-message 'wttrin-not-found-error + "Location not found (HTTP %d)" 404))) + (should (string= "Location not found (HTTP 404)" msg)) + (should (eq 'wttrin-not-found-error (wttrin-error-message-type msg))))) + +;;; wttrin-error-type accessor + +(ert-deftest test-wttrin-error-types-normal-error-type-reads-tag () + "wttrin-error-type returns the class symbol from a tagged message." + (let ((msg (wttrin--error-message 'wttrin-service-error "boom"))) + (should (eq 'wttrin-service-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-boundary-error-type-plain-string-is-nil () + "An untagged string has no error type." + (should (null (wttrin-error-message-type "just a string")))) + +(ert-deftest test-wttrin-error-types-boundary-error-type-nil-is-nil () + "nil has no error type." + (should (null (wttrin-error-message-type nil)))) + +(ert-deftest test-wttrin-error-types-boundary-error-type-empty-string-is-nil () + "An empty string has no error type." + (should (null (wttrin-error-message-type "")))) + +;;; Synchronous signal site + +(ert-deftest test-wttrin-error-types-error-build-url-nil-signals-invalid-input () + "A nil query signals the specific wttrin-invalid-input condition." + (should-error (wttrin--build-url nil) :type 'wttrin-invalid-input) + (should-error (wttrin--build-url nil) :type 'wttrin-error)) + +;;; Async classification — error-msg handed to the callback carries the class + +(defun test-wttrin-error-types--capture-error-msg (status &optional status-code) + "Run the fetch callback with STATUS, return the error-msg it receives. +STATUS-CODE, when non-nil, is the HTTP status the buffer reports." + (let ((captured 'unset)) + (cl-letf (((symbol-function 'wttrin--extract-response-body) (lambda () nil)) + ((symbol-function 'wttrin--extract-http-status) (lambda () status-code)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin--handle-fetch-callback + status + (lambda (_data &optional error-msg) (setq captured error-msg)))) + captured)) + +(ert-deftest test-wttrin-error-types-error-network-failure-tagged-network () + "A network-level failure tags the error-msg as wttrin-network-error." + (let ((msg (test-wttrin-error-types--capture-error-msg + '(:error (error "Network unreachable"))))) + (should (eq 'wttrin-network-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-error-http-404-tagged-not-found () + "An HTTP 4xx tags the error-msg as wttrin-not-found-error." + (let ((msg (test-wttrin-error-types--capture-error-msg nil 404))) + (should (eq 'wttrin-not-found-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-error-http-500-tagged-service () + "An HTTP 5xx tags the error-msg as wttrin-service-error." + (let ((msg (test-wttrin-error-types--capture-error-msg nil 500))) + (should (eq 'wttrin-service-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-error-2xx-empty-body-tagged-parse () + "A 2xx response with no usable body tags the error-msg as wttrin-parse-error." + (let ((msg (test-wttrin-error-types--capture-error-msg nil 200))) + (should (eq 'wttrin-parse-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-error-missing-status-tagged-parse () + "An unreadable response (no status, no body) tags the error-msg as wttrin-parse-error." + (let ((msg (test-wttrin-error-types--capture-error-msg nil nil))) + (should (eq 'wttrin-parse-error (wttrin-error-message-type msg))))) + +(provide 'test-wttrin-error-types) +;;; test-wttrin-error-types.el ends here diff --git a/tests/test-wttrin-faces.el b/tests/test-wttrin-faces.el new file mode 100644 index 0000000..db30002 --- /dev/null +++ b/tests/test-wttrin-faces.el @@ -0,0 +1,26 @@ +;;; test-wttrin-faces.el --- Tests for wttrin themeable faces -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;;; Commentary: + +;; Unit tests verifying the package's customizable faces are defined so +;; themes and `customize-face' can target them. + +;;; Code: + +(require 'ert) +(require 'wttrin) + +;;; Normal Cases + +(ert-deftest test-wttrin-faces-normal-all-defined () + "Normal: every package face is defined after loading wttrin." + (dolist (face '(wttrin-mode-line-stale + wttrin-staleness-header + wttrin-instructions + wttrin-key)) + (should (facep face)))) + +(provide 'test-wttrin-faces) +;;; test-wttrin-faces.el ends here diff --git a/tests/test-wttrin-geolocation--internals.el b/tests/test-wttrin-geolocation--internals.el index 6ad8384..dfc483d 100644 --- a/tests/test-wttrin-geolocation--internals.el +++ b/tests/test-wttrin-geolocation--internals.el @@ -128,9 +128,11 @@ ;;; Error Cases (ert-deftest test-wttrin-geolocation--lookup-provider-error-unknown-symbol () - "Unknown provider symbol signals error." + "Unknown provider symbol signals the typed wttrin-invalid-input condition." (should-error (wttrin-geolocation--lookup-provider 'definitely-not-registered) - :type 'error)) + :type 'wttrin-invalid-input) + (should-error (wttrin-geolocation--lookup-provider 'definitely-not-registered) + :type 'wttrin-error)) ;;; -------------------------------------------------------------------------- ;;; wttrin-geolocation--extract-body diff --git a/tests/test-wttrin-geolocation-command.el b/tests/test-wttrin-geolocation-command.el new file mode 100644 index 0000000..40ea278 --- /dev/null +++ b/tests/test-wttrin-geolocation-command.el @@ -0,0 +1,161 @@ +;;; test-wttrin-geolocation-command.el --- Tests for the external-command geolocation provider -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the generic external-command geolocation provider: +;; `wttrin-geolocation--parse-coordinates' (pure JSON -> "LAT,LNG"), the +;; routing/fallback in `wttrin-geolocation-detect' when +;; `wttrin-geolocation-command' is set, and an end-to-end run of +;; `wttrin-geolocation--detect-via-command' against a real shell command. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) +(require 'wttrin-geolocation) + +;;; wttrin-geolocation--parse-coordinates + +(ert-deftest test-wttrin-geolocation-command-normal-parse-coordinates () + "Normal: numeric lat/lng become a \"LAT,LNG\" string." + (should (equal "41.32,-71.81" + (wttrin-geolocation--parse-coordinates + "{\"lat\": 41.32, \"lng\": -71.81}")))) + +(ert-deftest test-wttrin-geolocation-command-boundary-parse-ignores-extra-keys () + "Boundary: extra keys (accuracy, address) are ignored." + (should (equal "1.5,2.5" + (wttrin-geolocation--parse-coordinates + "{\"lat\":1.5,\"lng\":2.5,\"accuracy_m\":11.5,\"address\":\"x\"}")))) + +(ert-deftest test-wttrin-geolocation-command-error-parse-malformed-json () + "Error: malformed JSON returns nil." + (should (null (wttrin-geolocation--parse-coordinates "not json"))) + (should (null (wttrin-geolocation--parse-coordinates ""))) + (should (null (wttrin-geolocation--parse-coordinates nil)))) + +(ert-deftest test-wttrin-geolocation-command-error-parse-missing-or-nonnumeric () + "Error: missing or non-numeric coordinates return nil." + (should (null (wttrin-geolocation--parse-coordinates "{\"lat\":1.0}"))) + (should (null (wttrin-geolocation--parse-coordinates + "{\"lat\":\"x\",\"lng\":\"y\"}")))) + +;;; wttrin-geolocation--parse-address + +(ert-deftest test-wttrin-geolocation-command-normal-parse-address () + "Normal: the address key is returned verbatim." + (should (equal "Westerly, Rhode Island, USA" + (wttrin-geolocation--parse-address + "{\"lat\":1.0,\"lng\":2.0,\"address\":\"Westerly, Rhode Island, USA\"}")))) + +(ert-deftest test-wttrin-geolocation-command-boundary-parse-address-label-synonym () + "Boundary: a `label' key is accepted when `address' is absent." + (should (equal "Westerly, RI" + (wttrin-geolocation--parse-address + "{\"lat\":1.0,\"lng\":2.0,\"label\":\"Westerly, RI\"}")))) + +(ert-deftest test-wttrin-geolocation-command-error-parse-address-absent () + "Error: no address or label, malformed JSON, or empty string returns nil." + (should (null (wttrin-geolocation--parse-address "{\"lat\":1.0,\"lng\":2.0}"))) + (should (null (wttrin-geolocation--parse-address "not json"))) + (should (null (wttrin-geolocation--parse-address + "{\"lat\":1.0,\"lng\":2.0,\"address\":\"\"}")))) + +;;; wttrin-geolocation-detect — routing and fallback + +(ert-deftest test-wttrin-geolocation-command-normal-detect-uses-command () + "Normal: with a command set that succeeds, its coordinates are used." + (let ((got 'none) + (ip-called nil) + (wttrin-geolocation-command "ignored-in-mock")) + (cl-letf (((symbol-function 'wttrin-geolocation--detect-via-command) + (lambda (cb) (funcall cb "1.0,2.0"))) + ((symbol-function 'wttrin-geolocation--detect-via-ip) + (lambda (cb) (setq ip-called t) (funcall cb "City, ST")))) + (wttrin-geolocation-detect (lambda (r &optional _a) (setq got r)))) + (should (equal "1.0,2.0" got)) + (should-not ip-called))) + +(ert-deftest test-wttrin-geolocation-command-boundary-detect-falls-back-to-ip () + "Boundary: with a command that fails (nil), detection falls back to IP." + (let ((got 'none) + (wttrin-geolocation-command "ignored-in-mock")) + (cl-letf (((symbol-function 'wttrin-geolocation--detect-via-command) + (lambda (cb) (funcall cb nil))) + ((symbol-function 'wttrin-geolocation--detect-via-ip) + (lambda (cb) (funcall cb "City, ST")))) + (wttrin-geolocation-detect (lambda (r &optional _a) (setq got r)))) + (should (equal "City, ST" got)))) + +(ert-deftest test-wttrin-geolocation-command-boundary-detect-no-command-uses-ip () + "Boundary: with no command set, the IP path runs directly." + (let ((got 'none) + (cmd-called nil) + (wttrin-geolocation-command nil)) + (cl-letf (((symbol-function 'wttrin-geolocation--detect-via-command) + (lambda (cb) (setq cmd-called t) (funcall cb "9.0,9.0"))) + ((symbol-function 'wttrin-geolocation--detect-via-ip) + (lambda (cb) (funcall cb "City, ST")))) + (wttrin-geolocation-detect (lambda (r &optional _a) (setq got r)))) + (should (equal "City, ST" got)) + (should-not cmd-called))) + +;;; wttrin-geolocation--detect-via-command — real process + +(defun test-wttrin-geolocation-command--run-sync (command) + "Run `wttrin-geolocation--detect-via-command' with COMMAND, wait, return coords. +The address (second callback argument) is ignored here; a separate test covers it." + (let ((result 'pending) + (wttrin-geolocation-command command)) + (wttrin-geolocation--detect-via-command + (lambda (r &optional _a) (setq result r))) + (with-timeout (5 (error "detect-via-command timed out")) + (while (eq result 'pending) + (accept-process-output nil 0.05))) + result)) + +(ert-deftest test-wttrin-geolocation-command-integration-real-command-success () + "Integration: a command printing lat/lng JSON resolves to \"LAT,LNG\". +Components: wttrin-geolocation--detect-via-command (real make-process), +the shell (real), wttrin-geolocation--parse-coordinates (real)." + (should (equal "1.5,2.5" + (test-wttrin-geolocation-command--run-sync + "echo '{\"lat\":1.5,\"lng\":2.5}'")))) + +(ert-deftest test-wttrin-geolocation-command-integration-real-command-passes-address () + "Integration: a command printing lat/lng plus an address passes both to the callback. +Components: detect-via-command (real make-process), the shell, the coord and +address parsers (real)." + (let ((coords 'pending) + (address 'pending) + (wttrin-geolocation-command + "echo '{\"lat\":1.5,\"lng\":2.5,\"address\":\"Westerly, RI\"}'")) + (wttrin-geolocation--detect-via-command + (lambda (c &optional a) (setq coords c address a))) + (with-timeout (5 (error "detect-via-command timed out")) + (while (eq coords 'pending) + (accept-process-output nil 0.05))) + (should (equal "1.5,2.5" coords)) + (should (equal "Westerly, RI" address)))) + +(ert-deftest test-wttrin-geolocation-command-integration-real-command-nonzero-exit () + "Integration: a command exiting non-zero yields nil (caller falls back to IP)." + (should (null (test-wttrin-geolocation-command--run-sync "exit 1")))) + +(ert-deftest test-wttrin-geolocation-command-integration-real-command-bad-output () + "Integration: a zero-exit command printing non-JSON yields nil." + (should (null (test-wttrin-geolocation-command--run-sync "echo not-json")))) + +(ert-deftest test-wttrin-geolocation-command-error-spawn-failure-yields-nil () + "Error: when the process cannot spawn, the callback receives nil." + (let ((result 'pending) + (wttrin-geolocation-command "whatever")) + (cl-letf (((symbol-function 'make-process) + (lambda (&rest _) (error "spawn failed")))) + (wttrin-geolocation--detect-via-command (lambda (r) (setq result r)))) + (should (null result)))) + +(provide 'test-wttrin-geolocation-command) +;;; test-wttrin-geolocation-command.el ends here diff --git a/tests/test-wttrin-geolocation-sentinel.el b/tests/test-wttrin-geolocation-sentinel.el new file mode 100644 index 0000000..169761b --- /dev/null +++ b/tests/test-wttrin-geolocation-sentinel.el @@ -0,0 +1,212 @@ +;;; test-wttrin-geolocation-sentinel.el --- Tests for the picker geolocation sentinel -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the "Current location (detect)" picker sentinel: its presence +;; and position in `wttrin--completion-candidates', the selection routing in +;; `wttrin--query-selection' (literal vs detect-then-query), and the guard that +;; keeps the sentinel out of location history. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) +(require 'wttrin-geolocation) +(require 'testutil-wttrin) + +;;; wttrin--completion-candidates — sentinel presence and position + +(ert-deftest test-wttrin-geolocation-sentinel-normal-first-candidate () + "Normal: the sentinel is the first completion candidate." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-favorite-location nil) + (wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history '("Tokyo"))) + (should (equal wttrin--geolocation-sentinel + (car (wttrin--completion-candidates))))) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-geolocation-sentinel-normal-first-even-with-favorite () + "Normal: the sentinel precedes a string favorite in the candidate list." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-favorite-location "New Orleans, LA") + (wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history nil)) + (should (equal (list wttrin--geolocation-sentinel + "New Orleans, LA" "Honolulu, HI") + (wttrin--completion-candidates)))) + (testutil-wttrin-teardown))) + +;;; wttrin--sort-completions — pin the sentinel first + +(ert-deftest test-wttrin-geolocation-sentinel-normal-sort-pins-first () + "Normal: the sentinel is moved to the front, the rest keep their order. +Sorting completion UIs (vertico, icomplete) call the metadata +display-sort-function, so this is what keeps the sentinel pinned." + (should (equal (list wttrin--geolocation-sentinel "Honolulu, HI" "Tokyo") + (wttrin--sort-completions + (list "Honolulu, HI" wttrin--geolocation-sentinel "Tokyo"))))) + +(ert-deftest test-wttrin-geolocation-sentinel-boundary-sort-no-sentinel-unchanged () + "Boundary: a list without the sentinel is returned in its original order." + (should (equal '("Honolulu, HI" "Tokyo") + (wttrin--sort-completions '("Honolulu, HI" "Tokyo"))))) + +(ert-deftest test-wttrin-geolocation-sentinel-boundary-sort-empty () + "Boundary: an empty candidate list sorts to empty." + (should (null (wttrin--sort-completions nil)))) + +;;; wttrin--completion-table — metadata + completion + +(ert-deftest test-wttrin-geolocation-sentinel-normal-table-metadata-sort-fn () + "Normal: the table advertises the pin-first display-sort-function." + (let* ((table (wttrin--completion-table + (list wttrin--geolocation-sentinel "Tokyo"))) + (meta (funcall table "" nil 'metadata))) + (should (eq #'wttrin--sort-completions + (cdr (assq 'display-sort-function (cdr meta))))))) + +(ert-deftest test-wttrin-geolocation-sentinel-normal-table-completes-candidates () + "Normal: the table completes over the candidates it was given." + (let ((table (wttrin--completion-table + (list wttrin--geolocation-sentinel "Tokyo" "Paris")))) + (should (equal (sort (list wttrin--geolocation-sentinel "Tokyo" "Paris") + #'string-lessp) + (sort (all-completions "" table) #'string-lessp))))) + +;;; wttrin interactive entry — delegates to routing + +(ert-deftest test-wttrin-geolocation-sentinel-normal-entry-delegates-to-query-selection () + "Normal: the interactive `wttrin' command routes its picker selection +through `wttrin--query-selection' (smoke test of the entry wrapper)." + (testutil-wttrin-setup) + (unwind-protect + (let ((routed nil)) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) "London, GB")) + ((symbol-function 'wttrin--query-selection) + (lambda (loc) (setq routed loc)))) + (call-interactively 'wttrin)) + (should (equal "London, GB" routed))) + (testutil-wttrin-teardown))) + +;;; wttrin--query-selection — routing + +(ert-deftest test-wttrin-geolocation-sentinel-normal-typed-location-queries-literally () + "Normal: a typed location is passed straight to `wttrin-query'." + (testutil-wttrin-setup) + (unwind-protect + (let ((captured nil)) + (cl-letf (((symbol-function 'wttrin-query) + (lambda (loc &rest _) (setq captured loc)))) + (wttrin--query-selection "Paris")) + (should (equal "Paris" captured))) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-geolocation-sentinel-normal-routes-to-detect-then-query () + "Normal: selecting the sentinel detects, then queries the resolved city." + (testutil-wttrin-setup) + (unwind-protect + (let ((captured nil)) + (cl-letf (((symbol-function 'wttrin-geolocation-detect) + (lambda (callback) (funcall callback "Austin, TX"))) + ((symbol-function 'wttrin-query) + (lambda (loc &rest _) (setq captured loc))) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin--query-selection wttrin--geolocation-sentinel)) + (should (equal "Austin, TX" captured))) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-geolocation-sentinel-error-detect-failure-no-query () + "Error: a failed detection does not query and does not mutate the favorite." + (testutil-wttrin-setup) + (unwind-protect + (let ((queried nil) + (wttrin-favorite-location "New Orleans, LA")) + (cl-letf (((symbol-function 'wttrin-geolocation-detect) + (lambda (callback) (funcall callback nil))) + ((symbol-function 'wttrin-query) + (lambda (_loc) (setq queried t))) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin--query-selection wttrin--geolocation-sentinel)) + (should-not queried) + (should (equal "New Orleans, LA" wttrin-favorite-location))) + (testutil-wttrin-teardown))) + +;;; sentinel never enters history + +(ert-deftest test-wttrin-geolocation-sentinel-boundary-never-added-to-history () + "Boundary: the sentinel string is never recorded in location history." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin--location-history nil)) + (wttrin--add-to-location-history wttrin--geolocation-sentinel) + (should (null wttrin--location-history))) + (testutil-wttrin-teardown))) + +;;; wttrin-geolocation-enabled — opt-out switch + +(ert-deftest test-wttrin-geolocation-sentinel-normal-disabled-hides-sentinel () + "Normal: with geolocation disabled, the sentinel is not offered." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-geolocation-enabled nil) + (wttrin-favorite-location nil) + (wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history '("Tokyo"))) + (should-not (member wttrin--geolocation-sentinel + (wttrin--completion-candidates))) + (should (equal '("Honolulu, HI" "Tokyo") + (wttrin--completion-candidates)))) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-geolocation-sentinel-boundary-enabled-shows-sentinel () + "Boundary: with geolocation enabled (default), the sentinel is offered first." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-geolocation-enabled t) + (wttrin-favorite-location nil) + (wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history nil)) + (should (equal wttrin--geolocation-sentinel + (car (wttrin--completion-candidates))))) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-geolocation-sentinel-error-disabled-detect-then-query-no-detect () + "Error: with geolocation disabled, detect-then-query does not detect or query." + (testutil-wttrin-setup) + (unwind-protect + (let ((detected nil) + (queried nil) + (wttrin-geolocation-enabled nil)) + (cl-letf (((symbol-function 'wttrin-geolocation-detect) + (lambda (_cb) (setq detected t))) + ((symbol-function 'wttrin-query) + (lambda (_loc) (setq queried t))) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin--detect-then-query)) + (should-not detected) + (should-not queried)) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-geolocation-sentinel-boundary-disabled-favorite-no-autodetect () + "Boundary: with geolocation disabled, the t-favorite auto-detect does not fire." + (testutil-wttrin-setup) + (unwind-protect + (let ((detected nil) + (wttrin-geolocation-enabled nil) + (wttrin--favorite-location-pending nil)) + (cl-letf (((symbol-function 'wttrin-geolocation-detect) + (lambda (_cb) (setq detected t)))) + (wttrin--start-favorite-location-detect)) + (should-not detected) + (should-not wttrin--favorite-location-pending)) + (testutil-wttrin-teardown))) + +(provide 'test-wttrin-geolocation-sentinel) +;;; test-wttrin-geolocation-sentinel.el ends here diff --git a/tests/test-wttrin-location-history.el b/tests/test-wttrin-location-history.el new file mode 100644 index 0000000..4af8235 --- /dev/null +++ b/tests/test-wttrin-location-history.el @@ -0,0 +1,242 @@ +;;; test-wttrin-location-history.el --- Tests for location search history -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the location search history feature: wttrin--add-to-location-history, +;; wttrin--completion-candidates, wttrin-remove-location-history, +;; wttrin-clear-location-history, and savehist integration. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) +(require 'testutil-wttrin) + +;;; Setup and Teardown + +(defun test-wttrin-location-history-setup () + "Setup: isolate history and defaults from the user's real config." + (testutil-wttrin-setup) + (setq wttrin--location-history nil)) + +(defun test-wttrin-location-history-teardown () + "Teardown: clear history." + (setq wttrin--location-history nil) + (testutil-wttrin-teardown)) + +;;; wttrin--add-to-location-history + +(ert-deftest test-wttrin-location-history-normal-adds-new-location () + "A new location is pushed onto the front of history." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin--location-history nil)) + (wttrin--add-to-location-history "Tokyo") + (should (equal '("Tokyo") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-normal-promotes-existing-to-front () + "Re-adding an existing location moves it to the front without duplicating." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin--location-history '("Paris" "Tokyo" "Berlin"))) + (wttrin--add-to-location-history "Tokyo") + (should (equal '("Tokyo" "Paris" "Berlin") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-normal-skips-default-location () + "A location already in defaults is not added to history." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history nil)) + (wttrin--add-to-location-history "Honolulu, HI") + (should (null wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-boundary-trims-to-max () + "History is trimmed to `wttrin-location-history-max', keeping the most recent." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin-location-history-max 3) + (wttrin--location-history '("c" "b" "a"))) + (wttrin--add-to-location-history "d") + (should (equal '("d" "c" "b") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-boundary-empty-history () + "Adding to empty history yields a single-entry list." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin--location-history nil)) + (wttrin--add-to-location-history "Reykjavik") + (should (equal '("Reykjavik") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-boundary-max-zero-keeps-none () + "A max of 0 results in empty history after a trim." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin-location-history-max 0) + (wttrin--location-history nil)) + (wttrin--add-to-location-history "Nowhere") + (should (null wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-error-nil-location-no-op () + "A nil location is a no-op." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin--location-history '("Paris"))) + (wttrin--add-to-location-history nil) + (should (equal '("Paris") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-error-empty-string-no-op () + "An empty string is a no-op." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin--location-history '("Paris"))) + (wttrin--add-to-location-history "") + (should (equal '("Paris") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +;;; wttrin--completion-candidates + +(ert-deftest test-wttrin-location-history-normal-candidates-defaults-then-history () + "Candidates list the sentinel, then defaults, then history." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-favorite-location nil) + (wttrin-default-locations '("Honolulu, HI" "Berkeley, CA")) + (wttrin--location-history '("Tokyo" "Paris"))) + (should (equal (list wttrin--geolocation-sentinel + "Honolulu, HI" "Berkeley, CA" "Tokyo" "Paris") + (wttrin--completion-candidates)))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-normal-candidates-only-defaults () + "With empty history, candidates are the sentinel then the defaults." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-favorite-location nil) + (wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history nil)) + (should (equal (list wttrin--geolocation-sentinel "Honolulu, HI") + (wttrin--completion-candidates)))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-normal-candidates-only-history () + "With empty defaults, candidates are the sentinel then the history." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-favorite-location nil) + (wttrin-default-locations '()) + (wttrin--location-history '("Tokyo"))) + (should (equal (list wttrin--geolocation-sentinel "Tokyo") + (wttrin--completion-candidates)))) + (test-wttrin-location-history-teardown))) + +;;; wttrin-remove-location-history + +(ert-deftest test-wttrin-location-history-normal-remove-entry () + "Removing an entry drops it from history." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin--location-history '("Tokyo" "Paris" "Berlin"))) + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location-history "Paris")) + (should (equal '("Tokyo" "Berlin") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-normal-remove-absent-no-op () + "Removing an entry not present leaves history unchanged." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin--location-history '("Tokyo"))) + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location-history "Mars")) + (should (equal '("Tokyo") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-boundary-remove-last-leaves-empty () + "Removing the only entry leaves an empty list." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin--location-history '("Tokyo"))) + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location-history "Tokyo")) + (should (null wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +;;; wttrin-clear-location-history + +(ert-deftest test-wttrin-location-history-normal-clear-confirmed () + "Confirming the prompt clears all history." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin--location-history '("Tokyo" "Paris"))) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-clear-location-history)) + (should (null wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-normal-clear-declined-keeps-history () + "Declining the prompt leaves history intact." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin--location-history '("Tokyo" "Paris"))) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-clear-location-history)) + (should (equal '("Tokyo" "Paris") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +;;; savehist integration + +(ert-deftest test-wttrin-location-history-integration-savehist-registers-variable () + "Loading savehist registers wttrin--location-history for persistence." + (require 'savehist) + (should (memq 'wttrin--location-history savehist-additional-variables))) + +(ert-deftest test-wttrin-location-history-normal-savehist-register-adds-var () + "wttrin--savehist-register adds the history variable to the save list." + (require 'savehist) + (let ((savehist-additional-variables '(kill-ring))) + (wttrin--savehist-register) + (should (memq 'wttrin--location-history savehist-additional-variables)))) + +(ert-deftest test-wttrin-location-history-boundary-savehist-register-idempotent () + "Registering an already-present variable does not duplicate it." + (require 'savehist) + (require 'cl-lib) + (let ((savehist-additional-variables '(wttrin--location-history wttrin-favorite-location))) + (wttrin--savehist-register) + (should (= 1 (cl-count 'wttrin--location-history savehist-additional-variables))) + (should (= 1 (cl-count 'wttrin-favorite-location savehist-additional-variables))))) + +(ert-deftest test-wttrin-location-history-integration-savehist-register-on-save-hook () + "The registration runs on `savehist-save-hook' so it survives a clobber." + (require 'savehist) + (should (memq 'wttrin--savehist-register savehist-save-hook))) + +(ert-deftest test-wttrin-location-history-integration-savehist-survives-clobber () + "A user setq that drops the variable is repaired before the next save." + (require 'savehist) + (let ((savehist-additional-variables '(kill-ring search-ring))) + ;; simulate the save path: savehist-save runs this hook first + (run-hooks 'savehist-save-hook) + (should (memq 'wttrin--location-history savehist-additional-variables)))) + +(provide 'test-wttrin-location-history) +;;; test-wttrin-location-history.el ends here diff --git a/tests/test-wttrin-make-default.el b/tests/test-wttrin-make-default.el new file mode 100644 index 0000000..e715e12 --- /dev/null +++ b/tests/test-wttrin-make-default.el @@ -0,0 +1,176 @@ +;;; test-wttrin-make-default.el --- Tests for promote-to-default command -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;;; Commentary: + +;; Unit tests for wttrin--set-favorite-location and wttrin-make-default, +;; the weather-buffer command (bound to "d") that promotes the displayed +;; location to the persisted favorite. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) + +;;; -------------------------------------------------------------------------- +;;; wttrin--set-favorite-location +;;; -------------------------------------------------------------------------- + +;;; Normal Cases + +(ert-deftest test-wttrin--set-favorite-location-normal-sets-variable () + "Normal: sets `wttrin-favorite-location' to the given location." + (let ((wttrin-favorite-location nil) + (savehist-additional-variables nil)) + (wttrin--set-favorite-location "Paris, FR") + (should (equal wttrin-favorite-location "Paris, FR")))) + +(ert-deftest test-wttrin--set-favorite-location-error-no-savehist-loaded () + "Error: setting the favorite works even when savehist is not loaded. +The setter must not touch `savehist-additional-variables' directly (it may be +unbound); persistence is left to `wttrin--savehist-register'." + (let ((wttrin-favorite-location nil)) + ;; Simulate savehist absent: the variable is unbound. + (cl-letf (((symbol-function 'wttrin--savehist-register) + (lambda () (error "Should not be called from the setter")))) + (wttrin--set-favorite-location "Oslo, NO") + (should (equal wttrin-favorite-location "Oslo, NO"))))) + +(ert-deftest test-wttrin--set-favorite-location-normal-drops-from-history () + "Normal: promoting a location removes it from the search history." + (let ((wttrin-favorite-location nil) + (wttrin--location-history '("Reykjavik" "Oslo, NO"))) + (wttrin--set-favorite-location "Reykjavik") + (should-not (member "Reykjavik" wttrin--location-history)) + (should (equal wttrin--location-history '("Oslo, NO"))))) + +(ert-deftest test-wttrin--set-favorite-location-boundary-not-in-history-is-noop () + "Boundary: promoting a location absent from history leaves history intact." + (let ((wttrin-favorite-location nil) + (wttrin--location-history '("Oslo, NO"))) + (wttrin--set-favorite-location "Berkeley, CA") + (should (equal wttrin--location-history '("Oslo, NO"))))) + +(ert-deftest test-wttrin-favorite-savehist-register-includes-favorite () + "Normal: `wttrin--savehist-register' registers the favorite for persistence." + (require 'savehist) + (let ((savehist-additional-variables '(kill-ring))) + (wttrin--savehist-register) + (should (memq 'wttrin-favorite-location savehist-additional-variables)))) + +;;; -------------------------------------------------------------------------- +;;; mode-line refresh when the favorite changes +;;; -------------------------------------------------------------------------- + +;;; Normal Cases + +(ert-deftest test-wttrin--set-favorite-location-normal-mode-line-on-refreshes () + "Normal: changing the favorite while the mode-line is active clears the +stale cache and fetches fresh weather for the new location immediately." + (let ((wttrin-favorite-location "Oslo, NO") + (wttrin-mode-line-mode t) + (wttrin--mode-line-cache (cons 0.0 "Oslo, NO: sun")) + (fetched nil)) + (cl-letf (((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil))) + (wttrin--set-favorite-location "Paris, FR") + (should (null wttrin--mode-line-cache)) + (should fetched)))) + +;;; Boundary Cases + +(ert-deftest test-wttrin--set-favorite-location-boundary-mode-line-off-no-fetch () + "Boundary: with the mode-line inactive, changing the favorite does not fetch." + (let ((wttrin-favorite-location "Oslo, NO") + (wttrin-mode-line-mode nil) + (fetched nil)) + (cl-letf (((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t)))) + (wttrin--set-favorite-location "Paris, FR") + (should-not fetched)))) + +(ert-deftest test-wttrin--set-favorite-location-boundary-unchanged-no-fetch () + "Boundary: re-promoting the current favorite does not refetch the mode-line." + (let ((wttrin-favorite-location "Paris, FR") + (wttrin-mode-line-mode t) + (fetched nil)) + (cl-letf (((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil))) + (wttrin--set-favorite-location "Paris, FR") + (should-not fetched)))) + +;;; -------------------------------------------------------------------------- +;;; wttrin-make-default +;;; -------------------------------------------------------------------------- + +;;; Normal Cases + +(ert-deftest test-wttrin-make-default-normal-sets-favorite-from-current () + "Normal: promotes the buffer's current location to the favorite." + (let ((wttrin-favorite-location nil) + (savehist-additional-variables nil)) + (with-temp-buffer + (setq-local wttrin--current-location "Tokyo, JP") + (wttrin-make-default) + (should (equal wttrin-favorite-location "Tokyo, JP"))))) + +;;; Boundary Cases + +(ert-deftest test-wttrin-make-default-boundary-nil-current-leaves-favorite () + "Boundary: no current location is a no-op that leaves the favorite intact." + (let ((wttrin-favorite-location "Berkeley, CA") + (savehist-additional-variables nil)) + (with-temp-buffer + (setq-local wttrin--current-location nil) + (wttrin-make-default) + (should (equal wttrin-favorite-location "Berkeley, CA"))))) + +;;; -------------------------------------------------------------------------- +;;; favorite in completion candidates +;;; -------------------------------------------------------------------------- + +;;; Normal Cases + +(ert-deftest test-wttrin-make-default-normal-favorite-prepended-to-candidates () + "Normal: a typed-in favorite is offered in the picker, at the front." + (let ((wttrin-default-locations '("Honolulu, HI" "Berkeley, CA")) + (wttrin--location-history nil) + (wttrin-favorite-location "Reykjavik")) + (should (equal (wttrin--completion-candidates) + (list wttrin--geolocation-sentinel + "Reykjavik" "Honolulu, HI" "Berkeley, CA"))))) + +;;; Boundary Cases + +(ert-deftest test-wttrin-make-default-boundary-favorite-default-not-duplicated () + "Boundary: a favorite that is already a default appears exactly once." + (require 'cl-lib) + (let ((wttrin-default-locations '("Honolulu, HI" "Berkeley, CA")) + (wttrin--location-history nil) + (wttrin-favorite-location "Berkeley, CA")) + (should (= 1 (cl-count "Berkeley, CA" (wttrin--completion-candidates) :test #'equal))))) + +(ert-deftest test-wttrin-make-default-boundary-nil-favorite-candidates-unchanged () + "Boundary: nil favorite leaves the candidate list as defaults plus history." + (let ((wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history '("Oslo, NO")) + (wttrin-favorite-location nil)) + (should (equal (wttrin--completion-candidates) + (list wttrin--geolocation-sentinel "Honolulu, HI" "Oslo, NO"))))) + +;;; -------------------------------------------------------------------------- +;;; keymap binding +;;; -------------------------------------------------------------------------- + +(ert-deftest test-wttrin-make-default-normal-d-bound-in-mode-map () + "Normal: the weather-buffer keymap binds \"d\" to the command." + (should (eq (lookup-key wttrin-mode-map (kbd "d")) 'wttrin-make-default))) + +(provide 'test-wttrin-make-default) +;;; test-wttrin-make-default.el ends here diff --git a/tests/test-wttrin-query.el b/tests/test-wttrin-query.el index 396507b..4c4de87 100644 --- a/tests/test-wttrin-query.el +++ b/tests/test-wttrin-query.el @@ -102,20 +102,17 @@ "When fetch returns nil, the user should see an error message, not a crash." (test-wttrin-query-setup) (unwind-protect - (let ((saved-callback nil) - (displayed-message nil)) - (cl-letf (((symbol-function 'wttrin--get-cached-or-fetch) - (lambda (_location callback) - (setq saved-callback callback))) - ((symbol-function 'message) - (lambda (fmt &rest args) - (setq displayed-message (apply #'format fmt args))))) - (wttrin-query "BadLocation") - ;; Simulate fetch returning nil - (funcall saved-callback nil) - ;; Should have shown error message (from wttrin--display-weather validation) - (should displayed-message) - (should (string-match-p "Cannot retrieve" displayed-message)))) + (let ((saved-callback nil)) + (testutil-wttrin-with-captured-message displayed-message + (cl-letf (((symbol-function 'wttrin--get-cached-or-fetch) + (lambda (_location callback) + (setq saved-callback callback)))) + (wttrin-query "BadLocation") + ;; Simulate fetch returning nil + (funcall saved-callback nil) + ;; Should have shown error message (from wttrin--display-weather validation) + (should displayed-message) + (should (string-match-p "Cannot retrieve" displayed-message))))) (test-wttrin-query-teardown))) (provide 'test-wttrin-query) diff --git a/tests/test-wttrin-requery-force.el b/tests/test-wttrin-requery-force.el index d572348..30af7dd 100644 --- a/tests/test-wttrin-requery-force.el +++ b/tests/test-wttrin-requery-force.el @@ -35,7 +35,7 @@ (unwind-protect (let ((queried-location nil)) (cl-letf (((symbol-function 'wttrin-query) - (lambda (location) (setq queried-location location)))) + (lambda (location &rest _) (setq queried-location location)))) ;; Set up a weather buffer with a known location (with-current-buffer (get-buffer-create "*wttr.in*") (setq-local wttrin--current-location "Berlin, DE") @@ -49,7 +49,7 @@ (unwind-protect (let ((force-refresh-was-set nil)) (cl-letf (((symbol-function 'wttrin-query) - (lambda (_location) + (lambda (_location &rest _) (setq force-refresh-was-set wttrin--force-refresh)))) (with-current-buffer (get-buffer-create "*wttr.in*") (setq-local wttrin--current-location "Paris") @@ -63,15 +63,12 @@ "When no current location is set, user should be told there's nothing to refresh." (test-wttrin-requery-force-setup) (unwind-protect - (let ((displayed-message nil)) - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) - (setq displayed-message (apply #'format fmt args))))) - (with-current-buffer (get-buffer-create "*wttr.in*") - ;; wttrin--current-location is nil (buffer-local default) - (wttrin-requery-force) - (should displayed-message) - (should (string-match-p "No location" displayed-message))))) + (testutil-wttrin-with-captured-message displayed-message + (with-current-buffer (get-buffer-create "*wttr.in*") + ;; wttrin--current-location is nil (buffer-local default) + (wttrin-requery-force) + (should displayed-message) + (should (string-match-p "No location" displayed-message)))) (test-wttrin-requery-force-teardown))) (ert-deftest test-wttrin-requery-force-boundary-force-flag-does-not-leak () @@ -79,7 +76,7 @@ (test-wttrin-requery-force-setup) (unwind-protect (progn - (cl-letf (((symbol-function 'wttrin-query) (lambda (_location) nil))) + (cl-letf (((symbol-function 'wttrin-query) (lambda (_location &rest _) nil))) (with-current-buffer (get-buffer-create "*wttr.in*") (setq-local wttrin--current-location "Paris") (wttrin-requery-force))) diff --git a/tests/test-wttrin-requery.el b/tests/test-wttrin-requery.el index d6a8beb..e065c43 100644 --- a/tests/test-wttrin-requery.el +++ b/tests/test-wttrin-requery.el @@ -39,7 +39,7 @@ (test-wttrin-requery-setup) (unwind-protect (let ((old-buffer (get-buffer-create "*wttr.in*"))) - (cl-letf (((symbol-function 'wttrin-query) (lambda (_loc) nil))) + (cl-letf (((symbol-function 'wttrin-query) (lambda (_loc &rest _) nil))) (wttrin--requery-location "Tokyo") ;; Old buffer should be dead (should-not (buffer-live-p old-buffer)))) @@ -51,7 +51,7 @@ (unwind-protect (let ((queried-location nil)) (cl-letf (((symbol-function 'wttrin-query) - (lambda (loc) (setq queried-location loc)))) + (lambda (loc &rest _) (setq queried-location loc)))) (wttrin--requery-location "Berlin, DE") (should (equal queried-location "Berlin, DE")))) (test-wttrin-requery-teardown))) @@ -66,7 +66,7 @@ ;; Ensure no buffer exists (should-not (get-buffer "*wttr.in*")) (cl-letf (((symbol-function 'wttrin-query) - (lambda (loc) (setq queried-location loc)))) + (lambda (loc &rest _) (setq queried-location loc)))) (wttrin--requery-location "Paris") (should (equal queried-location "Paris")))) (test-wttrin-requery-teardown))) @@ -77,7 +77,7 @@ (unwind-protect (let ((queried-location nil)) (cl-letf (((symbol-function 'wttrin-query) - (lambda (loc) (setq queried-location loc)))) + (lambda (loc &rest _) (setq queried-location loc)))) (wttrin--requery-location "Zürich, CH") (should (equal queried-location "Zürich, CH")))) (test-wttrin-requery-teardown))) @@ -105,15 +105,22 @@ to the core requery function." (test-wttrin-requery-setup) (unwind-protect (let ((offered-collection nil) + (wttrin-favorite-location nil) + (wttrin--location-history nil) (wttrin-default-locations '("Paris" "London" "Tokyo"))) (cl-letf (((symbol-function 'completing-read) (lambda (_prompt collection &rest _args) (setq offered-collection collection) "Paris")) ((symbol-function 'wttrin--requery-location) - (lambda (_loc) nil))) + (lambda (_loc &rest _) nil))) (wttrin-requery) - (should (equal offered-collection '("Paris" "London" "Tokyo"))))) + ;; The collection is now a completion table (a function) that pins + ;; the sentinel first; check the candidates it completes over. + (should (equal (list wttrin--geolocation-sentinel + "Paris" "London" "Tokyo") + (wttrin--sort-completions + (all-completions "" offered-collection)))))) (test-wttrin-requery-teardown))) (ert-deftest test-wttrin-requery-boundary-single-default-prefills () @@ -127,7 +134,7 @@ to the core requery function." (setq initial-input init) "Solo City")) ((symbol-function 'wttrin--requery-location) - (lambda (_loc) nil))) + (lambda (_loc &rest _) nil))) (wttrin-requery) (should (equal initial-input "Solo City")))) (test-wttrin-requery-teardown))) @@ -143,7 +150,7 @@ to the core requery function." (setq initial-input init) "Paris")) ((symbol-function 'wttrin--requery-location) - (lambda (_loc) nil))) + (lambda (_loc &rest _) nil))) (wttrin-requery) (should-not initial-input))) (test-wttrin-requery-teardown))) diff --git a/tests/test-wttrin-saved-locations.el b/tests/test-wttrin-saved-locations.el new file mode 100644 index 0000000..de97df0 --- /dev/null +++ b/tests/test-wttrin-saved-locations.el @@ -0,0 +1,418 @@ +;;; test-wttrin-saved-locations.el --- Tests for the named-locations directory -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the named-locations directory (Phase 1): the normalizer +;; `wttrin--saved-locations', the resolver `wttrin--resolve-location-query', +;; candidate de-duplication/precedence, favorite-as-name resolution, alias cache +;; identity, history suppression of saved names, and savehist registration. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) +(require 'testutil-wttrin) + +;;; wttrin--saved-locations (normalizer) + +(ert-deftest test-wttrin-saved-locations-normal-pairs-returned () + "Normal: well-formed pairs are returned as (NAME . QUERY)." + (let ((wttrin-saved-locations '(("Home" . "1500 Sugar Bowl Dr, New Orleans")))) + (should (equal '(("Home" . "1500 Sugar Bowl Dr, New Orleans")) + (wttrin--saved-locations))))) + +(ert-deftest test-wttrin-saved-locations-boundary-bare-string-shorthand () + "Boundary: a bare string S becomes (S . S)." + (let ((wttrin-saved-locations '("Berkeley, CA"))) + (should (equal '(("Berkeley, CA" . "Berkeley, CA")) + (wttrin--saved-locations))))) + +(ert-deftest test-wttrin-saved-locations-boundary-whitespace-trimmed () + "Boundary: surrounding whitespace on name and query is trimmed." + (let ((wttrin-saved-locations '((" Home " . " Paris, FR ")))) + (should (equal '(("Home" . "Paris, FR")) (wttrin--saved-locations))))) + +(ert-deftest test-wttrin-saved-locations-error-malformed-skipped () + "Error: non-cons, non-string, and empty entries are skipped, not fatal." + (let ((wttrin-saved-locations + (list '("Good" . "Tokyo") 42 '("" . "x") '("y" . "") " " '(a . b)))) + (should (equal '(("Good" . "Tokyo")) (wttrin--saved-locations))))) + +;;; wttrin--resolve-location-query + +(ert-deftest test-wttrin-saved-locations-normal-resolve-name-to-query () + "Normal: a saved name resolves to its query." + (let ((wttrin-saved-locations '(("Craig's House" . "1500 Sugar Bowl Dr, New Orleans")))) + (should (equal "1500 Sugar Bowl Dr, New Orleans" + (wttrin--resolve-location-query "Craig's House"))))) + +(ert-deftest test-wttrin-saved-locations-boundary-resolve-passthrough () + "Boundary: a non-saved selection passes through unchanged." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))) + (should (equal "Tokyo, JP" (wttrin--resolve-location-query "Tokyo, JP"))))) + +;;; Candidate de-duplication and precedence + +(ert-deftest test-wttrin-saved-locations-normal-candidates-precedence () + "Normal: candidates are saved, favorite, defaults, then history, deduped." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-geolocation-enabled nil) + (wttrin-saved-locations '(("Home" . "Paris, FR"))) + (wttrin-favorite-location "Reykjavik") + (wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history '("Tokyo"))) + (should (equal '("Home" "Reykjavik" "Honolulu, HI" "Tokyo") + (wttrin--completion-candidates)))) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-saved-locations-boundary-candidates-dedup-saved-wins () + "Boundary: a name present in saved and defaults appears once (saved first)." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-geolocation-enabled nil) + (wttrin-saved-locations '(("Honolulu, HI" . "Honolulu, HI"))) + (wttrin-favorite-location nil) + (wttrin-default-locations '("Honolulu, HI" "Berkeley, CA")) + (wttrin--location-history nil)) + (should (equal '("Honolulu, HI" "Berkeley, CA") + (wttrin--completion-candidates)))) + (testutil-wttrin-teardown))) + +;;; Favorite-as-name resolution + +(ert-deftest test-wttrin-saved-locations-normal-favorite-name-resolves-to-query () + "Normal: a favorite that is a saved name resolves to its query for fetching." + (let ((wttrin-saved-locations '(("Home" . "1500 Sugar Bowl Dr, New Orleans"))) + (wttrin-favorite-location "Home")) + (should (equal "1500 Sugar Bowl Dr, New Orleans" + (wttrin--resolve-favorite-location))))) + +(ert-deftest test-wttrin-saved-locations-normal-favorite-display-shows-name () + "Normal: the favorite display name is the saved name, not its query." + (let ((wttrin-saved-locations '(("Home" . "1500 Sugar Bowl Dr, New Orleans"))) + (wttrin-favorite-location "Home")) + (should (equal "Home" (wttrin--favorite-location-display-name))))) + +;;; Alias cache identity + +(ert-deftest test-wttrin-saved-locations-normal-cache-keyed-on-query () + "Normal: cache identity follows the query, not the display name. +Two names with the same query share a key; the name never leaks into the key." + (let ((wttrin-saved-locations '(("A" . "Paris, FR") ("B" . "Paris, FR")))) + (should (equal (wttrin--make-cache-key (wttrin--resolve-location-query "A")) + (wttrin--make-cache-key (wttrin--resolve-location-query "B")))))) + +;;; History suppression of saved names + +(ert-deftest test-wttrin-saved-locations-boundary-saved-name-not-logged () + "Boundary: a saved-directory name is not added to history." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))) + (wttrin-default-locations '()) + (wttrin--location-history nil)) + (wttrin--add-to-location-history "Home") + (should (null wttrin--location-history))) + (testutil-wttrin-teardown))) + +;;; savehist + +(ert-deftest test-wttrin-saved-locations-integration-savehist-registers () + "Integration: wttrin-saved-locations is registered for savehist persistence." + (require 'savehist) + (let ((savehist-additional-variables '(kill-ring))) + (wttrin--savehist-register) + (should (memq 'wttrin-saved-locations savehist-additional-variables)))) + +;;; wttrin--coordinates-p + +(ert-deftest test-wttrin-saved-locations-normal-coordinates-p () + "Normal/Boundary: coordinate strings match; place names do not." + (should (wttrin--coordinates-p "41.37,-71.83")) + (should (wttrin--coordinates-p "1.5,2.5")) + (should-not (wttrin--coordinates-p "New York, NY")) + (should-not (wttrin--coordinates-p "Berkeley, CA")) + (should-not (wttrin--coordinates-p ""))) + +;;; wttrin--put-saved-location + +(ert-deftest test-wttrin-saved-locations-normal-put-adds-and-updates () + "Normal: put adds a new entry and updates an existing name without duplicating." + (let ((wttrin-saved-locations nil)) + (wttrin--put-saved-location "Home" "Paris, FR") + (should (equal "Paris, FR" (wttrin--resolve-location-query "Home"))) + (wttrin--put-saved-location "Home" "Tokyo, JP") + (should (equal "Tokyo, JP" (wttrin--resolve-location-query "Home"))) + (should (= 1 (length (wttrin--saved-locations)))))) + +(ert-deftest test-wttrin-saved-locations-error-put-rejects-empty-and-sentinel () + "Error: put refuses an empty name, empty query, or the sentinel name." + (let ((wttrin-saved-locations nil)) + (should-error (wttrin--put-saved-location "" "Paris") :type 'user-error) + (should-error (wttrin--put-saved-location "Home" "") :type 'user-error) + (should-error (wttrin--put-saved-location wttrin--geolocation-sentinel "x") + :type 'user-error))) + +;;; wttrin-rename-location + +(ert-deftest test-wttrin-saved-locations-normal-rename () + "Normal: rename moves the entry and updates the favorite reference." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))) + (wttrin-favorite-location "Home")) + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-rename-location "Home" "Casa")) + (should (equal "Paris, FR" (wttrin--resolve-location-query "Casa"))) + (should-not (assoc "Home" (wttrin--saved-locations))) + (should (equal "Casa" wttrin-favorite-location)))) + +(ert-deftest test-wttrin-saved-locations-error-rename-collision-refused () + "Error: renaming onto an existing name is refused and changes nothing." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR") ("Work" . "Tokyo, JP")))) + (should-error (wttrin-rename-location "Home" "Work") :type 'user-error) + (should (equal "Paris, FR" (wttrin--resolve-location-query "Home"))))) + +(ert-deftest test-wttrin-saved-locations-normal-rename-favorite-refreshes-mode-line () + "Normal: renaming the favorite refreshes the mode-line so the icon and tooltip +follow the new name immediately instead of at the next scheduled fetch." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))) + (wttrin-favorite-location "Home") + (wttrin--location-history nil) + (wttrin-mode-line-mode t) + (fetched nil)) + (cl-letf (((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-rename-location "Home" "Casa")) + (should (equal "Casa" wttrin-favorite-location)) + (should fetched))) + +(ert-deftest test-wttrin-saved-locations-boundary-rename-non-favorite-no-refresh () + "Boundary: renaming a location that is not the favorite does not refresh." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR") ("Work" . "Tokyo, JP"))) + (wttrin-favorite-location "Work") + (wttrin--location-history nil) + (wttrin-mode-line-mode t) + (fetched nil)) + (cl-letf (((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-rename-location "Home" "Casa")) + (should-not fetched))) + +;;; wttrin-remove-location + +(ert-deftest test-wttrin-saved-locations-normal-remove-confirmed () + "Normal: confirming removes the entry." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location "Home")) + (should (null (wttrin--saved-locations))))) + +(ert-deftest test-wttrin-saved-locations-boundary-remove-declined-keeps () + "Boundary: declining the confirmation keeps the entry." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location "Home")) + (should (assoc "Home" (wttrin--saved-locations))))) + +(ert-deftest test-wttrin-saved-locations-normal-remove-favorite-refreshes-mode-line () + "Normal: removing the favorite refreshes the mode-line so it stops showing the +now-deleted alias's resolved weather and re-fetches against the bare query." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))) + (wttrin-favorite-location "Home") + (wttrin-mode-line-mode t) + (fetched nil)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location "Home")) + (should fetched))) + +(ert-deftest test-wttrin-saved-locations-boundary-remove-non-favorite-no-refresh () + "Boundary: removing a location that is not the favorite does not refresh." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR") ("Work" . "Tokyo, JP"))) + (wttrin-favorite-location "Work") + (wttrin-mode-line-mode t) + (fetched nil)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location "Home")) + (should-not fetched))) + +;;; wttrin-make-default — geolocation naming + +(ert-deftest test-wttrin-saved-locations-normal-d-names-and-promotes () + "Normal: d on a coordinate buffer names it, saves it, and promotes the name." + (let ((wttrin-saved-locations nil) + (wttrin-favorite-location nil) + (wttrin-mode-line-mode nil)) + (with-temp-buffer + (setq-local wttrin--current-location "41.37,-71.83") + (setq-local wttrin--current-display "41.37,-71.83") + (setq-local wttrin--current-address "Westerly, RI") + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "Home")) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-make-default))) + (should (equal "41.37,-71.83" (wttrin--resolve-location-query "Home"))) + (should (equal "Home" wttrin-favorite-location)))) + +(ert-deftest test-wttrin-saved-locations-boundary-d-empty-keeps-coordinates () + "Boundary: an empty name at the d prompt keeps the coordinates, saves no entry." + (let ((wttrin-saved-locations nil) + (wttrin-favorite-location nil) + (wttrin-mode-line-mode nil)) + (with-temp-buffer + (setq-local wttrin--current-location "41.37,-71.83") + (setq-local wttrin--current-address "Westerly, RI") + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "")) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-make-default))) + (should (null (wttrin--saved-locations))) + (should (equal "41.37,-71.83" wttrin-favorite-location)))) + +(ert-deftest test-wttrin-saved-locations-boundary-d-named-buffer-no-prompt () + "Boundary: d on a named buffer promotes the display name without prompting." + (let ((wttrin-saved-locations nil) + (wttrin-favorite-location nil) + (wttrin-mode-line-mode nil) + (prompted nil)) + (with-temp-buffer + (setq-local wttrin--current-location "1500 Sugar Bowl Dr") + (setq-local wttrin--current-display "Craig's House") + (cl-letf (((symbol-function 'read-string) + (lambda (&rest _) (setq prompted t) "x")) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-make-default))) + (should-not prompted) + (should (equal "Craig's House" wttrin-favorite-location)) + (should (equal "1500 Sugar Bowl Dr" + (wttrin--resolve-location-query "Craig's House"))))) + +(ert-deftest test-wttrin-saved-locations-normal-d-typed-saves-to-directory () + "Normal: making a typed location the default also saves it to the directory, +so it persists as a named entry rather than only as the favorite string." + (let ((wttrin-saved-locations nil) + (wttrin-favorite-location nil) + (wttrin-mode-line-mode nil)) + (with-temp-buffer + (setq-local wttrin--current-location "Reykjavik") + (setq-local wttrin--current-display "Reykjavik") + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-make-default))) + (should (equal "Reykjavik" wttrin-favorite-location)) + (should (assoc "Reykjavik" (wttrin--saved-locations))) + (should (equal "Reykjavik" (wttrin--resolve-location-query "Reykjavik"))))) + +;;; interactive entry smoke tests (cover the prompt forms) + +(ert-deftest test-wttrin-saved-locations-normal-save-location-interactive () + "Normal: the interactive save command reads the buffer query and a name." + (let ((wttrin-saved-locations nil)) + (with-temp-buffer + (setq-local wttrin--current-location "Paris, FR") + (setq-local wttrin--current-display "Paris, FR") + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "Home")) + ((symbol-function 'message) (lambda (&rest _) nil))) + (call-interactively 'wttrin-save-location))) + (should (equal "Paris, FR" (wttrin--resolve-location-query "Home"))))) + +(ert-deftest test-wttrin-saved-locations-normal-rename-interactive () + "Normal: the interactive rename command prompts for the entry and new name." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))) + (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "Home")) + ((symbol-function 'read-string) (lambda (&rest _) "Casa")) + ((symbol-function 'message) (lambda (&rest _) nil))) + (call-interactively 'wttrin-rename-location)) + (should (equal "Paris, FR" (wttrin--resolve-location-query "Casa"))))) + +(ert-deftest test-wttrin-saved-locations-normal-remove-interactive () + "Normal: the interactive remove command prompts and confirms." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))) + (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "Home")) + ((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (call-interactively 'wttrin-remove-location)) + (should (null (wttrin--saved-locations))))) + +(ert-deftest test-wttrin-saved-locations-boundary-save-empty-name-cancels () + "Boundary: an empty name at the save prompt cancels without saving." + (let ((wttrin-saved-locations nil)) + (with-temp-buffer + (setq-local wttrin--current-location "Paris, FR") + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) " ")) + ((symbol-function 'message) (lambda (&rest _) nil))) + (call-interactively 'wttrin-save-location))) + (should (null (wttrin--saved-locations))))) + +;;; coordinate suppression in history + +(ert-deftest test-wttrin-saved-locations-boundary-coordinates-not-logged () + "Boundary: a raw coordinate string is never added to history." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin-saved-locations nil) + (wttrin--location-history nil)) + (wttrin--add-to-location-history "41.37,-71.83") + (should (null wttrin--location-history))) + (testutil-wttrin-teardown))) + +;;; history stays in sync with the directory + +(ert-deftest test-wttrin-saved-locations-normal-save-drops-query-from-history () + "Normal: saving a location drops its query from history, so the place lives in +the directory only and does not also appear as a separate history candidate." + (let ((wttrin-saved-locations nil) + (wttrin--location-history '("New Orleans" "Paris"))) + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-save-location "Home" "New Orleans")) + (should-not (member "New Orleans" wttrin--location-history)) + (should (member "Paris" wttrin--location-history)))) + +(ert-deftest test-wttrin-saved-locations-normal-d-alias-drops-query-from-history () + "Normal: making an aliased location the default drops its underlying query from +history, so the place does not also linger as a separate history candidate." + (let ((wttrin-saved-locations nil) + (wttrin-favorite-location nil) + (wttrin-mode-line-mode nil) + (wttrin--location-history '("New Orleans" "Paris"))) + (with-temp-buffer + (setq-local wttrin--current-location "New Orleans") + (setq-local wttrin--current-display "Home") + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-make-default))) + (should (equal "Home" wttrin-favorite-location)) + (should (assoc "Home" (wttrin--saved-locations))) + (should-not (member "New Orleans" wttrin--location-history)) + (should (member "Paris" wttrin--location-history)))) + +(ert-deftest test-wttrin-saved-locations-normal-remove-forgets-history () + "Normal: removing a saved location drops both its name and its query from +history, so a removed place does not resurface as a history candidate." + (let ((wttrin-saved-locations '(("Home" . "New Orleans"))) + (wttrin--location-history '("Home" "New Orleans" "Paris"))) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location "Home")) + (should-not (member "Home" wttrin--location-history)) + (should-not (member "New Orleans" wttrin--location-history)) + (should (member "Paris" wttrin--location-history)))) + +(provide 'test-wttrin-saved-locations) +;;; test-wttrin-saved-locations.el ends here diff --git a/tests/test-wttrin-set-location-from-geolocation.el b/tests/test-wttrin-set-location-from-geolocation.el index 170d0fb..f16b2ae 100644 --- a/tests/test-wttrin-set-location-from-geolocation.el +++ b/tests/test-wttrin-set-location-from-geolocation.el @@ -65,6 +65,29 @@ (should (string= "Pre-existing, Place" wttrin-favorite-location))) (test-wttrin-set-location-from-geolocation-teardown))) +(ert-deftest test-wttrin-set-location-from-geolocation-normal-confirm-refreshes-mode-line () + "Normal: a confirmed detection refreshes the mode-line so it tracks the new +favorite immediately instead of at the next scheduled fetch." + (test-wttrin-set-location-from-geolocation-setup) + (setq wttrin-favorite-location "Pre-existing, Place") + (unwind-protect + (let ((wttrin-geolocation-enabled t) + (wttrin-mode-line-mode t) + (wttrin--location-history nil) + (fetched nil)) + (cl-letf (((symbol-function 'wttrin-geolocation-detect) + (lambda (callback) (funcall callback "Berkeley, California"))) + ((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil)) + ((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil))) + (wttrin-set-location-from-geolocation)) + (should (string= "Berkeley, California" wttrin-favorite-location)) + (should fetched)) + (test-wttrin-set-location-from-geolocation-teardown))) + ;;; Boundary Cases (ert-deftest test-wttrin-set-location-from-geolocation-boundary-unicode-location () @@ -118,5 +141,34 @@ messages))) (test-wttrin-set-location-from-geolocation-teardown))) +;;; Opt-out + +(ert-deftest test-wttrin-set-location-from-geolocation-boundary-disabled-no-detect () + "Boundary: with geolocation disabled, the command neither detects nor sets." + (test-wttrin-set-location-from-geolocation-setup) + (setq wttrin-favorite-location "Pre-existing, Place") + (unwind-protect + (let ((detected nil) + (wttrin-geolocation-enabled nil)) + (cl-letf (((symbol-function 'wttrin-geolocation-detect) + (lambda (_cb) (setq detected t))) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-set-location-from-geolocation)) + (should-not detected) + (should (string= "Pre-existing, Place" wttrin-favorite-location))) + (test-wttrin-set-location-from-geolocation-teardown))) + +;;; Deprecation + +(ert-deftest test-wttrin-set-location-from-geolocation-normal-marked-obsolete () + "Normal: the command is marked obsolete with a steering message. +The favorite-setting behavior is preserved (see the Normal cases above); +this only asserts the obsolescence marker so callers get a deprecation +notice steering them to the picker." + (let ((info (get 'wttrin-set-location-from-geolocation 'byte-obsolete-info))) + (should info) + ;; Option 1: a steering string, not an alias to another function. + (should (stringp (nth 0 info))))) + (provide 'test-wttrin-set-location-from-geolocation) ;;; test-wttrin-set-location-from-geolocation.el ends here diff --git a/tests/test-wttrin-use-current-location.el b/tests/test-wttrin-use-current-location.el new file mode 100644 index 0000000..4b61657 --- /dev/null +++ b/tests/test-wttrin-use-current-location.el @@ -0,0 +1,94 @@ +;;; test-wttrin-use-current-location.el --- Tests for wttrin-use-current-location -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the `wttrin-use-current-location' command, the labeled way to +;; set `wttrin-favorite-location' to t (always auto-detect) instead of typing +;; the bare symbol. Mocks `yes-or-no-p' and `message'; touches no network. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) + +;;; Setup and Teardown + +(defvar test-wttrin-use-current-location--saved nil + "Snapshot of `wttrin-favorite-location' restored in teardown.") + +(defun test-wttrin-use-current-location-setup () + "Snapshot `wttrin-favorite-location' and clear it." + (setq test-wttrin-use-current-location--saved wttrin-favorite-location) + (setq wttrin-favorite-location nil)) + +(defun test-wttrin-use-current-location-teardown () + "Restore `wttrin-favorite-location'." + (setq wttrin-favorite-location test-wttrin-use-current-location--saved)) + +;;; Normal Cases + +(ert-deftest test-wttrin-use-current-location-normal-confirm-sets-t () + "Normal: confirming sets the favorite to t (auto-detect)." + (test-wttrin-use-current-location-setup) + (unwind-protect + (let ((wttrin-geolocation-enabled t)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-use-current-location)) + (should (eq t wttrin-favorite-location))) + (test-wttrin-use-current-location-teardown))) + +(ert-deftest test-wttrin-use-current-location-normal-decline-leaves-unchanged () + "Normal: declining leaves the favorite untouched." + (test-wttrin-use-current-location-setup) + (setq wttrin-favorite-location "Berkeley, CA") + (unwind-protect + (let ((wttrin-geolocation-enabled t)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-use-current-location)) + (should (equal "Berkeley, CA" wttrin-favorite-location))) + (test-wttrin-use-current-location-teardown))) + +(ert-deftest test-wttrin-use-current-location-normal-confirm-refreshes-mode-line () + "Normal: confirming refreshes the mode-line so it switches to the current +location immediately rather than at the next scheduled fetch." + (test-wttrin-use-current-location-setup) + (setq wttrin-favorite-location "Berkeley, CA") + (unwind-protect + (let ((wttrin-geolocation-enabled t) + (wttrin-mode-line-mode t) + (wttrin--location-history nil) + (fetched nil)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil)) + ((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil))) + (wttrin-use-current-location)) + (should (eq t wttrin-favorite-location)) + (should fetched)) + (test-wttrin-use-current-location-teardown))) + +;;; Boundary / Error Cases + +(ert-deftest test-wttrin-use-current-location-boundary-disabled-no-prompt-no-set () + "Boundary: with geolocation disabled, no prompt and the favorite is unchanged." + (test-wttrin-use-current-location-setup) + (setq wttrin-favorite-location "Berkeley, CA") + (unwind-protect + (let ((prompted nil) + (wttrin-geolocation-enabled nil)) + (cl-letf (((symbol-function 'yes-or-no-p) + (lambda (&rest _) (setq prompted t) t)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-use-current-location)) + (should-not prompted) + (should (equal "Berkeley, CA" wttrin-favorite-location))) + (test-wttrin-use-current-location-teardown))) + +(provide 'test-wttrin-use-current-location) +;;; test-wttrin-use-current-location.el ends here diff --git a/tests/testutil-wttrin.el b/tests/testutil-wttrin.el index 7c71a84..e4e2e4e 100644 --- a/tests/testutil-wttrin.el +++ b/tests/testutil-wttrin.el @@ -111,6 +111,20 @@ (funcall callback nil))))) ,@body)) +;;; Message Capture Helpers + +(defmacro testutil-wttrin-with-captured-message (msg-var &rest body) + "Run BODY with `message' captured into MSG-VAR. +MSG-VAR starts nil and is set to each formatted message string as `message' +is called, so after BODY it holds the last message shown (or nil if none). +Other mocks BODY needs can be set in a nested `cl-letf'." + (declare (indent 1)) + `(let ((,msg-var nil)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) + (setq ,msg-var (apply #'format fmt args))))) + ,@body))) + ;;; Mode-line Cache Helpers (defun testutil-wttrin-set-mode-line-cache (data &optional age-seconds) |