diff options
| author | Craig Jennings <c@cjennings.net> | 2026-04-28 18:10:17 -0500 |
|---|---|---|
| committer | Craig Jennings <c@cjennings.net> | 2026-04-28 19:09:22 -0500 |
| commit | dc0db0f0e12d8af6d1d54a5dde1cd16cf890a33d (patch) | |
| tree | 9d174e136d62981c1bded06fe423d08bddc91e04 /tests/test-gloss-fetch--libxml-probe.el | |
| parent | 3a846506399dc12ab219bfa8047947c122dd1d04 (diff) | |
| download | gloss-dc0db0f0e12d8af6d1d54a5dde1cd16cf890a33d.tar.gz gloss-dc0db0f0e12d8af6d1d54a5dde1cd16cf890a33d.zip | |
test: add gloss-fetch test suite (red phase)
Eight test files cover the network layer's public and internal contract.
The boundary mock is `url-retrieve-synchronously', wrapped by a small
`testutil-gloss-fetch' helper that builds response buffers in the shape
the url library returns.
Tests cover the 200 happy paths (anaphora and SBIR fixtures), 404 to
:no-defs, 5xx and 4xx-other and malformed JSON to :server-error, 429 to
:rate-limited, nil-from-url to :unreachable, the libxml availability
probe (one-shot, signals user-error when absent), the registry walker
ordering, and the pure HTML strip helper across N/B/E.
Tests fail on missing `gloss-fetch--*' functions, as expected for red
phase.
Diffstat (limited to 'tests/test-gloss-fetch--libxml-probe.el')
| -rw-r--r-- | tests/test-gloss-fetch--libxml-probe.el | 62 |
1 files changed, 62 insertions, 0 deletions
diff --git a/tests/test-gloss-fetch--libxml-probe.el b/tests/test-gloss-fetch--libxml-probe.el new file mode 100644 index 0000000..830a278 --- /dev/null +++ b/tests/test-gloss-fetch--libxml-probe.el @@ -0,0 +1,62 @@ +;;; test-gloss-fetch--libxml-probe.el --- libxml availability probe tests -*- lexical-binding: t -*- + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: +;; libxml is a precondition for online fetch. First call probes once; +;; absent libxml triggers a one-shot `user-error' and disables online +;; fetch package-wide for the session. Subsequent attempts in the same +;; session also signal `user-error'. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'gloss-fetch) +(require 'testutil-gloss-fetch) + +(ert-deftest test-gloss-fetch-libxml-absent-signals-user-error () + "Error: with libxml unavailable, the first fetch signals user-error and disables online." + (let ((gloss-fetch--libxml-disabled nil)) + (cl-letf (((symbol-function 'gloss-fetch--libxml-available-p) + (lambda () nil))) + (should-error (gloss-fetch-definitions "anything") :type 'user-error) + ;; Subsequent attempts also signal — no auto-recovery in the same session. + (should-error (gloss-fetch-definitions "again") :type 'user-error)))) + +(ert-deftest test-gloss-fetch-libxml-error-mentions-libxml2 () + "Error: the user-error message names libxml2 so the user can act." + (let ((gloss-fetch--libxml-disabled nil)) + (cl-letf (((symbol-function 'gloss-fetch--libxml-available-p) + (lambda () nil))) + (let ((err (should-error (gloss-fetch-definitions "x") :type 'user-error))) + (should (string-match-p "libxml2" (error-message-string err))))))) + +(ert-deftest test-gloss-fetch-libxml-probe-runs-only-once () + "Boundary: the libxml availability probe is invoked at most once per session." + (let ((probe-calls 0) + (gloss-fetch--libxml-disabled nil) + (gloss-fetch--libxml-checked nil)) + (cl-letf (((symbol-function 'gloss-fetch--libxml-available-p) + (lambda () (cl-incf probe-calls) t))) + (gloss-fetch-test--with-mocked-url + (lambda (_url) (gloss-fetch-test--ok-response "{}")) + (gloss-fetch-definitions "first") + (gloss-fetch-definitions "second") + (gloss-fetch-definitions "third")) + (should (= 1 probe-calls))))) + +(ert-deftest test-gloss-fetch-libxml-present-allows-fetch () + "Normal: when libxml is available, fetch proceeds normally." + (let ((gloss-fetch--libxml-disabled nil) + (gloss-fetch--libxml-checked nil)) + (cl-letf (((symbol-function 'gloss-fetch--libxml-available-p) + (lambda () t))) + (gloss-fetch-test--with-mocked-url + (lambda (_url) (gloss-fetch-test--ok-response "{}")) + (let ((result (gloss-fetch-definitions "term"))) + (should (eq (car result) :empty)) + (should (member 'wiktionary (plist-get result :no-defs)))))))) + +(provide 'test-gloss-fetch--libxml-probe) +;;; test-gloss-fetch--libxml-probe.el ends here |
