From 2f469404a4ef8bd0e8cdf776a5d25ba04b63febb Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Sun, 21 Jun 2026 08:03:30 -0400 Subject: feat: add typed error hierarchy for fetch failures Define a wttrin-error condition with children wttrin-invalid-input, wttrin-network-error, wttrin-not-found-error, wttrin-service-error, and wttrin-parse-error, so callers branch on the class of a failure instead of matching message text. Synchronous paths signal these directly: a nil query and an unknown geolocation provider now raise wttrin-invalid-input. The async fetch path can't signal across its callback, so it tags the error string with the class via a wttrin-error-type text property. The wttrin-error-message-type accessor reads it back, and two-arg callbacks are untouched. Retyping the classifier also closed two gaps: a missing status and a 2xx with an empty body used to go silent or get mislabeled "Unexpected HTTP status". Both are now parse errors. wttrin-geolocation.el now requires wttrin for the shared conditions. It's only ever loaded through wttrin, so the require is a no-op in practice and just makes the dependency explicit. --- tests/test-wttrin-error-types.el | 128 ++++++++++++++++++++++++++++ tests/test-wttrin-geolocation--internals.el | 6 +- 2 files changed, 132 insertions(+), 2 deletions(-) create mode 100644 tests/test-wttrin-error-types.el (limited to 'tests') 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-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 -- cgit v1.2.3