aboutsummaryrefslogtreecommitdiff
path: root/archive/gptel/tests/test-gptel-tools-web-fetch.el
diff options
context:
space:
mode:
authorCraig Jennings <c@cjennings.net>2026-06-23 20:12:58 -0400
committerCraig Jennings <c@cjennings.net>2026-06-23 20:12:58 -0400
commit10fa6f4e2e7150ad99827721ada1ae4badcc5e90 (patch)
tree960065c8e69f1e7a4150ecf522e2f813c239b5ee /archive/gptel/tests/test-gptel-tools-web-fetch.el
parentf4cc70c69e7707dd4a686637e14885f5443fcca6 (diff)
downloaddotemacs-10fa6f4e2e7150ad99827721ada1ae4badcc5e90.tar.gz
dotemacs-10fa6f4e2e7150ad99827721ada1ae4badcc5e90.zip
chore(ai): archive gptel and remove it from the live config
I archived gptel to archive/gptel/ since I rarely use it. Moved there: the six gptel modules (ai-config, ai-conversations, ai-conversations-browser, ai-mcp, ai-quick-ask, ai-rewrite), the gptel-tools/ directory, custom/gptel-prompts.el, their test files and utilities, and the four gptel-only specs. Scrubbed from the live config: the ai-config require in init.el, which also drops the whole C-; a keymap; the gptel-mode emojify hook in font-config.el; the gptel-tools entries in the Makefile clean target and the coverage runner; and the gptel feature notes in README. Cancelled the open gptel tasks in todo.org (the AI Open Work issues, the feature-extension brainstorm, the velox gptel-magit bug). ai-term stays. It is the ghostel Claude launcher, independent of gptel. Verified: every module loads, a batch init launch reaches completion clean, and the full test suite shows only pre-existing coverage failures unrelated to this change.
Diffstat (limited to 'archive/gptel/tests/test-gptel-tools-web-fetch.el')
-rw-r--r--archive/gptel/tests/test-gptel-tools-web-fetch.el230
1 files changed, 230 insertions, 0 deletions
diff --git a/archive/gptel/tests/test-gptel-tools-web-fetch.el b/archive/gptel/tests/test-gptel-tools-web-fetch.el
new file mode 100644
index 00000000..10abe6eb
--- /dev/null
+++ b/archive/gptel/tests/test-gptel-tools-web-fetch.el
@@ -0,0 +1,230 @@
+;;; test-gptel-tools-web-fetch.el --- Tests for web_fetch gptel tool -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; Validators and helpers tested directly. The orchestrator's network
+;; call is stubbed via `cl-letf' on `url-retrieve-synchronously' / the
+;; module's `--retrieve' helper; HTML stripping runs against real
+;; pandoc / w3m (both are installed in this dev environment, and
+;; verifying they don't mangle inputs is the point).
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+
+(eval-and-compile
+ (add-to-list 'load-path (expand-file-name "tests" user-emacs-directory))
+ (add-to-list 'load-path (expand-file-name "gptel-tools" user-emacs-directory))
+ (setq load-prefer-newer t)
+ (unless (featurep 'gptel)
+ (defvar gptel-tools nil)
+ (defun gptel-make-tool (&rest _args) nil)
+ (defun gptel-get-tool (&rest _args) nil)
+ (provide 'gptel)))
+
+(require 'web_fetch)
+
+;; ---------- validate-url
+
+(ert-deftest test-gptel-tools-web-fetch-validate-url-http ()
+ "Normal: http URL passes."
+ (should (equal (cj/gptel-web-fetch--validate-url "http://example.com")
+ "http://example.com")))
+
+(ert-deftest test-gptel-tools-web-fetch-validate-url-https ()
+ "Normal: https URL passes."
+ (should (equal (cj/gptel-web-fetch--validate-url "https://example.com/path")
+ "https://example.com/path")))
+
+(ert-deftest test-gptel-tools-web-fetch-validate-url-error-non-string ()
+ "Error: non-string URL signals."
+ (should-error (cj/gptel-web-fetch--validate-url nil))
+ (should-error (cj/gptel-web-fetch--validate-url 42)))
+
+(ert-deftest test-gptel-tools-web-fetch-validate-url-error-empty ()
+ "Error: empty URL signals."
+ (should-error (cj/gptel-web-fetch--validate-url "")))
+
+(ert-deftest test-gptel-tools-web-fetch-validate-url-error-non-http-scheme ()
+ "Error: schemes other than http/https are rejected."
+ (should-error (cj/gptel-web-fetch--validate-url "file:///etc/hostname"))
+ (should-error (cj/gptel-web-fetch--validate-url "ftp://example.com"))
+ (should-error (cj/gptel-web-fetch--validate-url "javascript:alert(1)"))
+ (should-error (cj/gptel-web-fetch--validate-url "example.com"))) ; no scheme
+
+;; ---------- effective-max-bytes
+
+(ert-deftest test-gptel-tools-web-fetch-max-bytes-default-on-nil ()
+ "Boundary: nil falls back to the default cap."
+ (should (= (cj/gptel-web-fetch--effective-max-bytes nil)
+ cj/gptel-web-fetch--default-max-bytes)))
+
+(ert-deftest test-gptel-tools-web-fetch-max-bytes-clamp-low ()
+ "Boundary: zero / negative fall back to the default."
+ (should (= (cj/gptel-web-fetch--effective-max-bytes 0)
+ cj/gptel-web-fetch--default-max-bytes))
+ (should (= (cj/gptel-web-fetch--effective-max-bytes -1)
+ cj/gptel-web-fetch--default-max-bytes)))
+
+(ert-deftest test-gptel-tools-web-fetch-max-bytes-cap-high ()
+ "Boundary: values above the hard cap are clamped."
+ (should (= (cj/gptel-web-fetch--effective-max-bytes (* 10 1024 1024))
+ cj/gptel-web-fetch--hard-max-bytes)))
+
+(ert-deftest test-gptel-tools-web-fetch-max-bytes-normal ()
+ "Normal: a sensible value passes through."
+ (should (= (cj/gptel-web-fetch--effective-max-bytes 50000) 50000)))
+
+;; ---------- truncate
+
+(ert-deftest test-gptel-tools-web-fetch-truncate-under-cap ()
+ "Normal: small input returns unchanged."
+ (should (equal (cj/gptel-web-fetch--truncate "short" 1000) "short")))
+
+(ert-deftest test-gptel-tools-web-fetch-truncate-at-cap ()
+ "Boundary: input exactly at cap returns unchanged."
+ (let ((s (make-string 10 ?x)))
+ (should (equal (cj/gptel-web-fetch--truncate s 10) s))))
+
+(ert-deftest test-gptel-tools-web-fetch-truncate-over-cap ()
+ "Boundary: oversize input is truncated and marked."
+ (let* ((s (make-string 1000 ?x))
+ (out (cj/gptel-web-fetch--truncate s 100)))
+ (should (string-match-p "\\[truncated:" out))
+ (should (string-match-p "1000 bytes total" out))))
+
+;; ---------- html-to-text
+
+(ert-deftest test-gptel-tools-web-fetch-html-to-text-strips-tags ()
+ "Normal: pandoc / w3m strip HTML tags from real markup."
+ (let ((out (cj/gptel-web-fetch--html-to-text
+ "<html><body><h1>Hello</h1><p>World</p></body></html>")))
+ (should (string-match-p "Hello" out))
+ (should (string-match-p "World" out))
+ (should-not (string-match-p "<h1>" out))
+ (should-not (string-match-p "<p>" out))))
+
+(ert-deftest test-gptel-tools-web-fetch-html-to-text-error-when-neither-on-path ()
+ "Error: when neither pandoc nor w3m is on PATH, signals user-error."
+ (cl-letf (((symbol-function 'executable-find) (lambda (_ &rest _) nil)))
+ (should-error (cj/gptel-web-fetch--html-to-text "<p>x</p>"))))
+
+(ert-deftest test-gptel-tools-web-fetch-html-to-text-error-on-tool-failure ()
+ "Error: a failing HTML stripping command is reported."
+ (cl-letf (((symbol-function 'executable-find)
+ (lambda (program &rest _) (and (equal program "pandoc") "/bin/pandoc")))
+ ((symbol-function 'call-process-region)
+ (lambda (&rest _args) 9)))
+ (should-error (cj/gptel-web-fetch--html-to-text "<p>x</p>"))))
+
+(ert-deftest test-gptel-tools-web-fetch-html-to-text-falls-back-to-w3m ()
+ "Boundary: w3m is used when pandoc is unavailable."
+ (let (called-program)
+ (cl-letf (((symbol-function 'executable-find)
+ (lambda (program &rest _) (and (equal program "w3m") "/bin/w3m")))
+ ((symbol-function 'call-process-region)
+ (lambda (start end program delete output display &rest _args)
+ (setq called-program program)
+ (should delete)
+ (should output)
+ (should-not display)
+ (delete-region start end)
+ (insert "w3m text")
+ 0)))
+ (should (equal (cj/gptel-web-fetch--html-to-text "<p>x</p>")
+ "w3m text"))
+ (should (equal called-program "w3m")))))
+
+;; ---------- retrieve
+
+(ert-deftest test-gptel-tools-web-fetch-retrieve-normal-crlf-headers ()
+ "Normal: retrieval parses status and body after CRLF headers."
+ (let ((buffer (generate-new-buffer " *web-fetch-crlf*")))
+ (with-current-buffer buffer
+ (insert "HTTP/1.1 201 Created\r\nContent-Type: text/plain\r\n\r\nhello"))
+ (cl-letf (((symbol-function 'url-retrieve-synchronously)
+ (lambda (&rest _args) buffer)))
+ (should (equal (cj/gptel-web-fetch--retrieve "https://example.com")
+ '(201 . "hello"))))
+ (should-not (buffer-live-p buffer))))
+
+(ert-deftest test-gptel-tools-web-fetch-retrieve-boundary-lf-headers ()
+ "Boundary: retrieval also handles LF-only headers."
+ (let ((buffer (generate-new-buffer " *web-fetch-lf*")))
+ (with-current-buffer buffer
+ (insert "HTTP/1.1 200 OK\nContent-Type: text/plain\n\nhello"))
+ (cl-letf (((symbol-function 'url-retrieve-synchronously)
+ (lambda (&rest _args) buffer)))
+ (should (equal (cj/gptel-web-fetch--retrieve "https://example.com")
+ '(200 . "hello"))))))
+
+(ert-deftest test-gptel-tools-web-fetch-retrieve-boundary-no-header-separator ()
+ "Boundary: unseparated responses return the full buffer as body."
+ (let ((buffer (generate-new-buffer " *web-fetch-no-separator*")))
+ (with-current-buffer buffer
+ (insert "not an http response"))
+ (cl-letf (((symbol-function 'url-retrieve-synchronously)
+ (lambda (&rest _args) buffer)))
+ (should (equal (cj/gptel-web-fetch--retrieve "https://example.com")
+ '(nil . "not an http response"))))))
+
+(ert-deftest test-gptel-tools-web-fetch-retrieve-error-no-response ()
+ "Error: nil retrieval buffer signals network failure."
+ (cl-letf (((symbol-function 'url-retrieve-synchronously)
+ (lambda (&rest _args) nil)))
+ (should-error (cj/gptel-web-fetch--retrieve "https://example.com"))))
+
+;; ---------- run (orchestrator)
+
+(ert-deftest test-gptel-tools-web-fetch-run-normal-strips-html ()
+ "Normal: orchestrator returns stripped text by default."
+ (cl-letf (((symbol-function 'cj/gptel-web-fetch--retrieve)
+ (lambda (_url)
+ (cons 200 "<html><body><p>fetched</p></body></html>"))))
+ (let ((out (cj/gptel-web-fetch--run "https://example.com")))
+ (should (string-match-p "fetched" out))
+ (should-not (string-match-p "<p>" out)))))
+
+(ert-deftest test-gptel-tools-web-fetch-run-raw-returns-body-verbatim ()
+ "Normal: raw=t returns the response body without HTML stripping."
+ (cl-letf (((symbol-function 'cj/gptel-web-fetch--retrieve)
+ (lambda (_url)
+ (cons 200 "<html><body><p>raw</p></body></html>"))))
+ (let ((out (cj/gptel-web-fetch--run "https://example.com" t)))
+ (should (string-match-p "<p>raw</p>" out)))))
+
+(ert-deftest test-gptel-tools-web-fetch-run-error-on-4xx ()
+ "Error: HTTP 4xx response signals."
+ (cl-letf (((symbol-function 'cj/gptel-web-fetch--retrieve)
+ (lambda (_url) (cons 404 "not found"))))
+ (should-error (cj/gptel-web-fetch--run "https://example.com"))))
+
+(ert-deftest test-gptel-tools-web-fetch-run-error-on-5xx ()
+ "Error: HTTP 5xx response signals."
+ (cl-letf (((symbol-function 'cj/gptel-web-fetch--retrieve)
+ (lambda (_url) (cons 503 "service unavailable"))))
+ (should-error (cj/gptel-web-fetch--run "https://example.com"))))
+
+(ert-deftest test-gptel-tools-web-fetch-run-boundary-nil-status ()
+ "Boundary: an unparseable status line does not trigger HTTP error handling."
+ (cl-letf (((symbol-function 'cj/gptel-web-fetch--retrieve)
+ (lambda (_url) (cons nil "raw body"))))
+ (should (equal (cj/gptel-web-fetch--run "https://example.com" t)
+ "raw body"))))
+
+(ert-deftest test-gptel-tools-web-fetch-run-truncates-oversized-body ()
+ "Boundary: an oversize body is truncated by the run wrapper."
+ (let ((big (concat "<html><body>"
+ (make-string 1000 ?x)
+ "</body></html>")))
+ (cl-letf (((symbol-function 'cj/gptel-web-fetch--retrieve)
+ (lambda (_url) (cons 200 big))))
+ (let ((out (cj/gptel-web-fetch--run "https://example.com" t 200)))
+ (should (string-match-p "\\[truncated:" out))))))
+
+(ert-deftest test-gptel-tools-web-fetch-run-error-on-bad-scheme ()
+ "Error: non-http URL fails fast at the validator."
+ (should-error (cj/gptel-web-fetch--run "file:///etc/passwd")))
+
+(provide 'test-gptel-tools-web-fetch)
+;;; test-gptel-tools-web-fetch.el ends here