diff options
| author | Craig Jennings <c@cjennings.net> | 2026-06-23 20:12:58 -0400 |
|---|---|---|
| committer | Craig Jennings <c@cjennings.net> | 2026-06-23 20:12:58 -0400 |
| commit | e41c25068d0cec9434895a6d3e3a25d3a26f645f (patch) | |
| tree | 5e30938a3fd6d80f501ffe3e6c1c187c5ddeb2c9 /archive/gptel/tests | |
| parent | a936e081b7270fbd4f1e7e9cb67ca1d4c2291ce6 (diff) | |
| download | dotemacs-e41c25068d0cec9434895a6d3e3a25d3a26f645f.tar.gz dotemacs-e41c25068d0cec9434895a6d3e3a25d3a26f645f.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')
31 files changed, 5218 insertions, 0 deletions
diff --git a/archive/gptel/tests/test-ai-config--apply-model-selection.el b/archive/gptel/tests/test-ai-config--apply-model-selection.el new file mode 100644 index 000000000..4ccd6d7a0 --- /dev/null +++ b/archive/gptel/tests/test-ai-config--apply-model-selection.el @@ -0,0 +1,45 @@ +;;; test-ai-config--apply-model-selection.el --- Tests for cj/--gptel-apply-model-selection -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--gptel-apply-model-selection is the apply step extracted from the +;; interactive cj/gptel-change-model: it sets gptel-backend/gptel-model globally +;; or buffer-locally and returns the confirmation message. The extraction also +;; dropped a dead `(if (stringp model) ...)' branch (model is always a symbol by +;; that point). + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-config) + +(defvar gptel-backend) +(defvar gptel-model) + +(ert-deftest test-ai-config-apply-model-global-sets-globals () + "Normal: global scope assigns the global vars and reports (global)." + (let ((gptel-backend nil) (gptel-model nil)) + (let ((msg (cj/--gptel-apply-model-selection "global" 'mybackend 'mymodel "MyAI"))) + (should (eq gptel-backend 'mybackend)) + (should (eq gptel-model 'mymodel)) + (should (string-match-p "MyAI" msg)) + (should (string-match-p "mymodel" msg)) + (should (string-match-p "global" msg))))) + +(ert-deftest test-ai-config-apply-model-buffer-sets-buffer-locals () + "Normal: buffer scope makes the vars buffer-local and reports (buffer-local)." + (let ((gptel-backend 'orig) (gptel-model 'origm)) + (with-temp-buffer + (let ((msg (cj/--gptel-apply-model-selection "buffer" 'be 'mo "Name"))) + (should (local-variable-p 'gptel-backend)) + (should (local-variable-p 'gptel-model)) + (should (eq gptel-backend 'be)) + (should (eq gptel-model 'mo)) + (should (string-match-p "buffer-local" msg)))) + ;; outside the temp buffer the globals are untouched + (should (eq gptel-backend 'orig)) + (should (eq gptel-model 'origm)))) + +(provide 'test-ai-config--apply-model-selection) +;;; test-ai-config--apply-model-selection.el ends here diff --git a/archive/gptel/tests/test-ai-config-auth-source-secret.el b/archive/gptel/tests/test-ai-config-auth-source-secret.el new file mode 100644 index 000000000..bab506e5f --- /dev/null +++ b/archive/gptel/tests/test-ai-config-auth-source-secret.el @@ -0,0 +1,27 @@ +;;; test-ai-config-auth-source-secret.el --- Tests for the required-secret wrapper -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/auth-source-secret' is the required-secret layer over the shared +;; `cj/auth-source-secret-value' primitive: it returns the secret, or errors +;; when none is found. These tests stub the primitive to exercise both paths. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-config) + +(ert-deftest test-ai-config-auth-source-secret-returns-value () + "Normal: returns the value the primitive resolves." + (cl-letf (((symbol-function 'cj/auth-source-secret-value) (lambda (&rest _) "sk-x"))) + (should (equal "sk-x" (cj/auth-source-secret "api.example.com" "apikey"))))) + +(ert-deftest test-ai-config-auth-source-secret-errors-on-miss () + "Error: signals when the primitive finds no secret." + (cl-letf (((symbol-function 'cj/auth-source-secret-value) (lambda (&rest _) nil))) + (should-error (cj/auth-source-secret "api.example.com" "apikey")))) + +(provide 'test-ai-config-auth-source-secret) +;;; test-ai-config-auth-source-secret.el ends here diff --git a/archive/gptel/tests/test-ai-config-backend-and-model.el b/archive/gptel/tests/test-ai-config-backend-and-model.el new file mode 100644 index 000000000..c03c58a2d --- /dev/null +++ b/archive/gptel/tests/test-ai-config-backend-and-model.el @@ -0,0 +1,78 @@ +;;; test-ai-config-backend-and-model.el --- Tests for cj/gptel-backend-and-model -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/gptel-backend-and-model from ai-config.el. +;; +;; Returns a formatted string "backend: model [timestamp]" for use in +;; org headings marking AI responses. Uses pcase to extract the display +;; name from vector backends, falling back to "AI" otherwise. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'testutil-ai-config) +(require 'ai-config) + +;;; Normal Cases + +(ert-deftest test-ai-config-backend-and-model-normal-vector-backend-extracts-name () + "Vector backend should use element at index 1 as display name." + (let ((gptel-backend (vector 'cl-struct "Claude")) + (gptel-model "claude-opus-4-6")) + (let ((result (cj/gptel-backend-and-model))) + (should (string-match-p "^Claude:" result)) + (should (string-match-p "claude-opus-4-6" result))))) + +(ert-deftest test-ai-config-backend-and-model-normal-contains-timestamp () + "Result should contain a bracketed timestamp." + (let ((gptel-backend nil) + (gptel-model nil)) + (should (string-match-p "\\[[-0-9]+ [0-9]+:[0-9]+:[0-9]+\\]" + (cj/gptel-backend-and-model))))) + +(ert-deftest test-ai-config-backend-and-model-normal-format-structure () + "Result should follow 'backend: model [timestamp]' format." + (let ((gptel-backend (vector 'cl-struct "TestBackend")) + (gptel-model "test-model")) + (should (string-match-p "^TestBackend: test-model \\[" + (cj/gptel-backend-and-model))))) + +;;; Boundary Cases + +(ert-deftest test-ai-config-backend-and-model-boundary-nil-backend-shows-ai () + "Nil backend should fall back to \"AI\" display name." + (let ((gptel-backend nil) + (gptel-model "some-model")) + (should (string-match-p "^AI:" (cj/gptel-backend-and-model))))) + +(ert-deftest test-ai-config-backend-and-model-boundary-nil-model-shows-empty () + "Nil model should produce empty string in model position." + (let ((gptel-backend nil) + (gptel-model nil)) + (should (string-match-p "^AI: \\[" (cj/gptel-backend-and-model))))) + +(ert-deftest test-ai-config-backend-and-model-boundary-string-backend-shows-ai () + "String backend (not vector) should fall back to \"AI\"." + (let ((gptel-backend "just-a-string") + (gptel-model "model")) + (should (string-match-p "^AI:" (cj/gptel-backend-and-model))))) + +(ert-deftest test-ai-config-backend-and-model-boundary-symbol-model-formatted () + "Symbol model should be formatted as its print representation." + (let ((gptel-backend nil) + (gptel-model 'some-model)) + (should (string-match-p "some-model" (cj/gptel-backend-and-model))))) + +(ert-deftest test-ai-config-backend-and-model-boundary-timestamp-reflects-today () + "Timestamp should contain today's date." + (let ((gptel-backend nil) + (gptel-model nil) + (today (format-time-string "%Y-%m-%d"))) + (should (string-match-p (regexp-quote today) + (cj/gptel-backend-and-model))))) + +(provide 'test-ai-config-backend-and-model) +;;; test-ai-config-backend-and-model.el ends here diff --git a/archive/gptel/tests/test-ai-config-build-model-list.el b/archive/gptel/tests/test-ai-config-build-model-list.el new file mode 100644 index 000000000..827036038 --- /dev/null +++ b/archive/gptel/tests/test-ai-config-build-model-list.el @@ -0,0 +1,101 @@ +;;; test-ai-config-build-model-list.el --- Tests for cj/gptel--build-model-list -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/gptel--build-model-list from ai-config.el. +;; +;; Pure function that takes a backends alist and a model-fetching function, +;; and produces a flat list of (DISPLAY-STRING BACKEND MODEL-STRING BACKEND-NAME) +;; entries suitable for completing-read. Exercises the mapping and string +;; formatting logic that was previously embedded in cj/gptel-change-model. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'testutil-ai-config) +(require 'ai-config) + +;;; Normal Cases + +(ert-deftest test-ai-config-build-model-list-normal-single-backend-single-model () + "One backend with one model should produce one entry." + (let* ((backend-obj 'fake-backend) + (backends `(("Claude" . ,backend-obj))) + (result (cj/gptel--build-model-list backends (lambda (_) '("opus"))))) + (should (= 1 (length result))) + (should (equal (car (nth 0 result)) "Claude: opus")) + (should (eq (nth 1 (nth 0 result)) backend-obj)) + (should (equal (nth 2 (nth 0 result)) "opus")) + (should (equal (nth 3 (nth 0 result)) "Claude")))) + +(ert-deftest test-ai-config-build-model-list-normal-single-backend-multiple-models () + "One backend with multiple models should produce one entry per model." + (let* ((backends '(("Claude" . backend-a))) + (result (cj/gptel--build-model-list + backends (lambda (_) '("opus" "sonnet" "haiku"))))) + (should (= 3 (length result))) + (should (equal (mapcar #'car result) + '("Claude: opus" "Claude: sonnet" "Claude: haiku"))))) + +(ert-deftest test-ai-config-build-model-list-normal-multiple-backends () + "Multiple backends should interleave their models in backend order." + (let* ((backends '(("Claude" . backend-a) ("OpenAI" . backend-b))) + (result (cj/gptel--build-model-list + backends + (lambda (b) + (if (eq b 'backend-a) '("opus") '("gpt-4o")))))) + (should (= 2 (length result))) + (should (equal (car (nth 0 result)) "Claude: opus")) + (should (equal (car (nth 1 result)) "OpenAI: gpt-4o")))) + +(ert-deftest test-ai-config-build-model-list-normal-preserves-backend-object () + "Each entry should carry the original backend object for later use." + (let* ((obj (vector 'struct "Claude")) + (backends `(("Claude" . ,obj))) + (result (cj/gptel--build-model-list backends (lambda (_) '("opus"))))) + (should (eq (nth 1 (nth 0 result)) obj)))) + +(ert-deftest test-ai-config-build-model-list-normal-symbol-models-converted () + "Symbol model identifiers should be converted to strings via model-to-string." + (let* ((backends '(("Claude" . backend-a))) + (result (cj/gptel--build-model-list + backends (lambda (_) '(opus sonnet))))) + (should (equal (nth 2 (nth 0 result)) "opus")) + (should (equal (nth 2 (nth 1 result)) "sonnet")))) + +;;; Boundary Cases + +(ert-deftest test-ai-config-build-model-list-boundary-empty-backends () + "Empty backends list should produce empty result." + (should (null (cj/gptel--build-model-list nil (lambda (_) '("x")))))) + +(ert-deftest test-ai-config-build-model-list-boundary-backend-with-no-models () + "Backend returning no models should contribute no entries." + (let* ((backends '(("Claude" . backend-a))) + (result (cj/gptel--build-model-list backends (lambda (_) nil)))) + (should (null result)))) + +(ert-deftest test-ai-config-build-model-list-boundary-mixed-empty-and-populated () + "Only backends with models should produce entries." + (let* ((backends '(("Claude" . backend-a) ("Empty" . backend-b) ("OpenAI" . backend-c))) + (result (cj/gptel--build-model-list + backends + (lambda (b) + (cond ((eq b 'backend-a) '("opus")) + ((eq b 'backend-b) nil) + ((eq b 'backend-c) '("gpt-4o"))))))) + (should (= 2 (length result))) + (should (equal (nth 3 (nth 0 result)) "Claude")) + (should (equal (nth 3 (nth 1 result)) "OpenAI")))) + +(ert-deftest test-ai-config-build-model-list-boundary-model-with-special-characters () + "Model names with special characters should be preserved in display string." + (let* ((backends '(("Claude" . backend-a))) + (result (cj/gptel--build-model-list + backends (lambda (_) '("claude-haiku-4-5-20251001"))))) + (should (equal (car (nth 0 result)) "Claude: claude-haiku-4-5-20251001")))) + +(provide 'test-ai-config-build-model-list) +;;; test-ai-config-build-model-list.el ends here diff --git a/archive/gptel/tests/test-ai-config-commands.el b/archive/gptel/tests/test-ai-config-commands.el new file mode 100644 index 000000000..fed06d82b --- /dev/null +++ b/archive/gptel/tests/test-ai-config-commands.el @@ -0,0 +1,160 @@ +;;; test-ai-config-commands.el --- Tests for ai-config interactive commands -*- lexical-binding: t; -*- + +;;; Commentary: +;; Sibling tests cover the pure helpers (model-to-string, build-model-list, +;; current-model-selection, fresh-org-prefix, backend-and-model). This +;; file covers the user-facing wrappers: +;; +;; cj/gptel--available-backends +;; cj/gptel-change-model +;; cj/gptel-add-file +;; cj/gptel-add-this-buffer +;; cj/toggle-gptel +;; cj/gptel-context-clear + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-config) + +;; Top-level defvars so let-bindings reach the dynamic binding under +;; lexical scope. +(defvar gptel-backend nil) +(defvar gptel-model nil) +(defvar gptel-claude-backend nil) +(defvar gptel-chatgpt-backend nil) +(defvar gptel-context--alist nil) + +;;; cj/gptel--available-backends + +(ert-deftest test-ai-available-backends-returns-claude-and-chatgpt () + "Normal: both backends present become alist entries." + (let ((gptel-claude-backend 'claude-obj) + (gptel-chatgpt-backend 'chatgpt-obj)) + (cl-letf (((symbol-function 'require) (lambda (&rest _) t)) + ((symbol-function 'cj/ensure-gptel-backends) #'ignore)) + (let ((result (cj/gptel--available-backends))) + (should (equal (assoc "Anthropic - Claude" result) + '("Anthropic - Claude" . claude-obj))) + (should (equal (assoc "OpenAI - ChatGPT" result) + '("OpenAI - ChatGPT" . chatgpt-obj))))))) + +(ert-deftest test-ai-available-backends-skips-nil-entries () + "Boundary: only configured backends appear in the alist." + (let ((gptel-claude-backend nil) + (gptel-chatgpt-backend 'chatgpt-only)) + (cl-letf (((symbol-function 'require) (lambda (&rest _) t)) + ((symbol-function 'cj/ensure-gptel-backends) #'ignore)) + (let ((result (cj/gptel--available-backends))) + (should-not (assoc "Anthropic - Claude" result)) + (should (assoc "OpenAI - ChatGPT" result)))))) + +;;; cj/gptel-change-model + +(ert-deftest test-ai-change-model-global-sets-globals-and-messages () + "Normal: choosing 'global' sets `gptel-backend' and `gptel-model' +globally and reports via `message'." + (let ((gptel-backend 'old-backend) + (gptel-model 'old-model) + (gptel-claude-backend 'claude-obj) + (gptel-chatgpt-backend nil) + msg) + (cl-letf (((symbol-function 'require) (lambda (&rest _) t)) + ((symbol-function 'cj/ensure-gptel-backends) #'ignore) + ((symbol-function 'gptel-backend-models) + (lambda (_) '("claude-opus-4-7"))) + ((symbol-function 'completing-read) + (lambda (prompt &rest _) + (if (string-prefix-p "Set model for" prompt) + "global" + "Anthropic - Claude: claude-opus-4-7"))) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (cj/gptel-change-model)) + (should (eq gptel-backend 'claude-obj)) + (should (eq gptel-model 'claude-opus-4-7)) + (should (string-match-p "global" msg)))) + +;;; cj/gptel-add-file + +(ert-deftest test-ai-add-file-outside-projectile-uses-read-file-name () + "Normal: without projectile, add-file routes through read-file-name." + (let* ((target (make-temp-file "cj-ai-add-file-" nil ".org")) + added) + (unwind-protect + (cl-letf (((symbol-function 'featurep) + (lambda (sym &rest _) (not (eq sym 'projectile)))) + ((symbol-function 'read-file-name) + (lambda (&rest _) target)) + ((symbol-function 'gptel-add-file) + (lambda (f) (setq added f))) + ((symbol-function 'message) #'ignore)) + (cj/gptel-add-file)) + (delete-file target)) + (should (equal added target)))) + +;;; cj/gptel-add-this-buffer + +(ert-deftest test-ai-add-this-buffer-calls-gptel-add-with-prefix () + "Normal: add-this-buffer calls `gptel-add' with the prefix-arg form." + (let (gptel-add-args msg) + (cl-letf (((symbol-function 'require) (lambda (&rest _) t)) + ((symbol-function 'gptel-add) + (lambda (&rest args) (setq gptel-add-args args))) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (cj/gptel-add-this-buffer)) + (should (equal gptel-add-args '((4)))) + (should (string-match-p "to GPTel context" msg)))) + +;;; cj/toggle-gptel + +(ert-deftest test-ai-toggle-gptel-hides-when-visible () + "Normal: when the AI buffer is showing in a window, toggle hides it." + (let ((buffer (get-buffer-create "*AI-Assistant*")) + deleted-window) + (unwind-protect + (cl-letf (((symbol-function 'get-buffer-window) + (lambda (&rest _) 'fake-window)) + ((symbol-function 'delete-window) + (lambda (w) (setq deleted-window w)))) + (cj/toggle-gptel)) + (kill-buffer buffer)) + (should (eq deleted-window 'fake-window)))) + +;;; cj/gptel-context-clear + +(ert-deftest test-ai-context-clear-uses-remove-all-when-available () + "Normal: with `gptel-context-remove-all' present, it is called." + (let (called msg) + (cl-letf (((symbol-function 'gptel-context-remove-all) + (lambda () (setq called t))) + ((symbol-function 'call-interactively) + (lambda (fn &rest _) (funcall fn))) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (cj/gptel-context-clear)) + (should called) + (should (string-match-p "cleared" msg)))) + +(ert-deftest test-ai-context-clear-resets-alist-as-fallback () + "Boundary: when no clear function exists but the alist does, it gets +nilled directly." + (let ((gptel-context--alist '("item1" "item2")) + msg) + ;; Make sure the fboundp branches are skipped. + (cl-letf (((symbol-function 'fboundp) + (lambda (sym) + (not (memq sym '(gptel-context-remove-all + gptel-context-clear))))) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (cj/gptel-context-clear)) + (should-not gptel-context--alist) + (should (string-match-p "cleared" msg)))) + +(provide 'test-ai-config-commands) +;;; test-ai-config-commands.el ends here diff --git a/archive/gptel/tests/test-ai-config-current-model-selection.el b/archive/gptel/tests/test-ai-config-current-model-selection.el new file mode 100644 index 000000000..14f9391c8 --- /dev/null +++ b/archive/gptel/tests/test-ai-config-current-model-selection.el @@ -0,0 +1,74 @@ +;;; test-ai-config-current-model-selection.el --- Tests for cj/gptel--current-model-selection -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/gptel--current-model-selection from ai-config.el. +;; +;; Pure function that formats the active backend and model into a display +;; string like "Anthropic - Claude: claude-opus-4-6". Used as the default +;; selection in the model-switching completing-read prompt. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'testutil-ai-config) +(require 'ai-config) + +;;; Normal Cases + +(ert-deftest test-ai-config-current-model-selection-normal-matching-backend () + "When current backend is in the backends alist, use its display name." + (let* ((backend-obj 'my-backend) + (backends `(("Anthropic - Claude" . ,backend-obj)))) + (should (equal (cj/gptel--current-model-selection backends backend-obj "opus") + "Anthropic - Claude: opus")))) + +(ert-deftest test-ai-config-current-model-selection-normal-symbol-model () + "Symbol model should be converted to string in the output." + (let* ((backend-obj 'my-backend) + (backends `(("Claude" . ,backend-obj)))) + (should (equal (cj/gptel--current-model-selection backends backend-obj 'opus) + "Claude: opus")))) + +(ert-deftest test-ai-config-current-model-selection-normal-multiple-backends () + "Should find the correct backend name among multiple backends." + (let* ((backend-a 'backend-a) + (backend-b 'backend-b) + (backends `(("Claude" . ,backend-a) ("OpenAI" . ,backend-b)))) + (should (equal (cj/gptel--current-model-selection backends backend-b "gpt-4o") + "OpenAI: gpt-4o")))) + +;;; Boundary Cases + +(ert-deftest test-ai-config-current-model-selection-boundary-nil-backend-shows-ai () + "Nil backend (not in alist) should fall back to \"AI\"." + (should (equal (cj/gptel--current-model-selection '(("Claude" . x)) nil "opus") + "AI: opus"))) + +(ert-deftest test-ai-config-current-model-selection-boundary-unknown-backend-shows-ai () + "Backend not found in alist should fall back to \"AI\"." + (should (equal (cj/gptel--current-model-selection + '(("Claude" . backend-a)) 'unknown-backend "opus") + "AI: opus"))) + +(ert-deftest test-ai-config-current-model-selection-boundary-nil-model () + "Nil model should produce \"nil\" in the model position (symbolp nil)." + (let* ((backend 'my-backend) + (backends `(("Claude" . ,backend)))) + (should (equal (cj/gptel--current-model-selection backends backend nil) + "Claude: nil")))) + +(ert-deftest test-ai-config-current-model-selection-boundary-empty-backends () + "Empty backends alist should fall back to \"AI\" for backend name." + (should (equal (cj/gptel--current-model-selection nil 'anything "model") + "AI: model"))) + +(ert-deftest test-ai-config-current-model-selection-boundary-both-nil () + "Nil backend and nil model should produce \"AI: nil\"." + (should (equal (cj/gptel--current-model-selection nil nil nil) + "AI: nil"))) + +(provide 'test-ai-config-current-model-selection) +;;; test-ai-config-current-model-selection.el ends here diff --git a/archive/gptel/tests/test-ai-config-fresh-org-prefix.el b/archive/gptel/tests/test-ai-config-fresh-org-prefix.el new file mode 100644 index 000000000..16a3211cf --- /dev/null +++ b/archive/gptel/tests/test-ai-config-fresh-org-prefix.el @@ -0,0 +1,65 @@ +;;; test-ai-config-fresh-org-prefix.el --- Tests for cj/gptel--fresh-org-prefix -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/gptel--fresh-org-prefix from ai-config.el. +;; +;; Generates an org-mode level-1 heading containing the user's login +;; name and a bracketed timestamp, used as the user message prefix in +;; gptel org-mode conversations. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'testutil-ai-config) +(require 'ai-config) + +;;; Normal Cases + +(ert-deftest test-ai-config-fresh-org-prefix-normal-starts-with-org-heading () + "Result should start with '* ' for an org level-1 heading." + (should (string-prefix-p "* " (cj/gptel--fresh-org-prefix)))) + +(ert-deftest test-ai-config-fresh-org-prefix-normal-contains-username () + "Result should contain the current user's login name." + (should (string-match-p (regexp-quote user-login-name) + (cj/gptel--fresh-org-prefix)))) + +(ert-deftest test-ai-config-fresh-org-prefix-normal-contains-timestamp () + "Result should contain a bracketed timestamp in YYYY-MM-DD HH:MM:SS format." + (should (string-match-p "\\[[-0-9]+ [0-9]+:[0-9]+:[0-9]+\\]" + (cj/gptel--fresh-org-prefix)))) + +(ert-deftest test-ai-config-fresh-org-prefix-normal-ends-with-newline () + "Result should end with a newline." + (should (string-suffix-p "\n" (cj/gptel--fresh-org-prefix)))) + +(ert-deftest test-ai-config-fresh-org-prefix-normal-format-order () + "Result should have star, then username, then timestamp in order." + (let ((result (cj/gptel--fresh-org-prefix))) + (should (string-match + (format "^\\* %s \\[" (regexp-quote user-login-name)) + result)))) + +;;; Boundary Cases + +(ert-deftest test-ai-config-fresh-org-prefix-boundary-timestamp-reflects-today () + "Timestamp should contain today's date." + (let ((today (format-time-string "%Y-%m-%d"))) + (should (string-match-p (regexp-quote today) + (cj/gptel--fresh-org-prefix))))) + +(ert-deftest test-ai-config-fresh-org-prefix-boundary-overridden-username () + "Result should reflect a dynamically-bound user-login-name." + (let ((user-login-name "testuser")) + (should (string-match-p "testuser" (cj/gptel--fresh-org-prefix))))) + +(ert-deftest test-ai-config-fresh-org-prefix-boundary-empty-username () + "Empty user-login-name should produce heading with empty name slot." + (let ((user-login-name "")) + (should (string-match-p "^\\* \\[" (cj/gptel--fresh-org-prefix))))) + +(provide 'test-ai-config-fresh-org-prefix) +;;; test-ai-config-fresh-org-prefix.el ends here diff --git a/archive/gptel/tests/test-ai-config-gptel-backend-libs.el b/archive/gptel/tests/test-ai-config-gptel-backend-libs.el new file mode 100644 index 000000000..cbf48f444 --- /dev/null +++ b/archive/gptel/tests/test-ai-config-gptel-backend-libs.el @@ -0,0 +1,58 @@ +;;; test-ai-config-gptel-backend-libs.el --- Tests for gptel backend-lib loading -*- lexical-binding: t; -*- + +;;; Commentary: +;; Regression coverage for the "gptel-make-anthropic void" bug. The local +;; gptel fork (:load-path "~/code/gptel", :ensure nil) ships no generated +;; autoloads, so (require 'gptel) alone never loads gptel-anthropic / +;; gptel-openai where the gptel-make-* constructors live. The fix is to +;; require those backend libraries explicitly before constructing backends. +;; +;; These tests don't load gptel itself (it isn't reliably loadable in batch); +;; they stub `require' and the constructors to verify the loader requires both +;; libs and that `cj/ensure-gptel-backends' calls it before building backends. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-config) + +;; gptel defvars these at runtime; declare them here so the wiring test can +;; let-bind them in a batch session where gptel itself is not loaded. +(defvar gptel-backend) +(defvar gptel-model) + +(ert-deftest test-ai-config-gptel-load-backend-libs-requires-both () + "Normal: the loader requires gptel-anthropic and gptel-openai so the fork's +make-* constructors exist despite the missing autoloads." + (let ((required '())) + (cl-letf (((symbol-function 'require) + (lambda (feature &rest _) (push feature required) feature))) + (cj/--gptel-load-backend-libs)) + (should (memq 'gptel-anthropic required)) + (should (memq 'gptel-openai required)))) + +(ert-deftest test-ai-config-ensure-gptel-backends-loads-libs-first () + "Regression: `cj/ensure-gptel-backends' loads the backend libs before it +calls the constructors, so a fork without autoloads no longer signals +`void-function gptel-make-anthropic'." + (let ((loaded nil) + (gptel-claude-backend nil) + (gptel-chatgpt-backend nil) + (gptel-backend nil) + (gptel-model nil)) + (cl-letf (((symbol-function 'cj/--gptel-load-backend-libs) + (lambda () (setq loaded t))) + ((symbol-function 'gptel-make-anthropic) (lambda (&rest _) 'claude)) + ((symbol-function 'gptel-make-openai) (lambda (&rest _) 'chatgpt)) + ((symbol-function 'cj/anthropic-api-key) (lambda () "k")) + ((symbol-function 'cj/openai-api-key) (lambda () "k"))) + (cj/ensure-gptel-backends)) + (should loaded) + (should (eq gptel-claude-backend 'claude)) + (should (eq gptel-chatgpt-backend 'chatgpt)))) + +(provide 'test-ai-config-gptel-backend-libs) +;;; test-ai-config-gptel-backend-libs.el ends here diff --git a/archive/gptel/tests/test-ai-config-gptel-commands.el b/archive/gptel/tests/test-ai-config-gptel-commands.el new file mode 100644 index 000000000..cab23572e --- /dev/null +++ b/archive/gptel/tests/test-ai-config-gptel-commands.el @@ -0,0 +1,155 @@ +;;; test-ai-config-gptel-commands.el --- Tests for ai-config gptel command wrappers -*- lexical-binding: t; -*- + +;;; Commentary: +;; Second pass on ai-config. The first batch covered the helpers +;; (auth-source, api-key caching, add-file, clear-buffer, context- +;; clear, insert-model-heading). This file covers the gptel command +;; wrappers and a few small pure helpers: +;; +;; cj/gptel--refresh-org-prefix +;; cj/gptel-backend-and-model +;; cj/gptel-switch-backend +;; cj/gptel-add-buffer-file +;; cj/gptel-add-this-buffer +;; cj/toggle-gptel +;; +;; The gptel/projectile primitives are stubbed throughout. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-config) + +;; Dynamic vars gptel would normally own. +(defvar gptel-backend nil) +(defvar gptel-model nil) +(defvar gptel-prompt-prefix-alist nil) + +;;; cj/gptel--refresh-org-prefix + +(ert-deftest test-ai-config-refresh-org-prefix-updates-alist-entry () + "Normal: the advice refreshes the org-mode entry in the prefix alist." + (let ((gptel-prompt-prefix-alist '((org-mode . "stale\n")))) + (cj/gptel--refresh-org-prefix) + (let ((entry (alist-get 'org-mode gptel-prompt-prefix-alist))) + (should (stringp entry)) + ;; Fresh prefix includes the user-login-name + a timestamp bracket. + (should (string-match-p "\\[" entry))))) + +;;; cj/gptel-backend-and-model + +(ert-deftest test-ai-config-backend-and-model-formats-with-vector-backend () + "Normal: a vector backend's name element comes through formatted." + (let ((gptel-backend [unused-slot "Claude" other]) + (gptel-model 'claude-opus-4-6)) + (let ((s (cj/gptel-backend-and-model))) + (should (string-match-p "Claude" s)) + (should (string-match-p "claude-opus-4-6" s))))) + +(ert-deftest test-ai-config-backend-and-model-falls-back-to-ai-when-no-backend () + "Boundary: with no backend bound, the string starts with the AI fallback." + (let ((gptel-backend nil) + (gptel-model nil)) + (should (string-prefix-p "AI:" (cj/gptel-backend-and-model))))) + +;;; cj/gptel-switch-backend + +(ert-deftest test-ai-config-switch-backend-sets-backend-and-model () + "Normal: switch picks a backend + model, then updates the gptel vars." + (let ((gptel-backend nil) + (gptel-model nil) + (msg nil)) + (cl-letf (((symbol-function 'cj/gptel--available-backends) + (lambda () + '(("Anthropic - Claude" . anthropic-backend)))) + ((symbol-function 'gptel-backend-models) + (lambda (_b) '(claude-opus claude-sonnet))) + ((symbol-function 'completing-read) + (lambda (prompt collection &rest _) + ;; First call -> backend choice; second -> model. + (cond + ((string-match-p "backend" prompt) "Anthropic - Claude") + (t "claude-opus")))) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (cj/gptel-switch-backend)) + (should (eq gptel-backend 'anthropic-backend)) + ;; gptel-model must be a symbol, not the raw completing-read string: + ;; gptel's modeline calls `symbolp' on it and hangs redisplay otherwise. + (should (symbolp gptel-model)) + (should (eq gptel-model 'claude-opus)) + (should (string-match-p "Anthropic - Claude" msg)))) + +(ert-deftest test-ai-config-switch-backend-error-invalid-choice () + "Error: an unrecognized backend name signals user-error." + (cl-letf (((symbol-function 'cj/gptel--available-backends) + (lambda () '(("Anthropic - Claude" . backend-a)))) + ((symbol-function 'completing-read) + (lambda (&rest _) "Something Else"))) + (should-error (cj/gptel-switch-backend) :type 'user-error))) + +;;; cj/gptel-add-buffer-file + +(ert-deftest test-ai-config-add-buffer-file-adds-when-buffer-has-file () + "Normal: a buffer that visits a file -> the file is added to context." + (let ((added nil)) + (with-temp-buffer + (setq buffer-file-name "/tmp/sample.org") + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) (buffer-name))) + ((symbol-function 'cj/gptel--add-file-to-context) + (lambda (f) (setq added f) t)) + ((symbol-function 'message) #'ignore)) + (cj/gptel-add-buffer-file)) + (setq buffer-file-name nil)) + (should (equal added "/tmp/sample.org")))) + +(ert-deftest test-ai-config-add-buffer-file-messages-when-no-file () + "Boundary: a buffer not visiting a file -> message, no add call." + (let ((added nil) + (msg nil)) + (with-temp-buffer + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) (buffer-name))) + ((symbol-function 'cj/gptel--add-file-to-context) + (lambda (f) (setq added f) t)) + ((symbol-function 'message) + (lambda (fmt &rest args) + (setq msg (apply #'format fmt args))))) + (cj/gptel-add-buffer-file))) + (should-not added) + (should (string-match-p "not visiting" msg)))) + +;;; cj/gptel-add-this-buffer + +(ert-deftest test-ai-config-add-this-buffer-calls-gptel-add-with-prefix () + "Normal: `cj/gptel-add-this-buffer' calls `gptel-add' with the (4) prefix arg." + (let ((arg nil)) + (cl-letf (((symbol-function 'featurep) (lambda (_ &rest _) t)) + ((symbol-function 'gptel-add) + (lambda (a) (setq arg a))) + ((symbol-function 'message) #'ignore)) + (with-temp-buffer + (cj/gptel-add-this-buffer))) + (should (equal arg '(4))))) + +;;; cj/toggle-gptel + +(ert-deftest test-ai-config-toggle-gptel-closes-when-window-shown () + "Normal: with a window already displaying *AI-Assistant*, toggle deletes it." + (let* ((buf (generate-new-buffer "*AI-Assistant*")) + (deleted nil)) + (unwind-protect + (cl-letf (((symbol-function 'get-buffer-window) + (lambda (_b &rest _) 'fake-window)) + ((symbol-function 'delete-window) + (lambda (w) (setq deleted w)))) + (cj/toggle-gptel)) + (when (buffer-live-p buf) (kill-buffer buf))) + (should (eq deleted 'fake-window)))) + +(provide 'test-ai-config-gptel-commands) +;;; test-ai-config-gptel-commands.el ends here diff --git a/archive/gptel/tests/test-ai-config-gptel-local-tools.el b/archive/gptel/tests/test-ai-config-gptel-local-tools.el new file mode 100644 index 000000000..8d3a45ac4 --- /dev/null +++ b/archive/gptel/tests/test-ai-config-gptel-local-tools.el @@ -0,0 +1,57 @@ +;;; test-ai-config-gptel-local-tools.el --- Tests for local GPTel tool loading -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Tests for optional local GPTel tool loading from ai-config.el. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(setq load-prefer-newer t) +(require 'testutil-ai-config) +(require 'ai-config) + +(defun test-ai-config-gptel-local-tools--write-tool (dir feature) + "Write a temporary tool module named FEATURE into DIR." + (let ((file (expand-file-name (format "%s.el" feature) dir))) + (write-region + (format ";;; %s.el --- test tool -*- lexical-binding: t; -*-\n(provide '%s)\n" + feature feature) + nil + file + nil + 'silent))) + +(ert-deftest test-ai-config-gptel-local-tools-missing-directory-is-non-fatal () + "Missing optional tool directory should not signal or load anything." + (let ((dir (expand-file-name "missing-gptel-tools/" + (make-temp-file "gptel-tools-home-" t)))) + (should-not (cj/gptel-load-local-tools dir '(test_missing_tool))))) + +(ert-deftest test-ai-config-gptel-local-tools-loads-present-tools () + "Present tool modules should be loaded and returned in request order." + (let ((dir (make-temp-file "gptel-tools-" t)) + (features '(test_gptel_tool_one test_gptel_tool_two))) + (dolist (feature features) + (test-ai-config-gptel-local-tools--write-tool dir feature)) + (should (equal (cj/gptel-load-local-tools dir features) + features)) + (dolist (feature features) + (should (featurep feature))))) + +(ert-deftest test-ai-config-gptel-local-tools-skips-missing-tool-files () + "Missing optional tool files should not prevent present tools from loading." + (let ((dir (make-temp-file "gptel-tools-" t)) + (present 'test_gptel_present_tool) + (missing 'test_gptel_missing_tool)) + (test-ai-config-gptel-local-tools--write-tool dir present) + (should (equal (cj/gptel-load-local-tools dir (list present missing)) + (list present))) + (should (featurep present)) + (should-not (featurep missing)))) + +(provide 'test-ai-config-gptel-local-tools) +;;; test-ai-config-gptel-local-tools.el ends here diff --git a/archive/gptel/tests/test-ai-config-gptel-magit-lazy-loading.el b/archive/gptel/tests/test-ai-config-gptel-magit-lazy-loading.el new file mode 100644 index 000000000..6eac0d193 --- /dev/null +++ b/archive/gptel/tests/test-ai-config-gptel-magit-lazy-loading.el @@ -0,0 +1,151 @@ +;;; test-ai-config-gptel-magit-lazy-loading.el --- Tests for gptel-magit lazy loading -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the per-feature lazy gptel-magit integration in ai-config.el. +;; +;; ai-config.el uses three separate `with-eval-after-load' blocks -- +;; one per actual dependency -- to wire up its bindings: +;; git-commit -> M-g in `git-commit-mode-map' +;; magit-commit -> "g" suffix in the `magit-commit' transient +;; magit-diff -> "x" suffix in the `magit-diff' transient +;; +;; This shape matters: `magit.el' calls `(provide 'magit)' before its +;; `cl-eval-when (load eval) ...' block requires `magit-commit' and +;; `magit-stash', so a single `with-eval-after-load 'magit' would fire +;; while the transient prefixes the wiring references are still +;; undefined. `transient-append-suffix' silently no-ops on missing +;; prefixes, which is how that bug stayed invisible. +;; +;; Testing approach. In Emacs 30, `provide' does NOT fire registered +;; `eval-after-load' callbacks in batch mode -- only an actual `load' +;; does. Rather than work around that with disk-backed stub files, the +;; tests inspect `after-load-alist' directly to verify which features +;; the wiring is gated on. That's stronger evidence than running the +;; callbacks anyway: the regression we're guarding against is "wiring +;; hooked on `magit'," and the right shape of that check is "no entry +;; for `magit', entries for `git-commit', `magit-commit', `magit-diff'." + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Load gptel stubs. This does NOT provide any of the magit features, +;; so the eval-after-load blocks in ai-config stay dormant. +(require 'testutil-ai-config) + +;; Stub the keymap used by the M-g binding. +(defvar git-commit-mode-map (make-sparse-keymap) + "Stub keymap standing in for magit's git-commit-mode-map.") + +;; Stub transient-append-suffix as a recorder. We don't invoke it +;; through provide in this test file, but the symbol must be fbound so +;; ai-config.el byte-compiles cleanly through `(require 'ai-config)'. +(unless (fboundp 'transient-append-suffix) + (defun transient-append-suffix (&rest _) nil)) + +(require 'ai-config) + +;; ----------------------------- Regression check ------------------------------ + +(ert-deftest test-ai-config-gptel-magit-regression-no-after-load-on-magit () + "ai-config must NOT register a `with-eval-after-load 'magit' hook. +`magit.el' provides itself BEFORE it loads `magit-commit' and +`magit-stash', so wiring keyed on `magit' would fire while the +transient prefixes are still undefined and `transient-append-suffix' +would silently no-op. The per-feature hooks side-step the race +entirely -- this test guards against any future regression that +re-introduces a single `'magit' hook." + ;; Forge installs an after-load entry for 'magit-mode'; magit's own + ;; code does not register anything keyed on the bare 'magit' symbol. + ;; Our wiring must not either. + (let ((entry (assoc 'magit after-load-alist))) + ;; If something else (e.g. another package) registers under 'magit + ;; the entry will exist, but it must not contain a closure that + ;; refers to gptel-magit symbols. Stringify the entry and grep. + (when entry + (should-not (string-match-p "gptel-magit" (format "%s" entry)))))) + +;; ------------------------------ Wiring registration -------------------------- + +(ert-deftest test-ai-config-gptel-magit-lazy-loading-git-commit-hook-registered () + "ai-config registers an `eval-after-load' hook keyed on `git-commit'. +The hook body binds M-g in `git-commit-mode-map' to +`gptel-magit-generate-message', so the printed closure mentions both." + (let ((entry (assoc 'git-commit after-load-alist))) + (should entry) + (let ((printed (format "%s" entry))) + (should (string-match-p "git-commit-mode-map" printed)) + (should (string-match-p "gptel-magit-generate-message" printed))))) + +(ert-deftest test-ai-config-gptel-magit-lazy-loading-magit-commit-hook-registered () + "ai-config registers an `eval-after-load' hook keyed on `magit-commit'. +The hook body calls `transient-append-suffix' for `magit-commit', so +the printed closure mentions both." + (let ((entry (assoc 'magit-commit after-load-alist))) + (should entry) + (let ((printed (format "%s" entry))) + (should (string-match-p "transient-append-suffix" printed)) + (should (string-match-p "magit-commit" printed)) + (should (string-match-p "gptel-magit-commit-generate" printed))))) + +(ert-deftest test-ai-config-gptel-magit-lazy-loading-magit-diff-hook-registered () + "ai-config registers an `eval-after-load' hook keyed on `magit-diff'. +The hook body calls `transient-append-suffix' for `magit-diff', so the +printed closure mentions both." + (let ((entry (assoc 'magit-diff after-load-alist))) + (should entry) + (let ((printed (format "%s" entry))) + (should (string-match-p "transient-append-suffix" printed)) + (should (string-match-p "magit-diff" printed)) + (should (string-match-p "gptel-magit-diff-explain" printed))))) + +;;; Normal Cases — Autoloads + +(ert-deftest test-ai-config-gptel-magit-lazy-loading-normal-generate-message-is-autoload () + "After ai-config loads, `gptel-magit-generate-message' is an autoload. +An autoload means the function is registered but `gptel-magit.el' has +not been loaded yet -- it loads only when the function is first +called." + (should (fboundp 'gptel-magit-generate-message)) + (should (autoloadp (symbol-function 'gptel-magit-generate-message)))) + +(ert-deftest test-ai-config-gptel-magit-lazy-loading-normal-commit-generate-is-autoload () + "After ai-config loads, `gptel-magit-commit-generate' is an autoload." + (should (fboundp 'gptel-magit-commit-generate)) + (should (autoloadp (symbol-function 'gptel-magit-commit-generate)))) + +(ert-deftest test-ai-config-gptel-magit-lazy-loading-normal-diff-explain-is-autoload () + "After ai-config loads, `gptel-magit-diff-explain' is an autoload." + (should (fboundp 'gptel-magit-diff-explain)) + (should (autoloadp (symbol-function 'gptel-magit-diff-explain)))) + +;;; Boundary Cases + +(ert-deftest test-ai-config-gptel-magit-lazy-loading-boundary-gptel-magit-not-loaded () + "After ai-config loads, `gptel-magit' itself stays unloaded. +The autoloads are registered so the package only loads when one of its +entry points is invoked." + (should-not (featurep 'gptel-magit))) + +;;; Error Cases — Install behavior + +(ert-deftest test-ai-config-gptel-magit-declared-via-use-package () + "ai-config declares gptel-magit via `use-package' so it gets installed. +Raw `(autoload ...)' calls register the function name but leave the +package uninstalled on machines that never ran `package-install'. The +\\=`use-package' form inherits `use-package-always-ensure' from +early-init, which is how every other package in this config gets +onto `load-path' before its autoloads fire." + (let ((source-file (expand-file-name "modules/ai-config.el" + user-emacs-directory))) + (with-temp-buffer + (insert-file-contents source-file) + (goto-char (point-min)) + (should (re-search-forward "(use-package gptel-magit\\b" nil t))))) + +(provide 'test-ai-config-gptel-magit-lazy-loading) +;;; test-ai-config-gptel-magit-lazy-loading.el ends here diff --git a/archive/gptel/tests/test-ai-config-helpers.el b/archive/gptel/tests/test-ai-config-helpers.el new file mode 100644 index 000000000..cdbc0f6eb --- /dev/null +++ b/archive/gptel/tests/test-ai-config-helpers.el @@ -0,0 +1,183 @@ +;;; test-ai-config-helpers.el --- Tests for ai-config helper functions -*- lexical-binding: t; -*- + +;;; Commentary: +;; Covers helpers that don't depend on a live gptel install: +;; +;; cj/auth-source-secret +;; cj/anthropic-api-key (caching wrapper) +;; cj/openai-api-key (caching wrapper) +;; cj/gptel--add-file-to-context +;; cj/gptel-clear-buffer +;; cj/gptel-context-clear +;; cj/gptel-insert-model-heading +;; +;; External primitives (`auth-source-search', `gptel-add-file', etc.) +;; are stubbed so the tests never touch the keyring or the network. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-config) + +;; Make `gptel-context--alist' a real dynamic variable for the fallback +;; test below. Under lexical-binding a plain `let' is lexical, so the +;; `setq' inside `cj/gptel-context-clear' would otherwise miss it. +(defvar gptel-context--alist nil + "Dynamic stand-in for the gptel-context alist (gptel not loaded here).") + +;;; cj/auth-source-secret + +(ert-deftest test-ai-config-auth-source-secret-returns-string () + "Normal: a plain-string secret comes back as-is." + (cl-letf (((symbol-function 'auth-source-search) + (lambda (&rest _) '((:secret "plaintext"))))) + (should (equal (cj/auth-source-secret "example.com" "user") + "plaintext")))) + +(ert-deftest test-ai-config-auth-source-secret-unwraps-function () + "Normal: a function secret is funcall'd to retrieve the value." + (cl-letf (((symbol-function 'auth-source-search) + (lambda (&rest _) (list (list :secret (lambda () "called")))))) + (should (equal (cj/auth-source-secret "example.com" "user") + "called")))) + +(ert-deftest test-ai-config-auth-source-secret-errors-when-missing () + "Error: an empty result raises a clear error." + (cl-letf (((symbol-function 'auth-source-search) + (lambda (&rest _) nil))) + (should-error (cj/auth-source-secret "nope.example.com" "user") + :type 'error))) + +;;; cj/anthropic-api-key / cj/openai-api-key + +(ert-deftest test-ai-config-anthropic-api-key-caches-after-first-call () + "Normal: a subsequent call returns the cached value without re-fetching." + (let ((cj/anthropic-api-key-cached nil) + (call-count 0)) + (cl-letf (((symbol-function 'auth-source-search) + (lambda (&rest _) + (cl-incf call-count) + '((:secret "anth-key"))))) + (should (equal (cj/anthropic-api-key) "anth-key")) + (should (equal (cj/anthropic-api-key) "anth-key")) + (should (= call-count 1))))) + +(ert-deftest test-ai-config-openai-api-key-caches-after-first-call () + "Normal: same caching contract as the anthropic key." + (let ((cj/openai-api-key-cached nil) + (call-count 0)) + (cl-letf (((symbol-function 'auth-source-search) + (lambda (&rest _) + (cl-incf call-count) + '((:secret "oai-key"))))) + (should (equal (cj/openai-api-key) "oai-key")) + (should (equal (cj/openai-api-key) "oai-key")) + (should (= call-count 1))))) + +;;; cj/gptel--add-file-to-context + +(ert-deftest test-ai-config-add-file-to-context-adds-existing-file () + "Normal: an existing file is added and the function returns t." + (let ((tmp (make-temp-file "ai-config-add-file-"))) + (unwind-protect + (let ((gptel-context--alist nil) + (added nil)) + (cl-letf (((symbol-function 'gptel-add-file) + (lambda (f) (setq added f))) + ((symbol-function 'message) #'ignore)) + (should (eq (cj/gptel--add-file-to-context tmp) t)) + (should (equal added tmp)))) + (delete-file tmp)))) + +(ert-deftest test-ai-config-add-file-to-context-skips-missing-file () + "Boundary: a non-existent path returns nil and doesn't call gptel-add-file." + (let ((called nil)) + (cl-letf (((symbol-function 'gptel-add-file) + (lambda (_) (setq called t)))) + (should-not (cj/gptel--add-file-to-context "/no/such/path")) + (should-not called)))) + +(ert-deftest test-ai-config-add-file-to-context-skips-nil-path () + "Boundary: a nil path returns nil without calling gptel-add-file." + (let ((called nil)) + (cl-letf (((symbol-function 'gptel-add-file) + (lambda (_) (setq called t)))) + (should-not (cj/gptel--add-file-to-context nil)) + (should-not called)))) + +;;; cj/gptel-clear-buffer + +(ert-deftest test-ai-config-clear-buffer-erases-in-gptel-org-buffer () + "Normal: a gptel-mode org buffer is erased and the fresh org prefix is reinserted." + (with-temp-buffer + (delay-mode-hooks (org-mode)) + (setq-local gptel-mode t) + (insert "* Existing conversation\nstuff\n") + (let ((msg nil)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) + (setq msg (apply #'format fmt args))))) + (cj/gptel-clear-buffer)) + (should (string-match-p "cleared" msg))) + ;; The fresh prefix is an org heading starting with "* ". + (should (string-prefix-p "* " (buffer-string))) + (should-not (string-match-p "Existing conversation" (buffer-string))))) + +(ert-deftest test-ai-config-clear-buffer-noop-when-not-gptel-org () + "Boundary: in a non-gptel buffer the function messages and changes nothing." + (with-temp-buffer + (insert "untouched\n") + (let ((msg nil)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) + (setq msg (apply #'format fmt args))))) + (cj/gptel-clear-buffer)) + (should (string-match-p "Not a GPTel buffer" msg)) + (should (equal (buffer-string) "untouched\n"))))) + +;;; cj/gptel-context-clear + +(ert-deftest test-ai-config-context-clear-uses-remove-all-when-available () + "Normal: when `gptel-context-remove-all' is bound, it wins the cond. +The stub must be a command because `cj/gptel-context-clear' invokes it +via `call-interactively'." + (let ((called nil) + (msg nil)) + (cl-letf (((symbol-function 'gptel-context-remove-all) + (lambda () (interactive) (setq called 'remove-all))) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (cj/gptel-context-clear)) + (should (eq called 'remove-all)) + (should (string-match-p "cleared" msg)))) + +(ert-deftest test-ai-config-context-clear-falls-back-to-alist-setq () + "Boundary: when no clearing function exists, the alist is set to nil." + (let ((gptel-context--alist '((:dummy))) + (msg nil)) + (cl-letf (((symbol-function 'fboundp) + (lambda (sym) + (not (memq sym '(gptel-context-remove-all gptel-context-clear))))) + ((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (cj/gptel-context-clear)) + (should (null gptel-context--alist)) + (should (string-match-p "cleared" msg)))) + +;;; cj/gptel-insert-model-heading + +(ert-deftest test-ai-config-insert-model-heading-inserts-at-given-position () + "Normal: an Org heading is inserted at RESPONSE-BEGIN-POS." + (with-temp-buffer + (insert "response text") + (cl-letf (((symbol-function 'cj/gptel-backend-and-model) + (lambda () "Anthropic: claude-test [2026-05-13 12:00:00]"))) + (cj/gptel-insert-model-heading (point-min) (point-max))) + (should (string-prefix-p "* Anthropic: claude-test" (buffer-string))) + (should (string-match-p "\nresponse text" (buffer-string))))) + +(provide 'test-ai-config-helpers) +;;; test-ai-config-helpers.el ends here diff --git a/archive/gptel/tests/test-ai-config-model-to-string.el b/archive/gptel/tests/test-ai-config-model-to-string.el new file mode 100644 index 000000000..aa1149272 --- /dev/null +++ b/archive/gptel/tests/test-ai-config-model-to-string.el @@ -0,0 +1,60 @@ +;;; test-ai-config-model-to-string.el --- Tests for cj/gptel--model-to-string -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/gptel--model-to-string from ai-config.el. +;; +;; Pure function that converts a model identifier (string, symbol, or +;; other type) to a string representation. Branches on input type: +;; string (identity), symbol (symbol-name), fallback (format). + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'testutil-ai-config) +(require 'ai-config) + +;;; Normal Cases + +(ert-deftest test-ai-config-model-to-string-normal-string-returns-string () + "String model name should be returned unchanged." + (should (equal (cj/gptel--model-to-string "claude-opus-4-6") "claude-opus-4-6"))) + +(ert-deftest test-ai-config-model-to-string-normal-symbol-returns-symbol-name () + "Symbol model name should return its symbol-name." + (should (equal (cj/gptel--model-to-string 'gpt-4o) "gpt-4o"))) + +(ert-deftest test-ai-config-model-to-string-normal-number-returns-formatted () + "Numeric input should be formatted as a string." + (should (equal (cj/gptel--model-to-string 42) "42"))) + +;;; Boundary Cases + +(ert-deftest test-ai-config-model-to-string-boundary-empty-string-returns-empty () + "Empty string should be returned as empty string." + (should (equal (cj/gptel--model-to-string "") ""))) + +(ert-deftest test-ai-config-model-to-string-boundary-nil-returns-nil-string () + "Nil is a symbol, so should return \"nil\"." + (should (equal (cj/gptel--model-to-string nil) "nil"))) + +(ert-deftest test-ai-config-model-to-string-boundary-keyword-symbol-includes-colon () + "Keyword symbol should return its name including the colon." + (should (equal (cj/gptel--model-to-string :some-model) ":some-model"))) + +(ert-deftest test-ai-config-model-to-string-boundary-list-uses-format-fallback () + "List input should hit the fallback format branch." + (should (equal (cj/gptel--model-to-string '(a b)) "(a b)"))) + +(ert-deftest test-ai-config-model-to-string-boundary-vector-uses-format-fallback () + "Vector input should hit the fallback format branch." + (should (equal (cj/gptel--model-to-string [1 2]) "[1 2]"))) + +(ert-deftest test-ai-config-model-to-string-boundary-string-with-spaces-unchanged () + "String with spaces should be returned unchanged." + (should (equal (cj/gptel--model-to-string "model with spaces") "model with spaces"))) + +(provide 'test-ai-config-model-to-string) +;;; test-ai-config-model-to-string.el ends here diff --git a/archive/gptel/tests/test-ai-config-model-to-symbol.el b/archive/gptel/tests/test-ai-config-model-to-symbol.el new file mode 100644 index 000000000..de6f18ff8 --- /dev/null +++ b/archive/gptel/tests/test-ai-config-model-to-symbol.el @@ -0,0 +1,61 @@ +;;; test-ai-config-model-to-symbol.el --- Tests for cj/gptel--model-to-symbol -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/gptel--model-to-symbol from ai-config.el. +;; +;; Pure function that coerces a model identifier (string, symbol, or other +;; type) to a symbol. `gptel-model' MUST be a symbol -- gptel's modeline +;; code calls `symbolp' on it and signals wrong-type-argument on a string, +;; which manifests as a redisplay hang. The function's invariant is that +;; the result is always a symbol, so a value coerced through it is safe to +;; assign to `gptel-model'. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'testutil-ai-config) +(require 'ai-config) + +;;; Normal Cases + +(ert-deftest test-ai-config-model-to-symbol-normal-string-interns () + "Normal: a string model name is interned to the matching symbol." + (should (eq (cj/gptel--model-to-symbol "claude-opus-4-8") 'claude-opus-4-8))) + +(ert-deftest test-ai-config-model-to-symbol-normal-symbol-returns-symbol () + "Normal: a symbol model name is returned unchanged." + (should (eq (cj/gptel--model-to-symbol 'gpt-4o) 'gpt-4o))) + +(ert-deftest test-ai-config-model-to-symbol-normal-result-always-symbol () + "Normal: the invariant -- the result is always a symbol (the crash guard)." + (should (symbolp (cj/gptel--model-to-symbol "gpt-5.5"))) + (should (symbolp (cj/gptel--model-to-symbol 'gpt-5.5)))) + +;;; Boundary Cases + +(ert-deftest test-ai-config-model-to-symbol-boundary-empty-string-is-symbol () + "Boundary: empty string interns to a symbol (still satisfies the invariant)." + (should (symbolp (cj/gptel--model-to-symbol "")))) + +(ert-deftest test-ai-config-model-to-symbol-boundary-nil-returns-nil () + "Boundary: nil is already a symbol, returned unchanged." + (should (eq (cj/gptel--model-to-symbol nil) nil)) + (should (symbolp (cj/gptel--model-to-symbol nil)))) + +(ert-deftest test-ai-config-model-to-symbol-boundary-string-with-spaces-interns () + "Boundary: a string with spaces interns to a single symbol with that name." + (should (eq (cj/gptel--model-to-symbol "model with spaces") + (intern "model with spaces")))) + +;;; Error/Odd Cases + +(ert-deftest test-ai-config-model-to-symbol-number-formats-then-interns () + "Error: a non-string, non-symbol value is formatted then interned to a symbol." + (should (eq (cj/gptel--model-to-symbol 42) (intern "42"))) + (should (symbolp (cj/gptel--model-to-symbol 42)))) + +(provide 'test-ai-config-model-to-symbol) +;;; test-ai-config-model-to-symbol.el ends here diff --git a/archive/gptel/tests/test-ai-conversations-browser.el b/archive/gptel/tests/test-ai-conversations-browser.el new file mode 100644 index 000000000..d7422b096 --- /dev/null +++ b/archive/gptel/tests/test-ai-conversations-browser.el @@ -0,0 +1,244 @@ +;;; test-ai-conversations-browser.el --- Tests for ai-conversations-browser -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the saved-conversations browser. Pure helpers (topic +;; parsing, header stripping, preview, rename target) are tested +;; against fixed inputs. File-touching actions (load / delete / +;; rename) are tested against a temp conversations directory. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +(require 'testutil-ai-config) +;; Force real ai-conversations to override testutil's stub. +(setq features (delq 'ai-conversations features)) +(require 'ai-conversations) +(require 'ai-conversations-browser) + +;; ----------------------------- temp-dir helper + +(defun test-ai-conversations-browser--with-temp-dir (fn) + "Run FN inside a fresh conversations directory. Clean up after." + (let* ((dir (make-temp-file "test-ai-conversations-browser-" t)) + (cj/gptel-conversations-directory dir)) + (unwind-protect + (funcall fn dir) + (when (file-exists-p dir) + (delete-directory dir t))))) + +(defun test-ai-conversations-browser--write (dir name content) + "Write CONTENT to NAME in DIR. Return the absolute path." + (let ((path (expand-file-name name dir))) + (with-temp-file path (insert content)) + path)) + +;; ----------------------------- topic-from-filename + +(ert-deftest test-ai-conversations-browser-topic-normal () + "Normal: topic slug extracted from a well-formed filename." + (should (equal (cj/gptel-browser--topic-from-filename + "my-topic_20260315-101530.gptel") + "my-topic"))) + +(ert-deftest test-ai-conversations-browser-topic-error-malformed () + "Boundary: malformed filename returns nil." + (should-not (cj/gptel-browser--topic-from-filename "garbage.gptel")) + (should-not (cj/gptel-browser--topic-from-filename "topic.gptel")) + (should-not (cj/gptel-browser--topic-from-filename "topic_20260315.gptel"))) + +;; ----------------------------- strip-headers + +(ert-deftest test-ai-conversations-browser-strip-headers-normal () + "Strip the two visibility headers plus the blank line after them." + (should (equal (cj/gptel-browser--strip-headers + "#+STARTUP: showeverything\n#+VISIBILITY: all\n\nrest\n") + "rest\n"))) + +(ert-deftest test-ai-conversations-browser-strip-headers-no-headers () + "Boundary: input without headers is unchanged." + (should (equal (cj/gptel-browser--strip-headers "plain body\n") + "plain body\n"))) + +;; ----------------------------- last-message + +(ert-deftest test-ai-conversations-browser-last-message-normal () + "Last-message picks the body of the last org heading." + (let ((text "* user [2026-01-01]\nhello there\n* AI [2026-01-01]\nthe latest reply\n")) + (should (equal (cj/gptel-browser--last-message text) + "the latest reply")))) + +(ert-deftest test-ai-conversations-browser-last-message-no-heading () + "Boundary: text without headings returns the (collapsed) body." + (let ((text "just some body\nwith two lines\n")) + (should (equal (cj/gptel-browser--last-message text) + "just some body with two lines")))) + +;; ----------------------------- preview + +(ert-deftest test-ai-conversations-browser-preview-truncates () + "Preview is ellipsized when the message is longer than LENGTH." + (let ((text "* AI\nthis is a very long response that should get truncated for the preview\n")) + (let ((preview (cj/gptel-browser--preview text 30))) + (should (= (length preview) 30)) + (should (string-suffix-p "…" preview))))) + +(ert-deftest test-ai-conversations-browser-preview-short () + "Preview is returned verbatim when shorter than LENGTH." + (let ((text "* AI\nshort\n")) + (should (equal (cj/gptel-browser--preview text 60) "short")))) + +(ert-deftest test-ai-conversations-browser-preview-empty () + "Preview of empty body returns empty string." + (should (equal (cj/gptel-browser--preview "" 60) ""))) + +;; ----------------------------- row-for-file + +(ert-deftest test-ai-conversations-browser-row-for-file-normal () + "Row contains date, topic, and a preview; carries file metadata." + (test-ai-conversations-browser--with-temp-dir + (lambda (dir) + (let ((file (test-ai-conversations-browser--write + dir "alpha_20260315-101530.gptel" + "#+STARTUP: showeverything\n\n* AI\nresult body\n"))) + (let ((row (cj/gptel-browser--row-for-file file dir))) + (should row) + (should (string-match-p "2026-03-15 10:15" row)) + (should (string-match-p "alpha" row)) + (should (string-match-p "result body" row)) + (should (equal (get-text-property 0 'cj/gptel-browser-file row) + "alpha_20260315-101530.gptel"))))))) + +(ert-deftest test-ai-conversations-browser-row-for-file-non-conversation () + "Files that don't match the conversation pattern return nil." + (test-ai-conversations-browser--with-temp-dir + (lambda (dir) + (let ((file (test-ai-conversations-browser--write + dir "not-a-conversation.gptel" "body"))) + (should-not (cj/gptel-browser--row-for-file file dir)))))) + +;; ----------------------------- rows / render + +(ert-deftest test-ai-conversations-browser-rows-from-empty-dir () + "Empty conversations directory yields no rows." + (test-ai-conversations-browser--with-temp-dir + (lambda (_dir) + (should-not (cj/gptel-browser--rows))))) + +(ert-deftest test-ai-conversations-browser-rows-multiple-conversations () + "Multiple conversations produce a row per file." + (test-ai-conversations-browser--with-temp-dir + (lambda (dir) + (test-ai-conversations-browser--write + dir "a_20260101-100000.gptel" "* AI\nfirst\n") + (test-ai-conversations-browser--write + dir "b_20260102-100000.gptel" "* AI\nsecond\n") + (let ((rows (cj/gptel-browser--rows))) + (should (= 2 (length rows))))))) + +(ert-deftest test-ai-conversations-browser-render-empty () + "Render shows a 'no conversations' line when directory is empty." + (test-ai-conversations-browser--with-temp-dir + (lambda (_dir) + (with-temp-buffer + (cj/gptel-browser-mode) + (cj/gptel-browser--render) + (should (string-match-p "no saved conversations" (buffer-string))))))) + +(ert-deftest test-ai-conversations-browser-render-newest-first () + "Render sorts rows newest first by timestamp." + (test-ai-conversations-browser--with-temp-dir + (lambda (dir) + (test-ai-conversations-browser--write + dir "old_20260101-100000.gptel" "* AI\nx\n") + (test-ai-conversations-browser--write + dir "new_20260301-100000.gptel" "* AI\ny\n") + (with-temp-buffer + (cj/gptel-browser-mode) + (cj/gptel-browser--render) + (let ((text (buffer-substring-no-properties (point-min) (point-max)))) + ;; New (March) should appear before old (January) in the buffer. + (should (< (string-match "2026-03-01" text) + (string-match "2026-01-01" text)))))))) + +;; ----------------------------- rename-target + +(ert-deftest test-ai-conversations-browser-rename-target-normal () + "Rename-target preserves the timestamp and slugifies the new topic." + (should (equal (cj/gptel-browser--rename-target + "/tmp/old-topic_20260101-100000.gptel" + "Brand New Topic") + "/tmp/brand-new-topic_20260101-100000.gptel"))) + +(ert-deftest test-ai-conversations-browser-rename-target-error-no-timestamp () + "Rename-target errors when the filename lacks a timestamp." + (should-error (cj/gptel-browser--rename-target "/tmp/no-ts.gptel" "x"))) + +;; ----------------------------- delete / rename actions + +(ert-deftest test-ai-conversations-browser-delete-removes-file () + "Delete with y removes the file under point and re-renders." + (test-ai-conversations-browser--with-temp-dir + (lambda (dir) + (let ((file (test-ai-conversations-browser--write + dir "topic_20260101-100000.gptel" "* AI\nx\n"))) + (with-temp-buffer + (cj/gptel-browser-mode) + (cj/gptel-browser--render) + ;; Point on the only data row + (goto-char (point-min)) + (forward-line 2) + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t))) + (cj/gptel-browser-delete)) + (should-not (file-exists-p file))))))) + +(ert-deftest test-ai-conversations-browser-delete-cancel-keeps-file () + "Delete with n leaves the file alone." + (test-ai-conversations-browser--with-temp-dir + (lambda (dir) + (let ((file (test-ai-conversations-browser--write + dir "topic_20260101-100000.gptel" "* AI\nx\n"))) + (with-temp-buffer + (cj/gptel-browser-mode) + (cj/gptel-browser--render) + (goto-char (point-min)) + (forward-line 2) + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) nil))) + (cj/gptel-browser-delete)) + (should (file-exists-p file))))))) + +(ert-deftest test-ai-conversations-browser-rename-renames-file () + "Rename moves the file under a new slug while preserving timestamp." + (test-ai-conversations-browser--with-temp-dir + (lambda (dir) + (let* ((file (test-ai-conversations-browser--write + dir "old-name_20260101-100000.gptel" "* AI\nx\n"))) + (with-temp-buffer + (cj/gptel-browser-mode) + (cj/gptel-browser--render) + (goto-char (point-min)) + (forward-line 2) + (cl-letf (((symbol-function 'read-string) + (lambda (&rest _) "renamed topic"))) + (cj/gptel-browser-rename)) + (should-not (file-exists-p file)) + (should (file-exists-p + (expand-file-name "renamed-topic_20260101-100000.gptel" + dir)))))))) + +(ert-deftest test-ai-conversations-browser-rename-error-on-empty-line () + "Rename errors when point is on the header/empty area." + (test-ai-conversations-browser--with-temp-dir + (lambda (_dir) + (with-temp-buffer + (cj/gptel-browser-mode) + (cj/gptel-browser--render) + (goto-char (point-min)) + (should-error (cj/gptel-browser-rename)))))) + +(provide 'test-ai-conversations-browser) +;;; test-ai-conversations-browser.el ends here diff --git a/archive/gptel/tests/test-ai-conversations.el b/archive/gptel/tests/test-ai-conversations.el new file mode 100644 index 000000000..2d5aefd13 --- /dev/null +++ b/archive/gptel/tests/test-ai-conversations.el @@ -0,0 +1,564 @@ +;;; test-ai-conversations.el --- Tests for ai-conversations.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Normal / Boundary / Error tests for the save/load/delete and +;; autosave surface in ai-conversations.el. Pure helpers are tested +;; against fixed inputs; file-touching helpers use per-test temp +;; directories. Interactive commands are exercised via `cl-letf' +;; stubs on `completing-read' and `y-or-n-p'. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +(require 'testutil-ai-config) +;; testutil-ai-config provides 'ai-conversations as a stub. Force the +;; real module to override. +(setq features (delq 'ai-conversations features)) +(require 'ai-conversations) + +;; -------------------------------------------------------- temp-dir helper + +(defun test-ai-conversations--with-temp-dir (fn) + "Run FN inside a fresh conversations directory. Clean up after." + (let* ((dir (make-temp-file "test-ai-conversations-" t)) + (cj/gptel-conversations-directory dir)) + (unwind-protect + (funcall fn dir) + (when (file-exists-p dir) + (delete-directory dir t))))) + +(defun test-ai-conversations--touch (dir name) + "Create empty file NAME in DIR." + (let ((path (expand-file-name name dir))) + (with-temp-file path (insert "")) + path)) + +;; ------------------------------------------------------ slugify-topic + +(ert-deftest test-ai-conversations-slugify-topic-normal () + "Normal: ASCII words with spaces become hyphen-joined slug." + (should (equal (cj/gptel--slugify-topic "Hello World") "hello-world"))) + +(ert-deftest test-ai-conversations-slugify-topic-boundary-empty () + "Boundary: empty input returns the literal \"conversation\" placeholder." + (should (equal (cj/gptel--slugify-topic "") "conversation")) + (should (equal (cj/gptel--slugify-topic nil) "conversation"))) + +(ert-deftest test-ai-conversations-slugify-topic-boundary-all-special () + "Boundary: input with no slug-safe chars falls back to placeholder." + (should (equal (cj/gptel--slugify-topic "!!!@@@###") "conversation")) + (should (equal (cj/gptel--slugify-topic " ") "conversation"))) + +(ert-deftest test-ai-conversations-slugify-topic-boundary-unicode-stripped () + "Boundary: non-ASCII characters drop out (only [a-z0-9] survives)." + (should (equal (cj/gptel--slugify-topic "Café Résumé") "caf-r-sum"))) + +(ert-deftest test-ai-conversations-slugify-topic-boundary-idempotent () + "Boundary: applying twice yields the same result as once." + (let ((once (cj/gptel--slugify-topic "Foo Bar 2026!"))) + (should (equal once (cj/gptel--slugify-topic once))))) + +(ert-deftest test-ai-conversations-slugify-topic-boundary-leading-trailing-trim () + "Boundary: leading/trailing separator runs are trimmed." + (should (equal (cj/gptel--slugify-topic "---foo---") "foo")) + (should (equal (cj/gptel--slugify-topic "**foo**") "foo"))) + +(ert-deftest test-ai-conversations-slugify-topic-normal-numbers-preserved () + "Normal: digits survive the slug." + (should (equal (cj/gptel--slugify-topic "Project 2026 Plan") + "project-2026-plan"))) + +;; ------------------------------------------------------ timestamp-from-filename + +(ert-deftest test-ai-conversations-timestamp-from-filename-normal () + "Normal: well-formed filename decodes to a time value." + (let ((ts (cj/gptel--timestamp-from-filename + "topic_20260315-101530.gptel"))) + (should ts) + (should (equal (format-time-string "%Y-%m-%d %H:%M:%S" ts) + "2026-03-15 10:15:30")))) + +(ert-deftest test-ai-conversations-timestamp-from-filename-boundary-year-edges () + "Boundary: end-of-year and start-of-year timestamps decode correctly." + (let ((eoy (cj/gptel--timestamp-from-filename + "topic_20251231-235959.gptel")) + (boy (cj/gptel--timestamp-from-filename + "topic_20260101-000000.gptel"))) + (should (equal (format-time-string "%Y-%m-%d %H:%M:%S" eoy) + "2025-12-31 23:59:59")) + (should (equal (format-time-string "%Y-%m-%d %H:%M:%S" boy) + "2026-01-01 00:00:00")))) + +(ert-deftest test-ai-conversations-timestamp-from-filename-error-malformed () + "Error: non-matching filename returns nil." + (should-not (cj/gptel--timestamp-from-filename "not-a-gptel-file")) + (should-not (cj/gptel--timestamp-from-filename "topic.gptel")) + (should-not (cj/gptel--timestamp-from-filename "topic_20260315.gptel")) + (should-not (cj/gptel--timestamp-from-filename "topic_2026031-101530.gptel"))) + +;; ------------------------------------------------------ existing-topics + +(ert-deftest test-ai-conversations-existing-topics-normal () + "Normal: returns unique topic slugs across multiple-timestamped files." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (test-ai-conversations--touch dir "foo_20260101-100000.gptel") + (test-ai-conversations--touch dir "foo_20260102-100000.gptel") + (test-ai-conversations--touch dir "bar_20260102-100000.gptel") + (let ((topics (cj/gptel--existing-topics))) + (should (member "foo" topics)) + (should (member "bar" topics)) + (should (= 2 (length topics))))))) + +(ert-deftest test-ai-conversations-existing-topics-boundary-empty-dir () + "Boundary: empty conversations directory returns nil." + (test-ai-conversations--with-temp-dir + (lambda (_dir) + (should-not (cj/gptel--existing-topics))))) + +(ert-deftest test-ai-conversations-existing-topics-boundary-missing-dir () + "Boundary: missing directory returns nil instead of erroring." + (let ((cj/gptel-conversations-directory + (expand-file-name (format "missing-%s" (random)) "/tmp"))) + (should-not (cj/gptel--existing-topics)))) + +(ert-deftest test-ai-conversations-existing-topics-boundary-ignores-non-gptel () + "Boundary: files without .gptel extension are ignored." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (test-ai-conversations--touch dir "foo_20260101-100000.gptel") + (test-ai-conversations--touch dir "readme.txt") + (test-ai-conversations--touch dir "stray.gptel.bak") + (should (equal (cj/gptel--existing-topics) '("foo")))))) + +;; ------------------------------------------------------ latest-file-for-topic + +(ert-deftest test-ai-conversations-latest-file-for-topic-normal () + "Normal: returns the newest file for the topic by lexical sort." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (test-ai-conversations--touch dir "foo_20260101-100000.gptel") + (test-ai-conversations--touch dir "foo_20260103-100000.gptel") + (test-ai-conversations--touch dir "foo_20260102-100000.gptel") + (should (equal (cj/gptel--latest-file-for-topic "foo") + "foo_20260103-100000.gptel"))))) + +(ert-deftest test-ai-conversations-latest-file-for-topic-boundary-no-match () + "Boundary: no matching topic returns nil." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (test-ai-conversations--touch dir "bar_20260101-100000.gptel") + (should-not (cj/gptel--latest-file-for-topic "foo"))))) + +(ert-deftest test-ai-conversations-latest-file-for-topic-boundary-missing-dir () + "Boundary: missing directory returns nil." + (let ((cj/gptel-conversations-directory + (expand-file-name (format "missing-%s" (random)) "/tmp"))) + (should-not (cj/gptel--latest-file-for-topic "foo")))) + +(ert-deftest test-ai-conversations-latest-file-for-topic-boundary-regex-isolation () + "Boundary: prefix-overlapping topics are not falsely matched." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (test-ai-conversations--touch dir "foo_20260101-100000.gptel") + (test-ai-conversations--touch dir "foobar_20260102-100000.gptel") + (should (equal (cj/gptel--latest-file-for-topic "foo") + "foo_20260101-100000.gptel"))))) + +;; ------------------------------------------------------ conversation-candidates + +(ert-deftest test-ai-conversations-conversation-candidates-normal-newest-first () + "Normal: candidates are sorted newest-first when configured that way." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (test-ai-conversations--touch dir "foo_20260101-100000.gptel") + (test-ai-conversations--touch dir "foo_20260103-100000.gptel") + (test-ai-conversations--touch dir "foo_20260102-100000.gptel") + (let ((cj/gptel-conversations-sort-order 'newest-first)) + (let* ((cands (cj/gptel--conversation-candidates)) + (files (mapcar #'cdr cands))) + (should (equal files + '("foo_20260103-100000.gptel" + "foo_20260102-100000.gptel" + "foo_20260101-100000.gptel")))))))) + +(ert-deftest test-ai-conversations-conversation-candidates-normal-oldest-first () + "Normal: candidates respect oldest-first sort order." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (test-ai-conversations--touch dir "foo_20260101-100000.gptel") + (test-ai-conversations--touch dir "foo_20260103-100000.gptel") + (test-ai-conversations--touch dir "foo_20260102-100000.gptel") + (let ((cj/gptel-conversations-sort-order 'oldest-first)) + (let* ((cands (cj/gptel--conversation-candidates)) + (files (mapcar #'cdr cands))) + (should (equal files + '("foo_20260101-100000.gptel" + "foo_20260102-100000.gptel" + "foo_20260103-100000.gptel")))))))) + +(ert-deftest test-ai-conversations-conversation-candidates-error-missing-dir () + "Error: missing conversations directory signals." + (let ((cj/gptel-conversations-directory + (expand-file-name (format "missing-%s" (random)) "/tmp"))) + (should-error (cj/gptel--conversation-candidates)))) + +(ert-deftest test-ai-conversations-conversation-candidates-display-shape () + "Display string is \"filename [YYYY-MM-DD HH:MM]\"." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (test-ai-conversations--touch dir "topic_20260315-101530.gptel") + (let* ((cands (cj/gptel--conversation-candidates)) + (display (car (car cands)))) + (should (string-match-p + "\\`topic_20260315-101530\\.gptel \\[2026-03-15 10:15\\]\\'" + display)))))) + +;; ------------------------------------------------------ save-buffer-to-file + +(ert-deftest test-ai-conversations-save-buffer-to-file-normal () + "Normal: writes buffer with visibility headers prepended." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (with-temp-buffer + (insert "hello world\n") + (let ((file (expand-file-name "out.gptel" dir))) + (cj/gptel--save-buffer-to-file (current-buffer) file) + (should (file-exists-p file)) + (with-temp-buffer + (insert-file-contents file) + (should (string-match-p "^#\\+STARTUP: showeverything" + (buffer-string))) + (should (string-match-p "^#\\+VISIBILITY: all" + (buffer-string))) + (should (string-match-p "hello world" + (buffer-string))))))))) + +(ert-deftest test-ai-conversations-save-buffer-to-file-roundtrip-with-strip () + "Round-trip: save then strip-visibility-headers yields original content." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (let ((original "first line\nsecond line\n") + (file (expand-file-name "rt.gptel" dir))) + (with-temp-buffer + (insert original) + (cj/gptel--save-buffer-to-file (current-buffer) file)) + (with-temp-buffer + (insert-file-contents file) + (cj/gptel--strip-visibility-headers) + (should (equal (buffer-string) original))))))) + +(ert-deftest test-ai-conversations-strip-visibility-headers-boundary-no-headers () + "Boundary: buffer without headers is unchanged." + (with-temp-buffer + (insert "plain body\n") + (cj/gptel--strip-visibility-headers) + (should (equal (buffer-string) "plain body\n")))) + +;; ------------------------------------------------------ autosave-after-response + +(defmacro test-ai-conversations--with-gptel-mode (&rest body) + "Run BODY in a temp buffer with `gptel-mode' bound non-nil." + (declare (indent 0)) + `(with-temp-buffer + (setq-local gptel-mode t) + ,@body)) + +(ert-deftest test-ai-conversations-autosave-after-response-saves-when-enabled () + "Hook saves the buffer to the autosave filepath when enabled." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (let ((file (expand-file-name "auto.gptel" dir))) + (test-ai-conversations--with-gptel-mode + (setq-local cj/gptel-autosave-enabled t) + (setq-local cj/gptel-autosave-filepath file) + (insert "autosaved body") + (cj/gptel--autosave-after-response) + (should (file-exists-p file))))))) + +(ert-deftest test-ai-conversations-autosave-after-response-skips-when-disabled () + "Hook is a no-op when `cj/gptel-autosave-enabled' is nil." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (let ((file (expand-file-name "auto.gptel" dir))) + (test-ai-conversations--with-gptel-mode + (setq-local cj/gptel-autosave-enabled nil) + (setq-local cj/gptel-autosave-filepath file) + (cj/gptel--autosave-after-response) + (should-not (file-exists-p file))))))) + +(ert-deftest test-ai-conversations-autosave-after-response-skips-when-no-filepath () + "Hook is a no-op when filepath is nil or empty." + (test-ai-conversations--with-temp-dir + (lambda (_dir) + (test-ai-conversations--with-gptel-mode + (setq-local cj/gptel-autosave-enabled t) + (setq-local cj/gptel-autosave-filepath nil) + ;; Should not error + (cj/gptel--autosave-after-response)) + (test-ai-conversations--with-gptel-mode + (setq-local cj/gptel-autosave-enabled t) + (setq-local cj/gptel-autosave-filepath "") + (cj/gptel--autosave-after-response))))) + +(ert-deftest test-ai-conversations-autosave-after-response-skips-outside-gptel-mode () + "Hook is a no-op when `gptel-mode' is nil." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (let ((file (expand-file-name "auto.gptel" dir))) + (with-temp-buffer + (setq-local gptel-mode nil) + (setq-local cj/gptel-autosave-enabled t) + (setq-local cj/gptel-autosave-filepath file) + (cj/gptel--autosave-after-response) + (should-not (file-exists-p file))))))) + +(ert-deftest test-ai-conversations-autosave-after-send-error-is-non-fatal () + "Hook surfaces a save error via `message' rather than signaling." + (test-ai-conversations--with-temp-dir + (lambda (_dir) + (test-ai-conversations--with-gptel-mode + (setq-local cj/gptel-autosave-enabled t) + (setq-local cj/gptel-autosave-filepath "/nonexistent-dir/file.gptel") + ;; Must not signal even though the write will fail + (cj/gptel--autosave-after-send))))) + +;; ------------------------------------------------------ autosave timer + +(ert-deftest test-ai-conversations-autosave-start-timer-normal () + "Normal: starting autosave creates a repeating timer for the current buffer." + (with-temp-buffer + (setq-local gptel-mode t) + (setq-local cj/gptel-autosave-enabled t) + (setq-local cj/gptel-autosave-filepath "/tmp/foo.gptel") + (let ((calls nil)) + (cl-letf (((symbol-function 'run-with-timer) + (lambda (secs repeat function &rest args) + (push (list secs repeat function args) calls) + :fake-timer))) + (let ((cj/gptel-autosave-interval 17)) + (cj/gptel--autosave-start-timer))) + (should (eq cj/gptel-autosave--timer :fake-timer)) + (should (equal (caar calls) 17)) + (should (equal (cadar calls) 17)) + (should (eq (nth 2 (car calls)) #'cj/gptel--autosave-timer-callback)) + (should (eq (car (nth 3 (car calls))) (current-buffer)))))) + +(ert-deftest test-ai-conversations-autosave-start-timer-idempotent () + "Boundary: starting autosave twice does not create a second timer." + (with-temp-buffer + (setq-local gptel-mode t) + (setq-local cj/gptel-autosave-enabled t) + (setq-local cj/gptel-autosave-filepath "/tmp/foo.gptel") + (setq-local cj/gptel-autosave--timer :existing-timer) + (let ((created 0)) + (cl-letf (((symbol-function 'run-with-timer) + (lambda (&rest _) + (setq created (1+ created)) + :new-timer))) + (cj/gptel--autosave-start-timer)) + (should (= created 0)) + (should (eq cj/gptel-autosave--timer :existing-timer))))) + +(ert-deftest test-ai-conversations-autosave-stop-timer-cancels () + "Normal: stopping autosave cancels the current buffer's timer." + (with-temp-buffer + (setq-local cj/gptel-autosave--timer :fake-timer) + (let ((cancelled nil)) + (cl-letf (((symbol-function 'cancel-timer) + (lambda (timer) (setq cancelled timer)))) + (cj/gptel--autosave-stop-timer)) + (should (eq cancelled :fake-timer)) + (should-not cj/gptel-autosave--timer)))) + +(ert-deftest test-ai-conversations-autosave-timer-callback-saves-active-buffer () + "Normal: timer callback saves the live buffer when autosave is active." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (let ((file (expand-file-name "timer.gptel" dir)) + (buf (generate-new-buffer " *gptel timer test*"))) + (unwind-protect + (with-current-buffer buf + (setq-local gptel-mode t) + (setq-local cj/gptel-autosave-enabled t) + (setq-local cj/gptel-autosave-filepath file) + (insert "timer body") + (cj/gptel--autosave-timer-callback buf) + (should (file-exists-p file))) + (when (buffer-live-p buf) + (kill-buffer buf))))))) + +(ert-deftest test-ai-conversations-autosave-timer-callback-stops-inactive-buffer () + "Boundary: timer callback cancels itself when autosave is no longer active." + (let ((buf (generate-new-buffer " *gptel timer inactive*"))) + (unwind-protect + (with-current-buffer buf + (setq-local gptel-mode t) + (setq-local cj/gptel-autosave-enabled nil) + (setq-local cj/gptel-autosave-filepath "/tmp/foo.gptel") + (setq-local cj/gptel-autosave--timer :fake-timer) + (let ((cancelled nil)) + (cl-letf (((symbol-function 'cancel-timer) + (lambda (timer) (setq cancelled timer)))) + (cj/gptel--autosave-timer-callback buf)) + (should (eq cancelled :fake-timer)) + (should-not cj/gptel-autosave--timer))) + (when (buffer-live-p buf) + (kill-buffer buf))))) + +;; ------------------------------------------------------ save-conversation + +(ert-deftest test-ai-conversations-save-conversation-interactive-new-topic () + "Save-conversation writes file, enables autosave, and starts a timer." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (let ((ai-buffer (generate-new-buffer "*AI-Assistant*"))) + (unwind-protect + (progn + (with-current-buffer ai-buffer + (setq-local gptel-mode t) + (insert "session content")) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) "Test Topic")) + ((symbol-function 'y-or-n-p) + (lambda (&rest _) nil)) + ((symbol-function 'run-with-timer) + (lambda (&rest _) :save-timer))) + (cj/gptel-save-conversation) + (let ((files (directory-files dir nil "test-topic_.*\\.gptel$"))) + (should files) + (should (= 1 (length files)))) + ;; Autosave state is set in the AI buffer + (with-current-buffer ai-buffer + (should cj/gptel-autosave-enabled) + (should (stringp cj/gptel-autosave-filepath)) + (should (eq cj/gptel-autosave--timer :save-timer))))) + (kill-buffer ai-buffer)))))) + +(ert-deftest test-ai-conversations-save-conversation-error-no-buffer () + "Save-conversation errors when *AI-Assistant* doesn't exist." + (when (get-buffer "*AI-Assistant*") + (kill-buffer "*AI-Assistant*")) + (should-error (cj/gptel-save-conversation))) + +;; ------------------------------------------------------ delete-conversation + +(ert-deftest test-ai-conversations-delete-conversation-interactive () + "Delete-conversation removes the chosen file after confirmation." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (let ((file (test-ai-conversations--touch + dir "topic_20260101-100000.gptel"))) + (cl-letf (((symbol-function 'completing-read) + (lambda (_p cands &rest _) (caar cands))) + ((symbol-function 'y-or-n-p) + (lambda (&rest _) t))) + (cj/gptel-delete-conversation) + (should-not (file-exists-p file))))))) + +(ert-deftest test-ai-conversations-delete-conversation-cancelled () + "Delete-conversation preserves the file when the user declines." + (test-ai-conversations--with-temp-dir + (lambda (dir) + (let ((file (test-ai-conversations--touch + dir "topic_20260101-100000.gptel"))) + (cl-letf (((symbol-function 'completing-read) + (lambda (_p cands &rest _) (caar cands))) + ((symbol-function 'y-or-n-p) + (lambda (&rest _) nil))) + (cj/gptel-delete-conversation) + (should (file-exists-p file))))))) + +(ert-deftest test-ai-conversations-delete-conversation-error-empty-dir () + "Delete-conversation errors when no saved conversations exist." + (test-ai-conversations--with-temp-dir + (lambda (_dir) + (should-error (cj/gptel-delete-conversation))))) + +;; ------------------------------------------------------ install-once + +(ert-deftest test-ai-conversations-autosave-after-response-hook-not-duplicated () + "Loading ai-conversations twice does not duplicate the post-response hook." + (let ((gptel-post-response-functions + (list #'cj/gptel--autosave-after-response))) + ;; Re-run the install code + (unless (member #'cj/gptel--autosave-after-response gptel-post-response-functions) + (add-hook 'gptel-post-response-functions #'cj/gptel--autosave-after-response)) + (should (= 1 (cl-count #'cj/gptel--autosave-after-response + gptel-post-response-functions))))) + +;; --------------------------------------------- autosave-toggle / indicator + +(ert-deftest test-ai-conversations-autosave-toggle-enables-with-filepath () + "Toggle enables autosave when a filepath is set." + (with-temp-buffer + (setq-local gptel-mode t) + (setq-local cj/gptel-autosave-enabled nil) + (setq-local cj/gptel-autosave-filepath "/tmp/foo.gptel") + (cj/gptel-autosave-toggle) + (should cj/gptel-autosave-enabled))) + +(ert-deftest test-ai-conversations-autosave-toggle-disables () + "Toggle turns autosave off and cancels the periodic timer when already on." + (with-temp-buffer + (setq-local gptel-mode t) + (setq-local cj/gptel-autosave-enabled t) + (setq-local cj/gptel-autosave-filepath "/tmp/foo.gptel") + (setq-local cj/gptel-autosave--timer :fake-timer) + (let ((cancelled nil)) + (cl-letf (((symbol-function 'cancel-timer) + (lambda (timer) (setq cancelled timer)))) + (cj/gptel-autosave-toggle)) + (should-not cj/gptel-autosave-enabled) + (should (eq cancelled :fake-timer)) + (should-not cj/gptel-autosave--timer)))) + +(ert-deftest test-ai-conversations-autosave-toggle-prompts-when-no-filepath () + "Toggle prompts to save first when no filepath is configured." + (with-temp-buffer + (setq-local gptel-mode t) + (setq-local cj/gptel-autosave-enabled nil) + (setq-local cj/gptel-autosave-filepath nil) + (let ((prompted nil) + (save-called nil)) + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (&rest _) (setq prompted t) nil)) + ((symbol-function 'cj/gptel-save-conversation) + (lambda () (setq save-called t)))) + (cj/gptel-autosave-toggle)) + (should prompted) + (should-not save-called) + (should-not cj/gptel-autosave-enabled)))) + +(ert-deftest test-ai-conversations-autosave-toggle-error-outside-gptel-mode () + "Toggle signals when called outside a gptel buffer." + (with-temp-buffer + (setq-local gptel-mode nil) + (should-error (cj/gptel-autosave-toggle)))) + +(ert-deftest test-ai-conversations-autosave-mode-line-format-evaluates () + "Mode-line format evaluates to \" [AS]\" only when autosave is enabled." + (with-temp-buffer + (setq-local cj/gptel-autosave-enabled t) + (should (equal (eval (cadr cj/gptel-autosave-mode-line-format)) + " [AS]"))) + (with-temp-buffer + (setq-local cj/gptel-autosave-enabled nil) + (should-not (eval (cadr cj/gptel-autosave-mode-line-format))))) + +(ert-deftest test-ai-conversations-install-mode-line-idempotent () + "Repeated installs do not duplicate the construct in mode-line-format." + (with-temp-buffer + (setq-local mode-line-format '("base")) + (cj/gptel--install-autosave-mode-line) + (cj/gptel--install-autosave-mode-line) + (cj/gptel--install-autosave-mode-line) + (should (= 1 (cl-count 'cj/gptel-autosave-mode-line-format mode-line-format))))) + +(provide 'test-ai-conversations) +;;; test-ai-conversations.el ends here diff --git a/archive/gptel/tests/test-ai-mcp-helpers.el b/archive/gptel/tests/test-ai-mcp-helpers.el new file mode 100644 index 000000000..5a995ff2d --- /dev/null +++ b/archive/gptel/tests/test-ai-mcp-helpers.el @@ -0,0 +1,419 @@ +;;; test-ai-mcp-helpers.el --- Tests for pure helpers in ai-mcp.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Normal / Boundary / Error tests for the side-effect-free helpers in +;; ai-mcp.el: secrets redaction, confirm-policy classifier, description +;; normalizer, Claude-config reader (mtime-cached), env / secret-args +;; resolution, server-alist builder. No real `~/.claude.json' reads; +;; fixtures are written to per-test temp files. No real subprocesses +;; or network calls. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-mcp) + +;; -------------------------------------------------------- fixtures + +(defconst test-ai-mcp--sentinel "REDACTED_TEST_SECRET" + "Sentinel that must never appear in any user-facing output.") + +(defconst test-ai-mcp--fixture-json + "{ + \"mcpServers\": { + \"drawio\": { + \"type\": \"stdio\", + \"command\": \"npx\", + \"args\": [\"-y\", \"@drawio/mcp\"] + }, + \"google-calendar\": { + \"type\": \"stdio\", + \"command\": \"npx\", + \"args\": [\"-y\", \"@cocal/google-calendar-mcp\"], + \"env\": { + \"GOOGLE_OAUTH_CREDENTIALS\": \"REDACTED_TEST_SECRET\" + } + }, + \"google-docs-personal\": { + \"type\": \"stdio\", + \"command\": \"npx\", + \"args\": [\"-y\", \"@a-bonus/google-docs-mcp\"], + \"env\": { + \"GOOGLE_CLIENT_ID\": \"REDACTED_TEST_SECRET\", + \"GOOGLE_CLIENT_SECRET\": \"REDACTED_TEST_SECRET\", + \"GOOGLE_MCP_PROFILE\": \"personal\" + } + }, + \"figma\": { + \"type\": \"stdio\", + \"command\": \"npx\", + \"args\": [\"-y\", \"figma-developer-mcp\", \"--figma-api-key=REDACTED_TEST_SECRET\", \"--stdio\"] + }, + \"linear\": { + \"type\": \"http\", + \"url\": \"https://mcp.linear.app/mcp\" + }, + \"slack-deepsat\": { + \"type\": \"sse\", + \"url\": \"http://127.0.0.1:13080/sse\" + } + } +}" + "Fixture matching the shape of a real ~/.claude.json mcpServers tree.") + +(defun test-ai-mcp--write-fixture (&optional content) + "Write CONTENT (defaults to the standard fixture) to a temp file. +Return the file path." + (let ((tmp (make-temp-file "test-ai-mcp-" nil ".json"))) + (with-temp-file tmp + (insert (or content test-ai-mcp--fixture-json))) + tmp)) + +(defmacro test-ai-mcp--with-fixture (var &rest body) + "Bind VAR to a fresh fixture file path and BODY-eval. Clean up after." + (declare (indent 1)) + `(let ((,var (test-ai-mcp--write-fixture)) + (cj/mcp--config-cache nil)) + (unwind-protect (progn ,@body) + (when (file-exists-p ,var) (delete-file ,var))))) + +;; -------------------------------------------------------- redact + +(ert-deftest test-ai-mcp-redact-token-eq-normal () + "Normal: --token=VALUE has the value replaced by ***." + (should (equal (cj/mcp--redact "--token=abc123") "--token=***"))) + +(ert-deftest test-ai-mcp-redact-token-spaced-boundary () + "Boundary: --token VALUE (space separator) is also redacted." + (should (equal (cj/mcp--redact "--token abc123") "--token ***"))) + +(ert-deftest test-ai-mcp-redact-secret-flag-normal () + "Normal: --secret=VALUE is redacted." + (should (equal (cj/mcp--redact "--secret=topsecret") "--secret=***"))) + +(ert-deftest test-ai-mcp-redact-password-flag-normal () + "Normal: --password=VALUE is redacted." + (should (equal (cj/mcp--redact "--password=hunter2") "--password=***"))) + +(ert-deftest test-ai-mcp-redact-figma-api-key-normal () + "Normal: --figma-api-key=VALUE is redacted (covers the figma case)." + (should (equal (cj/mcp--redact "--figma-api-key=figd_xyz") + "--figma-api-key=***"))) + +(ert-deftest test-ai-mcp-redact-authorization-header-normal () + "Normal: Authorization header value (scheme + token) is masked." + (should (equal (cj/mcp--redact "Authorization: Bearer ghp_xyz123") + "Authorization: ***"))) + +(ert-deftest test-ai-mcp-redact-url-token-normal () + "Normal: ?token=VALUE in a URL is masked." + (should (equal (cj/mcp--redact "https://api.example/v1?token=abc123&page=2") + "https://api.example/v1?token=***&page=2"))) + +(ert-deftest test-ai-mcp-redact-no-secrets-boundary () + "Boundary: a string with no known secrets is returned unchanged." + (should (equal (cj/mcp--redact "hello world, nothing secret here") + "hello world, nothing secret here"))) + +(ert-deftest test-ai-mcp-redact-empty-string-boundary () + "Boundary: empty string returns empty string." + (should (equal (cj/mcp--redact "") ""))) + +(ert-deftest test-ai-mcp-redact-multiple-secrets-boundary () + "Boundary: multiple secrets in one string are all redacted." + (let* ((input "--token=abc --secret=xyz --password=qwe") + (out (cj/mcp--redact input))) + (should (equal out "--token=*** --secret=*** --password=***")))) + +(ert-deftest test-ai-mcp-redact-nil-input-error () + "Error: nil input returns nil rather than signaling." + (should (null (cj/mcp--redact nil)))) + +(ert-deftest test-ai-mcp-redact-sentinel-never-leaks () + "Sentinel REDACTED_TEST_SECRET is replaced wherever it lives in a secret slot." + (dolist (input (list (format "--token=%s" test-ai-mcp--sentinel) + (format "--figma-api-key=%s" test-ai-mcp--sentinel) + (format "Authorization: Bearer %s" test-ai-mcp--sentinel) + (format "https://x/y?token=%s" test-ai-mcp--sentinel))) + (let ((out (cj/mcp--redact input))) + (should-not (string-match-p test-ai-mcp--sentinel out))))) + +;; -------------------------------------------------------- confirm-p + +(ert-deftest test-ai-mcp-confirm-p-write-pattern-normal () + "Normal: a write-prefixed tool name returns t." + (should (cj/mcp--confirm-p "mcp__linear__create_issue"))) + +(ert-deftest test-ai-mcp-confirm-p-read-pattern-normal () + "Normal: a read-prefixed tool name returns nil." + (should-not (cj/mcp--confirm-p "mcp__linear__list_issues"))) + +(ert-deftest test-ai-mcp-confirm-p-unknown-fails-closed-boundary () + "Boundary: a name matching neither read nor write defaults to t (fail closed)." + (should (cj/mcp--confirm-p "mcp__linear__frobnicate"))) + +(ert-deftest test-ai-mcp-confirm-p-explicit-remote-name-boundary () + "Boundary: REMOTE-NAME arg overrides the prefix-strip of GPTEL-NAME." + ;; The gptel-name claims read, but the explicit remote-name is a write + ;; verb, so confirm should still fire. + (should (cj/mcp--confirm-p "mcp__linear__list_issues" "create_issue"))) + +(ert-deftest test-ai-mcp-confirm-p-override-wins-boundary () + "Boundary: cj/mcp-tool-confirm-overrides wins over the classifier." + (let ((cj/mcp-tool-confirm-overrides + '(("mcp__linear__create_issue" . nil)))) + (should-not (cj/mcp--confirm-p "mcp__linear__create_issue")))) + +;; -------------------------------------------------------- normalize-description + +(ert-deftest test-ai-mcp-normalize-description-read-normal () + "Normal: a read tool gets the bare [SERVER] prefix." + (should (equal + (cj/mcp--normalize-description + "linear" + '(:name "list_issues" :description "List issues in a Linear team.")) + "[linear] List issues in a Linear team."))) + +(ert-deftest test-ai-mcp-normalize-description-write-normal () + "Normal: a write tool gets [SERVER WRITE] prefix." + (should (equal + (cj/mcp--normalize-description + "linear" + '(:name "create_issue" :description "Create a new Linear issue.")) + "[linear WRITE] Create a new Linear issue."))) + +(ert-deftest test-ai-mcp-normalize-description-unknown-boundary () + "Boundary: a tool matching neither classifier gets [SERVER ?] prefix." + (should (equal + (cj/mcp--normalize-description + "google-keep" + '(:name "frobnicate" :description "Do the frob thing.")) + "[google-keep ?] Do the frob thing."))) + +(ert-deftest test-ai-mcp-normalize-description-missing-upstream-boundary () + "Boundary: missing upstream description falls back to a placeholder." + (should (equal + (cj/mcp--normalize-description + "linear" + '(:name "list_issues")) + "[linear] (no description provided by server)"))) + +;; -------------------------------------------------------- read-claude-config + +(ert-deftest test-ai-mcp-read-claude-config-good-fixture-normal () + "Normal: parsing a well-formed fixture returns :ok t and the parsed data." + (test-ai-mcp--with-fixture path + (let ((result (cj/mcp--read-claude-config path))) + (should (plist-get result :ok)) + (should (plist-get (plist-get result :data) :mcpServers))))) + +(ert-deftest test-ai-mcp-read-claude-config-missing-file-error () + "Error: missing file returns :ok nil with :reason missing-file." + (let ((cj/mcp--config-cache nil) + (path "/nonexistent/path/never-will-exist.json")) + (let ((result (cj/mcp--read-claude-config path))) + (should-not (plist-get result :ok)) + (should (eq (plist-get result :reason) 'missing-file))))) + +(ert-deftest test-ai-mcp-read-claude-config-malformed-json-error () + "Error: malformed JSON returns :ok nil with :reason malformed-json and a message." + (let ((cj/mcp--config-cache nil) + (tmp (make-temp-file "test-ai-mcp-malformed-" nil ".json"))) + (unwind-protect + (progn + (with-temp-file tmp (insert "{ this is not valid json ::: ")) + (let ((result (cj/mcp--read-claude-config tmp))) + (should-not (plist-get result :ok)) + (should (eq (plist-get result :reason) 'malformed-json)) + (should (stringp (plist-get result :message))))) + (delete-file tmp)))) + +(ert-deftest test-ai-mcp-read-claude-config-empty-object-boundary () + "Boundary: an empty JSON object parses to ok with empty data plist." + (let ((cj/mcp--config-cache nil) + (tmp (make-temp-file "test-ai-mcp-empty-" nil ".json"))) + (unwind-protect + (progn + (with-temp-file tmp (insert "{}")) + (let ((result (cj/mcp--read-claude-config tmp))) + (should (plist-get result :ok)) + ;; :mcpServers is absent; plist-get returns nil. + (should-not (plist-get (plist-get result :data) :mcpServers)))) + (delete-file tmp)))) + +(ert-deftest test-ai-mcp-read-claude-config-cache-hit-boundary () + "Boundary: a second read with the same mtime reuses the cache. +We detect cache reuse by mutating the cached :data alist after the first +read and verifying the second read returns the mutated value." + (test-ai-mcp--with-fixture path + (let* ((first (cj/mcp--read-claude-config path)) + (cache cj/mcp--config-cache)) + (should (plist-get first :ok)) + ;; Mutate the cached :data so a cache-hit returns the marker. + (plist-put cache :data '(:sentinel cache-was-hit)) + (let ((second (cj/mcp--read-claude-config path))) + (should (equal (plist-get second :data) '(:sentinel cache-was-hit))))))) + +(ert-deftest test-ai-mcp-read-claude-config-cache-invalidate-on-mtime-boundary () + "Boundary: changing the file's mtime forces a reparse." + (test-ai-mcp--with-fixture path + (let* ((first (cj/mcp--read-claude-config path)) + (cache cj/mcp--config-cache)) + (should (plist-get first :ok)) + ;; Poison the cache, then bump mtime; the next read should reparse. + (plist-put cache :data '(:sentinel cache-was-hit)) + (set-file-times path (time-add (current-time) 2)) + ;; Update the cache var since set-file-times changed file mtime. + (setq cj/mcp--config-cache cache) + (let ((second (cj/mcp--read-claude-config path))) + ;; Real reparse should give us the real data, not the sentinel. + (should (plist-get (plist-get second :data) :mcpServers)))))) + +(ert-deftest test-ai-mcp-read-claude-config-missing-mcpservers-boundary () + "Boundary: a valid JSON without :mcpServers parses but the subtree is nil." + (let ((cj/mcp--config-cache nil) + (tmp (make-temp-file "test-ai-mcp-no-mcp-" nil ".json"))) + (unwind-protect + (progn + (with-temp-file tmp (insert "{\"other\": 1}")) + (let ((result (cj/mcp--read-claude-config tmp))) + (should (plist-get result :ok)) + (should-not (plist-get (plist-get result :data) :mcpServers)))) + (delete-file tmp)))) + +;; -------------------------------------------------------- get-env / get-secret-arg + +(ert-deftest test-ai-mcp-get-env-known-server-with-env-normal () + "Normal: env-bearing server returns its env plist." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path) + (env (cj/mcp--get-env "google-calendar"))) + (should (equal (plist-get env :GOOGLE_OAUTH_CREDENTIALS) + test-ai-mcp--sentinel))))) + +(ert-deftest test-ai-mcp-get-env-known-server-without-env-boundary () + "Boundary: a server with no env subtree returns nil." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path)) + (should-not (cj/mcp--get-env "drawio"))))) + +(ert-deftest test-ai-mcp-get-env-unknown-server-error () + "Error: unknown server returns nil without signaling." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path)) + (should-not (cj/mcp--get-env "no-such-server"))))) + +(ert-deftest test-ai-mcp-get-secret-arg-figma-normal () + "Normal: figma's --figma-api-key= value is extracted from args." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path) + (value (cj/mcp--get-secret-arg "figma" "--figma-api-key"))) + (should (equal value test-ai-mcp--sentinel))))) + +(ert-deftest test-ai-mcp-get-secret-arg-missing-flag-error () + "Error: a flag not in the server's args returns nil." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path) + (value (cj/mcp--get-secret-arg "figma" "--no-such-flag"))) + (should (null value))))) + +;; -------------------------------------------------------- build-server-alist + +(ert-deftest test-ai-mcp-build-server-alist-all-enabled-normal () + "Normal: with default specs and all-enabled list, alist has all 9 entries." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path) + (alist (cj/mcp--build-server-alist))) + (should (= (length alist) 9)) + ;; Every name appears. + (dolist (name '("linear" "notion" "figma" "slack-deepsat" "drawio" + "google-calendar" "google-docs-personal" + "google-docs-work" "google-keep")) + (should (assoc name alist)))))) + +(ert-deftest test-ai-mcp-build-server-alist-filter-by-enabled-boundary () + "Boundary: enabled subset of names produces a subset alist." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path) + (alist (cj/mcp--build-server-alist + cj/mcp-server-specs + '("drawio" "linear")))) + (should (= (length alist) 2)) + (should (assoc "drawio" alist)) + (should (assoc "linear" alist)) + (should-not (assoc "figma" alist))))) + +(ert-deftest test-ai-mcp-build-server-alist-stdio-shape-normal () + "Normal: a stdio entry has :type, :command, :args (no :url)." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path) + (alist (cj/mcp--build-server-alist + cj/mcp-server-specs '("drawio")))) + (let ((entry (cdr (assoc "drawio" alist)))) + (should (equal (plist-get entry :type) "stdio")) + (should (equal (plist-get entry :command) "npx")) + (should (listp (plist-get entry :args))) + (should-not (plist-get entry :url)))))) + +(ert-deftest test-ai-mcp-build-server-alist-http-shape-normal () + "Normal: an http entry has :type and :url (no :command)." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path) + (alist (cj/mcp--build-server-alist + cj/mcp-server-specs '("linear")))) + (let ((entry (cdr (assoc "linear" alist)))) + (should (equal (plist-get entry :type) "http")) + (should (equal (plist-get entry :url) "https://mcp.linear.app/mcp")) + (should-not (plist-get entry :command)))))) + +(ert-deftest test-ai-mcp-build-server-alist-sse-shape-normal () + "Normal: an sse entry has :type and :url." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path) + (alist (cj/mcp--build-server-alist + cj/mcp-server-specs '("slack-deepsat")))) + (let ((entry (cdr (assoc "slack-deepsat" alist)))) + (should (equal (plist-get entry :type) "sse")) + (should (equal (plist-get entry :url) + "http://127.0.0.1:13080/sse")))))) + +(ert-deftest test-ai-mcp-build-server-alist-env-merge-normal () + "Normal: env-bearing server has its env plist merged into the entry." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path) + (alist (cj/mcp--build-server-alist + cj/mcp-server-specs '("google-calendar")))) + (let* ((entry (cdr (assoc "google-calendar" alist))) + (env (plist-get entry :env))) + (should env) + (should (equal (plist-get env :GOOGLE_OAUTH_CREDENTIALS) + test-ai-mcp--sentinel)))))) + +(ert-deftest test-ai-mcp-build-server-alist-secret-args-splice-normal () + "Normal: figma's --figma-api-key= is spliced into :args from Claude config." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path) + (alist (cj/mcp--build-server-alist + cj/mcp-server-specs '("figma")))) + (let* ((entry (cdr (assoc "figma" alist))) + (args (plist-get entry :args)) + (api-arg (cl-find-if + (lambda (a) (string-prefix-p "--figma-api-key=" a)) + args))) + (should api-arg) + (should (equal api-arg (format "--figma-api-key=%s" + test-ai-mcp--sentinel))))))) + +(ert-deftest test-ai-mcp-build-server-alist-no-mutation-boundary () + "Boundary: building the alist does not mutate `cj/mcp-server-specs'." + (test-ai-mcp--with-fixture path + (let* ((cj/mcp-claude-config path) + (snapshot (copy-tree cj/mcp-server-specs))) + (cj/mcp--build-server-alist) + (should (equal cj/mcp-server-specs snapshot))))) + +(provide 'test-ai-mcp-helpers) +;;; test-ai-mcp-helpers.el ends here diff --git a/archive/gptel/tests/test-ai-quick-ask.el b/archive/gptel/tests/test-ai-quick-ask.el new file mode 100644 index 000000000..3e1f6460f --- /dev/null +++ b/archive/gptel/tests/test-ai-quick-ask.el @@ -0,0 +1,149 @@ +;;; test-ai-quick-ask.el --- Tests for ai-quick-ask -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the helpers and orchestration in ai-quick-ask.el. The +;; quick-ask buffer is exercised via `cl-letf' stubs on +;; `gptel-request' and friends so no network call ever happens. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +(require 'testutil-ai-config) +;; Stub gptel-request so cj/gptel-quick-ask doesn't try to hit the network. +(unless (fboundp 'gptel-request) + (defun gptel-request (&rest _args) nil)) + +(require 'ai-quick-ask) + +;; The quick-ask escalation reopens *AI-Assistant* through +;; cj/side-window-display, which reads the panel-width state ai-config owns. +;; ai-config isn't loaded here (it would pull in gptel), so declare those vars +;; globally to stand in for it -- a value-less defvar in the module is only +;; file-local to the byte-compiler, so the function reads them dynamically and +;; would otherwise hit void-variable. +(defvar cj/ai-assistant-window-width 0.4) +(defvar cj/--ai-assistant-width nil) + +;; ------------------------------ pure helpers + +(ert-deftest test-ai-quick-ask-initial-text-shape () + "Initial text is Q: <prompt> blank line then the response marker." + (should (equal (cj/gptel-quick--initial-text "hello?") + "Q: hello?\n\nA: "))) + +(ert-deftest test-ai-quick-ask-extract-response-normal () + "Extracts text after the response marker." + (should (equal (cj/gptel-quick--extract-response "Q: x\n\nA: hello world") + "hello world"))) + +(ert-deftest test-ai-quick-ask-extract-response-multiline () + "Multi-line response is returned in full." + (should (equal (cj/gptel-quick--extract-response + "Q: x\n\nA: first line\nsecond line\n") + "first line\nsecond line\n"))) + +(ert-deftest test-ai-quick-ask-extract-response-no-marker () + "Buffer without the marker returns nil." + (should-not (cj/gptel-quick--extract-response "no marker here"))) + +(ert-deftest test-ai-quick-ask-extract-response-empty () + "Empty buffer returns nil." + (should-not (cj/gptel-quick--extract-response ""))) + +(ert-deftest test-ai-quick-ask-seed-text-shape () + "Seed text has user heading, prompt, AI heading, response." + (let ((seed (cj/gptel-quick--seed-text "ask" "reply"))) + (should (string-match-p "^\\* .* \\[" seed)) + (should (string-match-p "ask" seed)) + (should (string-match-p "^\\* AI" seed)) + (should (string-match-p "reply" seed)))) + +(ert-deftest test-ai-quick-ask-seed-text-nil-response () + "Seed text with a nil response leaves an empty body for the AI side." + (let ((seed (cj/gptel-quick--seed-text "ask" nil))) + (should (string-match-p "^\\* AI" seed)))) + +;; ------------------------------ ask + +(ert-deftest test-ai-quick-ask-creates-buffer () + "Ask creates the *GPTel-Quick* buffer in cj/gptel-quick-mode." + (when (get-buffer cj/gptel-quick--buffer-name) + (kill-buffer cj/gptel-quick--buffer-name)) + (let (request-called) + (cl-letf (((symbol-function 'gptel-request) + (lambda (&rest _) (setq request-called t))) + ((symbol-function 'display-buffer) + (lambda (&rest _) nil))) + (cj/gptel-quick-ask "test prompt") + (let ((buf (get-buffer cj/gptel-quick--buffer-name))) + (should buf) + (with-current-buffer buf + (should (eq major-mode 'cj/gptel-quick-mode)) + (should (equal cj/gptel-quick--prompt "test prompt")) + (should (string-match-p "Q: test prompt" (buffer-string)))) + (kill-buffer buf)) + (should request-called)))) + +(ert-deftest test-ai-quick-ask-error-empty-prompt () + "Empty prompt signals." + (should-error (cj/gptel-quick-ask ""))) + +;; ------------------------------ dismiss + +(ert-deftest test-ai-quick-ask-dismiss-kills-buffer () + "Dismiss kills the *GPTel-Quick* buffer." + (let ((buf (get-buffer-create cj/gptel-quick--buffer-name))) + (should (buffer-live-p buf)) + (cj/gptel-quick-dismiss) + (should-not (buffer-live-p buf)))) + +(ert-deftest test-ai-quick-ask-dismiss-no-op-when-absent () + "Dismiss with no quick buffer is a no-op." + (when (get-buffer cj/gptel-quick--buffer-name) + (kill-buffer cj/gptel-quick--buffer-name)) + ;; Should not error + (cj/gptel-quick-dismiss)) + +;; ------------------------------ continue + +(ert-deftest test-ai-quick-ask-continue-seeds-ai-assistant () + "Continue seeds *AI-Assistant* with prompt + response and kills quick buffer." + (when (get-buffer cj/gptel-quick--buffer-name) + (kill-buffer cj/gptel-quick--buffer-name)) + (when (get-buffer "*AI-Assistant*") + (kill-buffer "*AI-Assistant*")) + (let ((display-called nil)) + (cl-letf (((symbol-function 'display-buffer-in-side-window) + (lambda (&rest _) (setq display-called t)))) + ;; Prepare a quick buffer with prompt + response + (with-current-buffer (get-buffer-create cj/gptel-quick--buffer-name) + (cj/gptel-quick-mode) + (let ((inhibit-read-only t)) + (insert (cj/gptel-quick--initial-text "what is X?")) + (insert "X is a thing.")) + (setq-local cj/gptel-quick--prompt "what is X?") + ;; Provide a stub *AI-Assistant* so continue doesn't try to call gptel. + (get-buffer-create "*AI-Assistant*") + (cj/gptel-quick-continue)) + (should display-called) + ;; *AI-Assistant* got the seed + (with-current-buffer "*AI-Assistant*" + (let ((body (buffer-string))) + (should (string-match-p "what is X?" body)) + (should (string-match-p "X is a thing\\." body)))) + ;; Quick buffer was dismissed + (should-not (get-buffer cj/gptel-quick--buffer-name)))) + (kill-buffer "*AI-Assistant*")) + +(ert-deftest test-ai-quick-ask-continue-error-outside-quick-buffer () + "Continue signals when called outside a quick-ask buffer." + (with-temp-buffer + (should-error (cj/gptel-quick-continue)))) + +(provide 'test-ai-quick-ask) +;;; test-ai-quick-ask.el ends here diff --git a/archive/gptel/tests/test-ai-rewrite.el b/archive/gptel/tests/test-ai-rewrite.el new file mode 100644 index 000000000..ddb831339 --- /dev/null +++ b/archive/gptel/tests/test-ai-rewrite.el @@ -0,0 +1,159 @@ +;;; test-ai-rewrite.el --- Tests for ai-rewrite.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the directive-picker wrappers around `gptel-rewrite'. +;; `gptel-rewrite' itself is stubbed so the tests verify what the +;; wrappers do (which directive body lands in the hook, which region +;; was captured) without touching the real rewrite UI. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "tests" user-emacs-directory)) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +(require 'testutil-ai-config) + +;; Stub the gptel-rewrite surface so the wrapper can dispatch to it +;; without loading the real package. testutil-ai-config provides a +;; non-interactive stub of `gptel-rewrite'; we override it with an +;; interactive recorder that captures the hook-derived directive body +;; and the active region. +(defvar gptel-rewrite-directives-hook nil) +(defvar test-ai-rewrite--captured-directive nil + "Last system-message body produced by the hook during a stub rewrite.") +(defvar test-ai-rewrite--captured-region nil + "Cons (BEG . END) captured from `mark' and `point' at stub-rewrite time.") +(defun gptel-rewrite () + "Stub: capture the directive body and the active region." + (interactive) + (setq test-ai-rewrite--captured-directive + (run-hook-with-args-until-success 'gptel-rewrite-directives-hook)) + (setq test-ai-rewrite--captured-region + (cons (region-beginning) (region-end)))) + +(require 'ai-rewrite) + +;; ---------------------------- defcustom shape + +(ert-deftest test-ai-rewrite-directives-defcustom-has-named-entries () + "Default directives include the names called out in the spec." + (let ((names (mapcar #'car cj/gptel-rewrite-directives))) + (dolist (expected '("terse" "fix-grammar" "refactor-readability" + "add-docstring" "explain-as-comment" "shorten")) + (should (member expected names))))) + +(ert-deftest test-ai-rewrite-directives-bodies-are-strings () + "Every directive body is a non-empty string." + (dolist (entry cj/gptel-rewrite-directives) + (should (stringp (cdr entry))) + (should (> (length (cdr entry)) 0)))) + +;; ---------------------------- with-directive + +(ert-deftest test-ai-rewrite-with-directive-normal () + "Wrapper injects the directive body and runs gptel-rewrite on the region." + (with-temp-buffer + (insert "first body line\nsecond body line\n") + (let ((test-ai-rewrite--captured-directive nil) + (test-ai-rewrite--captured-region nil) + (cj/gptel-rewrite-directives + '(("test" . "BODY FOR TEST DIRECTIVE")))) + ;; Activate the region across both lines + (set-mark (point-min)) + (goto-char (point-max)) + (activate-mark) + (cj/gptel-rewrite-with-directive "test") + (should (equal test-ai-rewrite--captured-directive + "BODY FOR TEST DIRECTIVE")) + (should test-ai-rewrite--captured-region)))) + +(ert-deftest test-ai-rewrite-with-directive-error-no-region () + "No active region signals." + (with-temp-buffer + (insert "no region") + (deactivate-mark) + (should-error (call-interactively #'cj/gptel-rewrite-with-directive)))) + +(ert-deftest test-ai-rewrite-with-directive-error-unknown-directive () + "Unknown directive name signals." + (with-temp-buffer + (insert "body") + (set-mark (point-min)) + (goto-char (point-max)) + (activate-mark) + (let ((cj/gptel-rewrite-directives '(("known" . "x")))) + (should-error + (cj/gptel-rewrite--call-with-directive + "unknown" (point-min) (point-max)))))) + +(ert-deftest test-ai-rewrite-with-directive-records-last-state () + "Wrapper records the region and directive name for later redo." + (with-temp-buffer + (insert "abc\ndef\n") + (let ((cj/gptel-rewrite-directives + '(("first" . "FIRST BODY"))) + (test-ai-rewrite--captured-directive nil)) + (set-mark (point-min)) + (goto-char (point-max)) + (activate-mark) + (cj/gptel-rewrite-with-directive "first") + (should (equal cj/gptel-rewrite--last-directive "first")) + (should (consp cj/gptel-rewrite--last-region)) + (should (markerp (car cj/gptel-rewrite--last-region))) + (should (markerp (cdr cj/gptel-rewrite--last-region)))))) + +;; ---------------------------- redo + +(ert-deftest test-ai-rewrite-redo-normal () + "Redo replays the last region with a new directive." + (with-temp-buffer + (insert "line1\nline2\nline3\n") + (let* ((cj/gptel-rewrite-directives + '(("first" . "FIRST BODY") + ("second" . "SECOND BODY"))) + (test-ai-rewrite--captured-directive nil) + (test-ai-rewrite--captured-region nil)) + (set-mark (point-min)) + (goto-char (point-max)) + (activate-mark) + (cj/gptel-rewrite-with-directive "first") + (should (equal test-ai-rewrite--captured-directive "FIRST BODY")) + (let ((first-region test-ai-rewrite--captured-region)) + (setq test-ai-rewrite--captured-directive nil) + (setq test-ai-rewrite--captured-region nil) + (cl-letf (((symbol-function 'completing-read) + (lambda (_p choices &rest _) (car choices)))) + (cj/gptel-rewrite-redo-with-different-directive)) + (should (equal test-ai-rewrite--captured-directive "SECOND BODY")) + (should (equal test-ai-rewrite--captured-region first-region)))))) + +(ert-deftest test-ai-rewrite-redo-error-no-previous () + "Redo without prior rewrite signals." + (with-temp-buffer + (setq-local cj/gptel-rewrite--last-region nil) + (should-error (cj/gptel-rewrite-redo-with-different-directive)))) + +(ert-deftest test-ai-rewrite-redo-excludes-current-directive () + "Redo's completing-read prompt offers every directive except the last." + (with-temp-buffer + (insert "body") + (let ((cj/gptel-rewrite-directives + '(("a" . "A") ("b" . "B") ("c" . "C"))) + (offered nil)) + (set-mark (point-min)) + (goto-char (point-max)) + (activate-mark) + (cj/gptel-rewrite-with-directive "b") + (cl-letf (((symbol-function 'completing-read) + (lambda (_p choices &rest _) + (setq offered choices) + (car choices)))) + (cj/gptel-rewrite-redo-with-different-directive)) + (should (equal (sort (copy-sequence offered) #'string<) + '("a" "c")))))) + +(provide 'test-ai-rewrite) +;;; test-ai-rewrite.el ends here diff --git a/archive/gptel/tests/test-gptel-tools-git-diff.el b/archive/gptel/tests/test-gptel-tools-git-diff.el new file mode 100644 index 000000000..114fec293 --- /dev/null +++ b/archive/gptel/tests/test-gptel-tools-git-diff.el @@ -0,0 +1,163 @@ +;;; test-gptel-tools-git-diff.el --- Tests for git_diff gptel tool -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests run against real temp git repos under HOME via `process-file'. + +;;; 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 'git_diff) + +;; ---------- helpers + +(defun test-gptel-tools-git-diff--with-repo (fn) + "Create a temp git repo under HOME with one committed file, call FN." + (let* ((name (format ".test-gptel-tools-git-diff-%s" + (format-time-string "%s%N"))) + (dir (expand-file-name name "~"))) + (unwind-protect + (progn + (make-directory dir) + (let ((default-directory dir)) + (call-process "git" nil nil nil "init" "--quiet") + (call-process "git" nil nil nil "config" "user.email" "test@x") + (call-process "git" nil nil nil "config" "user.name" "Test") + (with-temp-file (expand-file-name "f.txt" dir) + (insert "original\n")) + (call-process "git" nil nil nil "add" "f.txt") + (call-process "git" nil nil nil "commit" "--quiet" "-m" "initial")) + (funcall fn dir)) + (when (file-exists-p dir) (delete-directory dir t))))) + +;; ---------- build-args + +(ert-deftest test-gptel-tools-git-diff-build-args-no-refs () + "Normal: no refs / no file → bare diff args." + (should (equal (cj/gptel-git-diff--build-args nil nil nil) + '("-c" "color.ui=false" "diff")))) + +(ert-deftest test-gptel-tools-git-diff-build-args-with-ref1 () + "Normal: REF1 appended." + (should (equal (cj/gptel-git-diff--build-args "HEAD~1" nil nil) + '("-c" "color.ui=false" "diff" "HEAD~1")))) + +(ert-deftest test-gptel-tools-git-diff-build-args-with-both-refs () + "Normal: REF1 and REF2 both appended." + (should (equal (cj/gptel-git-diff--build-args "HEAD~1" "HEAD" nil) + '("-c" "color.ui=false" "diff" "HEAD~1" "HEAD")))) + +(ert-deftest test-gptel-tools-git-diff-build-args-with-file () + "Normal: FILE appended after `--'." + (should (equal (cj/gptel-git-diff--build-args nil nil "foo.txt") + '("-c" "color.ui=false" "diff" "--" "foo.txt")))) + +(ert-deftest test-gptel-tools-git-diff-build-args-boundary-empty-strings () + "Boundary: empty-string REF/FILE values are ignored." + (should (equal (cj/gptel-git-diff--build-args "" "" "") + '("-c" "color.ui=false" "diff")))) + +;; ---------- truncate + +(ert-deftest test-gptel-tools-git-diff-truncate-under-cap () + "Normal: short input returns unchanged." + (should (equal (cj/gptel-git-diff--truncate "small diff") "small diff"))) + +(ert-deftest test-gptel-tools-git-diff-truncate-over-cap () + "Boundary: output exceeding the cap is truncated with a marker." + (let* ((cap cj/gptel-git-diff--max-output-bytes) + (huge (make-string (+ cap 1000) ?x)) + (out (cj/gptel-git-diff--truncate huge))) + (should (string-match-p "\\[truncated:" out)) + (should (> (length huge) (length out))))) + +;; ---------- validate-path + +(ert-deftest test-gptel-tools-git-diff-validate-path-normal () + "Normal: validator accepts a git working tree." + (test-gptel-tools-git-diff--with-repo + (lambda (dir) + (should (equal (cj/gptel-git-diff--validate-path dir) dir))))) + +(ert-deftest test-gptel-tools-git-diff-validate-path-error-outside-home () + "Error: path outside HOME signals." + (should-error (cj/gptel-git-diff--validate-path "/etc"))) + +(ert-deftest test-gptel-tools-git-diff-validate-path-error-not-a-repo () + "Error: non-git directory signals." + (let ((dir (make-temp-file + (expand-file-name ".test-gptel-tools-git-diff-" "~") t))) + (unwind-protect + (should-error (cj/gptel-git-diff--validate-path dir)) + (when (file-exists-p dir) (delete-directory dir t))))) + +(ert-deftest test-gptel-tools-git-diff-validate-path-error-not-a-directory () + "Error: file paths are rejected." + (let ((file (make-temp-file + (expand-file-name ".test-gptel-tools-git-diff-file-" "~")))) + (unwind-protect + (should-error (cj/gptel-git-diff--validate-path file)) + (when (file-exists-p file) (delete-file file))))) + +(ert-deftest test-gptel-tools-git-diff-validate-path-error-symlink-outside-home () + "Error: symlinked directories resolving outside HOME are rejected." + (let ((link (expand-file-name + (format ".test-gptel-tools-git-diff-link-%s" + (format-time-string "%s%N")) + "~"))) + (unwind-protect + (progn + (make-symbolic-link "/tmp" link t) + (should-error (cj/gptel-git-diff--validate-path link))) + (when (file-symlink-p link) (delete-file link))))) + +;; ---------- run + +(ert-deftest test-gptel-tools-git-diff-run-no-changes () + "Boundary: a clean tree with no refs returns the no-diff marker." + (test-gptel-tools-git-diff--with-repo + (lambda (dir) + (let ((out (cj/gptel-git-diff--run dir))) + (should (string-match-p "No diff" out)))))) + +(ert-deftest test-gptel-tools-git-diff-run-unstaged-change () + "Normal: an unstaged edit appears as a real diff." + (test-gptel-tools-git-diff--with-repo + (lambda (dir) + (with-temp-file (expand-file-name "f.txt" dir) + (insert "changed\n")) + (let ((out (cj/gptel-git-diff--run dir))) + (should (string-match-p "^-original" out)) + (should (string-match-p "^\\+changed" out)))))) + +(ert-deftest test-gptel-tools-git-diff-run-narrow-to-file () + "Normal: FILE argument narrows the diff." + (test-gptel-tools-git-diff--with-repo + (lambda (dir) + (with-temp-file (expand-file-name "f.txt" dir) + (insert "changed\n")) + (with-temp-file (expand-file-name "g.txt" dir) + (insert "second file\n")) + (let ((out (cj/gptel-git-diff--run dir nil nil "f.txt"))) + (should (string-match-p "f.txt" out)) + (should-not (string-match-p "g.txt" out)))))) + +(ert-deftest test-gptel-tools-git-diff-run-error-on-bad-ref () + "Error: git diff exits other than 0/1 are surfaced." + (test-gptel-tools-git-diff--with-repo + (lambda (dir) + (should-error (cj/gptel-git-diff--run dir "does-not-exist"))))) + +(provide 'test-gptel-tools-git-diff) +;;; test-gptel-tools-git-diff.el ends here diff --git a/archive/gptel/tests/test-gptel-tools-git-log.el b/archive/gptel/tests/test-gptel-tools-git-log.el new file mode 100644 index 000000000..c0503039a --- /dev/null +++ b/archive/gptel/tests/test-gptel-tools-git-log.el @@ -0,0 +1,183 @@ +;;; test-gptel-tools-git-log.el --- Tests for git_log gptel tool -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests run against real temp git repos under HOME via `process-file'. + +;;; 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 'git_log) + +;; ---------- helpers + +(defun test-gptel-tools-git-log--with-repo (commit-count fn) + "Create a temp git repo under HOME with COMMIT-COUNT empty commits. +Call FN with the absolute path, clean up after." + (let* ((name (format ".test-gptel-tools-git-log-%s" + (format-time-string "%s%N"))) + (dir (expand-file-name name "~"))) + (unwind-protect + (progn + (make-directory dir) + (let ((default-directory dir)) + (call-process "git" nil nil nil "init" "--quiet") + (call-process "git" nil nil nil "config" "user.email" "test@x") + (call-process "git" nil nil nil "config" "user.name" "Test") + (dotimes (i commit-count) + (let ((process-environment + (append + (list "GIT_AUTHOR_DATE=2000-01-01T00:00:00+0000" + "GIT_COMMITTER_DATE=2000-01-01T00:00:00+0000") + process-environment))) + (call-process "git" nil nil nil "commit" "--allow-empty" + "--quiet" "-m" (format "commit %d" i))))) + (funcall fn dir)) + (when (file-exists-p dir) (delete-directory dir t))))) + +;; ---------- effective-count + +(ert-deftest test-gptel-tools-git-log-effective-count-defaults-on-nil () + "Boundary: nil N → default count." + (should (= (cj/gptel-git-log--effective-count nil) + cj/gptel-git-log--default-count))) + +(ert-deftest test-gptel-tools-git-log-effective-count-defaults-on-non-integer () + "Boundary: non-integer N → default count." + (should (= (cj/gptel-git-log--effective-count "ten") + cj/gptel-git-log--default-count)) + (should (= (cj/gptel-git-log--effective-count 0.5) + cj/gptel-git-log--default-count))) + +(ert-deftest test-gptel-tools-git-log-effective-count-clamps-low () + "Boundary: N below 1 → default count." + (should (= (cj/gptel-git-log--effective-count 0) + cj/gptel-git-log--default-count)) + (should (= (cj/gptel-git-log--effective-count -5) + cj/gptel-git-log--default-count))) + +(ert-deftest test-gptel-tools-git-log-effective-count-caps-high () + "Boundary: N above max → max." + (should (= (cj/gptel-git-log--effective-count 1000) + cj/gptel-git-log--max-count))) + +(ert-deftest test-gptel-tools-git-log-effective-count-normal () + "Normal: a valid N passes through." + (should (= (cj/gptel-git-log--effective-count 5) 5))) + +;; ---------- validate-path + +(ert-deftest test-gptel-tools-git-log-validate-path-normal () + "Normal: validator accepts a git working tree." + (test-gptel-tools-git-log--with-repo + 1 + (lambda (dir) + (should (equal (cj/gptel-git-log--validate-path dir) dir))))) + +(ert-deftest test-gptel-tools-git-log-validate-path-error-outside-home () + "Error: path outside HOME signals." + (should-error (cj/gptel-git-log--validate-path "/etc"))) + +(ert-deftest test-gptel-tools-git-log-validate-path-error-not-a-repo () + "Error: directory outside any git working tree signals." + (let ((dir (make-temp-file + (expand-file-name ".test-gptel-tools-git-log-" "~") t))) + (unwind-protect + (should-error (cj/gptel-git-log--validate-path dir)) + (when (file-exists-p dir) (delete-directory dir t))))) + +(ert-deftest test-gptel-tools-git-log-validate-path-error-not-a-directory () + "Error: file paths are rejected." + (let ((file (make-temp-file + (expand-file-name ".test-gptel-tools-git-log-file-" "~")))) + (unwind-protect + (should-error (cj/gptel-git-log--validate-path file)) + (when (file-exists-p file) (delete-file file))))) + +(ert-deftest test-gptel-tools-git-log-validate-path-error-symlink-outside-home () + "Error: symlinked directories resolving outside HOME are rejected." + (let ((link (expand-file-name + (format ".test-gptel-tools-git-log-link-%s" + (format-time-string "%s%N")) + "~"))) + (unwind-protect + (progn + (make-symbolic-link "/tmp" link t) + (should-error (cj/gptel-git-log--validate-path link))) + (when (file-symlink-p link) (delete-file link))))) + +;; ---------- run + +(ert-deftest test-gptel-tools-git-log-run-default-count () + "Normal: default count limits output to that many commits." + (test-gptel-tools-git-log--with-repo + 30 + (lambda (dir) + (let* ((out (cj/gptel-git-log--run dir)) + (lines (split-string (string-trim out) "\n"))) + (should (= (length lines) cj/gptel-git-log--default-count)))))) + +(ert-deftest test-gptel-tools-git-log-run-honors-n () + "Normal: an explicit N limits output to N commits." + (test-gptel-tools-git-log--with-repo + 10 + (lambda (dir) + (let* ((out (cj/gptel-git-log--run dir 3)) + (lines (split-string (string-trim out) "\n"))) + (should (= (length lines) 3)))))) + +(ert-deftest test-gptel-tools-git-log-run-since-no-match () + "Boundary: --since filter with no matching commits returns marker." + (test-gptel-tools-git-log--with-repo + 1 + (lambda (dir) + (let ((out (cj/gptel-git-log--run dir 10 "2001-01-01"))) + (should (string-match-p "No commits" out)))))) + +(ert-deftest test-gptel-tools-git-log-run-error-on-git-log-failure () + "Error: non-zero git log exits are surfaced." + (test-gptel-tools-git-log--with-repo + 1 + (lambda (dir) + (cl-letf (((symbol-function 'process-file) + (lambda (program infile destination display &rest args) + (if (member "log" args) + (progn + (when (bufferp destination) + (with-current-buffer destination (insert "bad log"))) + 2) + (apply #'call-process program infile destination display args))))) + (should-error (cj/gptel-git-log--run dir)))))) + +(ert-deftest test-gptel-tools-git-log-run-empty-repo () + "Boundary: a repo with no commits returns the empty-result marker." + (let* ((name (format ".test-gptel-tools-git-log-empty-%s" + (format-time-string "%s%N"))) + (dir (expand-file-name name "~"))) + (unwind-protect + (progn + (make-directory dir) + (let ((default-directory dir)) + (call-process "git" nil nil nil "init" "--quiet")) + ;; git log on a no-commits repo errors in some versions, but + ;; our wrapper turns "no commits" into the no-match marker. + (let ((res (ignore-errors (cj/gptel-git-log--run dir)))) + ;; Either path is acceptable: error captured (nil) or the + ;; explicit "No commits matching" marker. + (should (or (null res) + (string-match-p "No commits" res))))) + (when (file-exists-p dir) (delete-directory dir t))))) + +(provide 'test-gptel-tools-git-log) +;;; test-gptel-tools-git-log.el ends here diff --git a/archive/gptel/tests/test-gptel-tools-git-status.el b/archive/gptel/tests/test-gptel-tools-git-status.el new file mode 100644 index 000000000..471938535 --- /dev/null +++ b/archive/gptel/tests/test-gptel-tools-git-status.el @@ -0,0 +1,124 @@ +;;; test-gptel-tools-git-status.el --- Tests for git_status gptel tool -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests run against real temp git repos under HOME via `process-file'. +;; The tool is read-only so repos are torn down per test. + +;;; 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 'git_status) + +;; ---------- helpers + +(defun test-gptel-tools-git-status--with-repo (fn) + "Create a temp git repo under HOME, call FN with its absolute path, clean up." + (let* ((name (format ".test-gptel-tools-git-status-%s" + (format-time-string "%s%N"))) + (dir (expand-file-name name "~"))) + (unwind-protect + (progn + (make-directory dir) + (let ((default-directory dir)) + (call-process "git" nil nil nil "init" "--quiet") + (call-process "git" nil nil nil "config" "user.email" "test@x") + (call-process "git" nil nil nil "config" "user.name" "Test") + (call-process "git" nil nil nil "commit" "--allow-empty" + "--quiet" "-m" "initial")) + (funcall fn dir)) + (when (file-exists-p dir) (delete-directory dir t))))) + +;; ---------- validate-path + +(ert-deftest test-gptel-tools-git-status-validate-path-normal () + "Normal: validator accepts a directory inside a git working tree." + (test-gptel-tools-git-status--with-repo + (lambda (dir) + (should (equal (cj/gptel-git-status--validate-path dir) dir))))) + +(ert-deftest test-gptel-tools-git-status-validate-path-error-outside-home () + "Error: path outside HOME signals." + (should-error (cj/gptel-git-status--validate-path "/etc"))) + +(ert-deftest test-gptel-tools-git-status-validate-path-error-not-a-directory () + "Error: path that's not a directory signals." + (let ((file (make-temp-file + (expand-file-name ".test-gptel-tools-git-status-" "~")))) + (unwind-protect + (should-error (cj/gptel-git-status--validate-path file)) + (when (file-exists-p file) (delete-file file))))) + +(ert-deftest test-gptel-tools-git-status-validate-path-error-not-a-repo () + "Error: directory outside any git working tree signals." + (let ((dir (make-temp-file + (expand-file-name ".test-gptel-tools-git-status-" "~") t))) + (unwind-protect + (should-error (cj/gptel-git-status--validate-path dir)) + (when (file-exists-p dir) (delete-directory dir t))))) + +(ert-deftest test-gptel-tools-git-status-validate-path-error-symlink-outside-home () + "Error: symlinked directories resolving outside HOME are rejected." + (let ((link (expand-file-name + (format ".test-gptel-tools-git-status-link-%s" + (format-time-string "%s%N")) + "~"))) + (unwind-protect + (progn + (make-symbolic-link "/tmp" link t) + (should-error (cj/gptel-git-status--validate-path link))) + (when (file-symlink-p link) (delete-file link))))) + +;; ---------- run + +(ert-deftest test-gptel-tools-git-status-run-clean-tree () + "Normal: a clean repo returns the clean-tree marker." + (test-gptel-tools-git-status--with-repo + (lambda (dir) + (let ((out (cj/gptel-git-status--run dir))) + (should (string-match-p "Clean working tree" out)))))) + +(ert-deftest test-gptel-tools-git-status-run-dirty-tree-includes-file () + "Normal: an untracked file appears in the output." + (test-gptel-tools-git-status--with-repo + (lambda (dir) + (with-temp-file (expand-file-name "new.txt" dir) (insert "x")) + (let ((out (cj/gptel-git-status--run dir))) + (should (string-match-p "new.txt" out)) + (should (string-match-p "^\\?\\?" out)))))) + +(ert-deftest test-gptel-tools-git-status-run-includes-branch () + "Normal: the `--branch' line surfaces in the output." + (test-gptel-tools-git-status--with-repo + (lambda (dir) + (with-temp-file (expand-file-name "f.txt" dir) (insert "x")) + (let ((out (cj/gptel-git-status--run dir))) + (should (string-match-p "^## " out)))))) + +(ert-deftest test-gptel-tools-git-status-run-error-on-git-status-failure () + "Error: non-zero git status exits are surfaced." + (test-gptel-tools-git-status--with-repo + (lambda (dir) + (cl-letf (((symbol-function 'process-file) + (lambda (program infile destination display &rest args) + (if (member "status" args) + (progn + (when (bufferp destination) + (with-current-buffer destination (insert "bad status"))) + 2) + (apply #'call-process program infile destination display args))))) + (should-error (cj/gptel-git-status--run dir)))))) + +(provide 'test-gptel-tools-git-status) +;;; test-gptel-tools-git-status.el ends here diff --git a/archive/gptel/tests/test-gptel-tools-list-directory-files.el b/archive/gptel/tests/test-gptel-tools-list-directory-files.el new file mode 100644 index 000000000..9588ce8be --- /dev/null +++ b/archive/gptel/tests/test-gptel-tools-list-directory-files.el @@ -0,0 +1,257 @@ +;;; test-gptel-tools-list-directory-files.el --- Tests for list_directory_files -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the helpers in list_directory_files.el. + +;;; 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 'list_directory_files) + +;; -------------------------- helpers + +(defun test-gptel-tools-list--with-tree (fn) + "Create a small directory tree, call FN with its root, clean up." + (let ((root (make-temp-file "test-gptel-tools-list-" t))) + (unwind-protect + (progn + (with-temp-file (expand-file-name "a.txt" root) (insert "a")) + (with-temp-file (expand-file-name "b.org" root) (insert "b")) + (make-directory (expand-file-name "sub" root)) + (with-temp-file (expand-file-name "sub/c.txt" root) (insert "c")) + (funcall fn root)) + (delete-directory root t)))) + +;; -------------------------- mode-to-permissions + +(ert-deftest test-gptel-tools-list-mode-to-permissions-regular-file () + "Mode 0644 on a regular file: -rw-r--r--." + (should (equal (list-directory-files--mode-to-permissions #o0644) + "-rw-r--r--"))) + +(ert-deftest test-gptel-tools-list-mode-to-permissions-directory () + "Mode 0755 + dir bit: drwxr-xr-x." + (should (equal (list-directory-files--mode-to-permissions + (logior #o40000 #o0755)) + "drwxr-xr-x"))) + +(ert-deftest test-gptel-tools-list-mode-to-permissions-executable () + "Mode 0700: -rwx------." + (should (equal (list-directory-files--mode-to-permissions #o0700) + "-rwx------"))) + +;; -------------------------- get-file-info + +(ert-deftest test-gptel-tools-list-get-file-info-success () + "Success: returns a plist with :success t and metadata." + (test-gptel-tools-list--with-tree + (lambda (root) + (let ((info (list-directory-files--get-file-info + (expand-file-name "a.txt" root)))) + (should (plist-get info :success)) + (should (numberp (plist-get info :size))) + (should (stringp (plist-get info :permissions))))))) + +(ert-deftest test-gptel-tools-list-get-file-info-directory () + "Directory info: :is-directory is t." + (test-gptel-tools-list--with-tree + (lambda (root) + (let ((info (list-directory-files--get-file-info + (expand-file-name "sub" root)))) + (should (plist-get info :is-directory)))))) + +(ert-deftest test-gptel-tools-list-get-file-info-error () + "Error: metadata failures are returned as failed info plists." + (cl-letf (((symbol-function 'file-attributes) + (lambda (&rest _args) (error "stat failed")))) + (let ((info (list-directory-files--get-file-info "/tmp/nope"))) + (should-not (plist-get info :success)) + (should (string-match-p "stat failed" (plist-get info :error)))))) + +;; -------------------------- filter-by-extension + +(ert-deftest test-gptel-tools-list-filter-by-extension-keeps-match () + "Filter for txt keeps txt files." + (let* ((filter (list-directory-files--filter-by-extension "txt")) + (info '(:success t :path "/x/foo.txt" :is-directory nil))) + (should (funcall filter info)))) + +(ert-deftest test-gptel-tools-list-filter-by-extension-drops-non-match () + "Filter for txt drops non-txt files." + (let* ((filter (list-directory-files--filter-by-extension "txt")) + (info '(:success t :path "/x/foo.org" :is-directory nil))) + (should-not (funcall filter info)))) + +(ert-deftest test-gptel-tools-list-filter-by-extension-always-keeps-directories () + "Filter keeps directories regardless of extension." + (let* ((filter (list-directory-files--filter-by-extension "txt")) + (info '(:success t :path "/x/sub" :is-directory t))) + (should (funcall filter info)))) + +(ert-deftest test-gptel-tools-list-filter-by-extension-no-extension-is-nil () + "No extension produces a nil filter (i.e. no filtering)." + (should-not (list-directory-files--filter-by-extension nil))) + +(ert-deftest test-gptel-tools-list-filter-by-extension-case-insensitive () + "Boundary: extension filtering is case-insensitive." + (let* ((filter (list-directory-files--filter-by-extension "txt")) + (info '(:success t :path "/x/FOO.TXT" :is-directory nil))) + (should (funcall filter info)))) + +(ert-deftest test-gptel-tools-list-filter-by-extension-drops-failed-file-info () + "Boundary: failed file info entries do not pass file extension filters." + (let* ((filter (list-directory-files--filter-by-extension "txt")) + (info '(:success nil :path "/x/foo.txt" :is-directory nil))) + (should-not (funcall filter info)))) + +;; -------------------------- format-file-entry + +(ert-deftest test-gptel-tools-list-format-file-entry-shape () + "Formatted entry contains permissions, size, mtime, and relative path." + (let* ((info (list (cons :path "/home/u/foo.txt") + (cons :permissions "-rw-r--r--") + (cons :executable nil) + (cons :size 42) + (cons :last-modified (current-time)))) + ;; Build as plist by flattening the cons list. + (info-plist (cl-loop for (k . v) in info append (list k v))) + (out (list-directory-files--format-file-entry info-plist "/home/u"))) + (should (string-match-p "-rw-r--r--" out)) + (should (string-match-p "foo.txt" out)))) + +;; -------------------------- list-directory + +(ert-deftest test-gptel-tools-list-list-directory-flat () + "Non-recursive listing returns only entries in the top level." + (test-gptel-tools-list--with-tree + (lambda (root) + (let* ((result (list-directory-files--list-directory root nil nil)) + (files (plist-get result :files))) + (should files) + (let ((paths (mapcar (lambda (i) (plist-get i :path)) files))) + (should (cl-some (lambda (p) (string-match-p "/a\\.txt\\'" p)) paths)) + (should-not (cl-some (lambda (p) (string-match-p "/c\\.txt\\'" p)) paths))))))) + +(ert-deftest test-gptel-tools-list-list-directory-recursive () + "Recursive listing also returns sub-directory contents." + (test-gptel-tools-list--with-tree + (lambda (root) + (let* ((result (list-directory-files--list-directory root t nil)) + (files (plist-get result :files)) + (paths (mapcar (lambda (i) (plist-get i :path)) files))) + (should (cl-some (lambda (p) (string-match-p "/c\\.txt\\'" p)) paths)))))) + +(ert-deftest test-gptel-tools-list-list-directory-max-depth () + "Boundary: max-depth limits recursive traversal." + (test-gptel-tools-list--with-tree + (lambda (root) + (let* ((result (list-directory-files--list-directory root t nil 0)) + (files (plist-get result :files)) + (paths (mapcar (lambda (i) (plist-get i :path)) files))) + (should-not (cl-some (lambda (p) (string-match-p "/c\\.txt\\'" p)) paths)))))) + +(ert-deftest test-gptel-tools-list-list-directory-filtered-recursive-keeps-matching-files () + "Normal: recursive extension filter returns matching nested files." + (test-gptel-tools-list--with-tree + (lambda (root) + (let* ((filter (list-directory-files--filter-by-extension "txt")) + (result (list-directory-files--list-directory root t filter)) + (files (plist-get result :files)) + (paths (mapcar (lambda (i) (plist-get i :path)) files))) + (should (cl-some (lambda (p) (string-match-p "/a\\.txt\\'" p)) paths)) + (should (cl-some (lambda (p) (string-match-p "/c\\.txt\\'" p)) paths)) + (should-not (cl-some (lambda (p) (string-match-p "/b\\.org\\'" p)) paths)))))) + +(ert-deftest test-gptel-tools-list-list-directory-records-entry-errors () + "Error: per-entry metadata failures are collected." + (test-gptel-tools-list--with-tree + (lambda (root) + (cl-letf (((symbol-function 'list-directory-files--get-file-info) + (lambda (path) + (if (string-match-p "/a\\.txt\\'" path) + (list :success nil :path path :error "denied") + (let* ((attrs (file-attributes path 'string)) + (dirp (eq t (file-attribute-type attrs)))) + (list :success t + :path path + :size 0 + :last-modified (current-time) + :is-directory dirp + :permissions "-rw-r--r--" + :executable nil)))))) + (let ((errors (plist-get (list-directory-files--list-directory root nil nil) + :errors))) + (should errors) + (should (string-match-p "denied" (car errors)))))))) + +(ert-deftest test-gptel-tools-list-list-directory-error-not-a-directory () + "Non-directory path returns errors entry." + (test-gptel-tools-list--with-tree + (lambda (root) + (let* ((result (list-directory-files--list-directory + (expand-file-name "a.txt" root) nil nil)) + (errors (plist-get result :errors))) + (should errors))))) + +(ert-deftest test-gptel-tools-list-list-directory-error-accessing-directory () + "Error: directory access failures are collected." + (test-gptel-tools-list--with-tree + (lambda (root) + (cl-letf (((symbol-function 'directory-files) + (lambda (&rest _args) (error "cannot list")))) + (let ((errors (plist-get (list-directory-files--list-directory root nil nil) + :errors))) + (should errors) + (should (string-match-p "cannot list" (car errors)))))))) + +;; -------------------------- format-output + +(ert-deftest test-gptel-tools-list-format-output-has-files-section () + "Format-output includes a \"Found N file(s)\" line when files present." + (test-gptel-tools-list--with-tree + (lambda (root) + (let* ((result (list-directory-files--list-directory root nil nil)) + (out (list-directory-files--format-output root result))) + (should (string-match-p "Found [0-9]+ file" out)))))) + +(ert-deftest test-gptel-tools-list-format-output-empty () + "Empty result: \"No files found\"." + (let ((out (list-directory-files--format-output + "/nowhere" '(:files nil :errors nil)))) + (should (string-match-p "No files found" out)))) + +(ert-deftest test-gptel-tools-list-format-output-errors-only () + "Format-output includes errors when no files are present." + (let ((out (list-directory-files--format-output + "/nowhere" '(:files nil :errors ("boom"))))) + (should (string-match-p "Errors encountered" out)) + (should (string-match-p "boom" out)))) + +(ert-deftest test-gptel-tools-list-format-output-files-and-errors () + "Format-output separates file listings and errors." + (let* ((info (list :success t + :path (expand-file-name "foo.txt" "~") + :size 1 + :last-modified (current-time) + :is-directory nil + :permissions "-rw-r--r--" + :executable nil)) + (out (list-directory-files--format-output + "~" (list :files (list info) :errors (list "boom"))))) + (should (string-match-p "Found 1 file" out)) + (should (string-match-p "Errors encountered" out)))) + +(provide 'test-gptel-tools-list-directory-files) +;;; test-gptel-tools-list-directory-files.el ends here diff --git a/archive/gptel/tests/test-gptel-tools-move-to-trash.el b/archive/gptel/tests/test-gptel-tools-move-to-trash.el new file mode 100644 index 000000000..77f886277 --- /dev/null +++ b/archive/gptel/tests/test-gptel-tools-move-to-trash.el @@ -0,0 +1,219 @@ +;;; test-gptel-tools-move-to-trash.el --- Tests for move_to_trash gptel tool -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the helpers in move_to_trash.el. + +;;; 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 'move_to_trash) + +;; -------------------------- helpers + +(defun test-gptel-tools-trash--with-tmp-tree (fn) + "Create a temp source dir and trash dir; run FN with both; clean up." + (let* ((src (make-temp-file "test-gptel-tools-trash-src-" t)) + (trash (make-temp-file "test-gptel-tools-trash-dst-" t))) + (unwind-protect + (funcall fn src trash) + (when (file-exists-p src) (delete-directory src t)) + (when (file-exists-p trash) (delete-directory trash t))))) + +;; -------------------------- generate-unique-name + +(ert-deftest test-gptel-tools-trash-generate-unique-name-no-conflict () + "No conflict: returns the plain base name in trash." + (test-gptel-tools-trash--with-tmp-tree + (lambda (_src trash) + (let ((out (gptel--move-to-trash-generate-unique-name + "/anywhere/foo.txt" trash))) + (should (equal (file-name-nondirectory out) "foo.txt")))))) + +(ert-deftest test-gptel-tools-trash-generate-unique-name-conflict-timestamps () + "Name conflict: returns a name with a timestamp suffix." + (test-gptel-tools-trash--with-tmp-tree + (lambda (_src trash) + (with-temp-file (expand-file-name "foo.txt" trash) (insert "")) + (let* ((out (gptel--move-to-trash-generate-unique-name + "/anywhere/foo.txt" trash)) + (name (file-name-nondirectory out))) + (should-not (equal name "foo.txt")) + (should (string-match-p "\\`foo-[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}-[0-9]\\{2\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\.txt\\'" + name)))))) + +(ert-deftest test-gptel-tools-trash-generate-unique-name-no-extension () + "Conflict on a name without extension: timestamp appended to the bare name." + (test-gptel-tools-trash--with-tmp-tree + (lambda (_src trash) + (with-temp-file (expand-file-name "noext" trash) (insert "")) + (let* ((out (gptel--move-to-trash-generate-unique-name + "/anywhere/noext" trash)) + (name (file-name-nondirectory out))) + (should-not (equal name "noext")) + (should (string-match-p "\\`noext-[0-9]" name)))))) + +;; -------------------------- validate-path + +(ert-deftest test-gptel-tools-trash-validate-path-normal-home () + "Normal: an existing path under HOME validates." + (let ((path (expand-file-name + (format ".test-gptel-tools-trash-home-%s.tmp" + (format-time-string "%s%N")) + "~"))) + (unwind-protect + (progn + (with-temp-file path (insert "")) + (should (equal (gptel--move-to-trash-validate-path path) + (expand-file-name path)))) + (when (file-exists-p path) (delete-file path))))) + +(ert-deftest test-gptel-tools-trash-validate-path-normal-tmp () + "Normal: an existing path under /tmp validates." + (let ((path (make-temp-file "test-gptel-tools-trash-tmpvalidate-"))) + (unwind-protect + (should (equal (gptel--move-to-trash-validate-path path) + (expand-file-name path))) + (when (file-exists-p path) (delete-file path))))) + +(ert-deftest test-gptel-tools-trash-validate-path-error-outside-allowed () + "Error: a path outside HOME or /tmp signals." + (should-error (gptel--move-to-trash-validate-path "/etc/hostname"))) + +(ert-deftest test-gptel-tools-trash-validate-path-error-tmp-prefix-trick () + "Error: paths that merely start with /tmp are not treated as /tmp children." + (should-error (gptel--move-to-trash-validate-path "/tmpnotreally/file"))) + +(ert-deftest test-gptel-tools-trash-validate-path-error-critical-dir () + "Error: critical directories (home root, .emacs.d, .config, /tmp) signal." + (should-error (gptel--move-to-trash-validate-path "~")) + (should-error (gptel--move-to-trash-validate-path "~/.emacs.d")) + (should-error (gptel--move-to-trash-validate-path "~/.config")) + (should-error (gptel--move-to-trash-validate-path "/tmp"))) + +(ert-deftest test-gptel-tools-trash-validate-path-error-missing () + "Error: missing path signals." + (let ((path (expand-file-name + (format ".test-gptel-tools-trash-missing-%s.tmp" + (format-time-string "%s%N")) + "~"))) + (when (file-exists-p path) (delete-file path)) + (should-error (gptel--move-to-trash-validate-path path)))) + +(ert-deftest test-gptel-tools-trash-validate-path-error-symlink-outside-allowed () + "Error: allowed-location symlinks resolving outside allowed roots are rejected." + (let ((link (expand-file-name + (format ".test-gptel-tools-trash-outside-link-%s.tmp" + (format-time-string "%s%N")) + "~"))) + (unwind-protect + (progn + (make-symbolic-link "/etc/hostname" link t) + (should-error (gptel--move-to-trash-validate-path link))) + (when (file-symlink-p link) (delete-file link))))) + +;; -------------------------- perform + +(ert-deftest test-gptel-tools-trash-perform-moves-file () + "Perform: moves the file out of the source dir into the trash dir." + (test-gptel-tools-trash--with-tmp-tree + (lambda (src trash) + (let ((file (expand-file-name "doomed.txt" src))) + (with-temp-file file (insert "trash me")) + (let ((status (gptel--move-to-trash-perform file trash))) + (should (string-match-p "moved to trash" status)) + (should-not (file-exists-p file)) + (should (file-exists-p (expand-file-name "doomed.txt" trash)))))))) + +(ert-deftest test-gptel-tools-trash-perform-handles-directory () + "Perform: moves a directory as a unit." + (test-gptel-tools-trash--with-tmp-tree + (lambda (src trash) + (let ((dir (expand-file-name "subdir" src))) + (make-directory dir) + (with-temp-file (expand-file-name "inside.txt" dir) (insert "x")) + (let ((status (gptel--move-to-trash-perform dir trash))) + (should (string-match-p "Directory moved to trash" status)) + (should-not (file-exists-p dir)) + (should (file-exists-p (expand-file-name "subdir/inside.txt" trash)))))))) + +(ert-deftest test-gptel-tools-trash-perform-handles-symlink () + "Perform: moving a symlink moves the link, not its target." + (test-gptel-tools-trash--with-tmp-tree + (lambda (src trash) + (let ((target (expand-file-name "target.txt" src)) + (link (expand-file-name "link.txt" src))) + (with-temp-file target (insert "target")) + (make-symbolic-link target link t) + (let ((status (gptel--move-to-trash-perform link trash))) + (should (string-match-p "Symlink moved to trash" status)) + (should (file-exists-p target)) + (should-not (file-symlink-p link)) + (should (file-symlink-p (expand-file-name "link.txt" trash)))))))) + +(ert-deftest test-gptel-tools-trash-perform-error-rename-failure () + "Error: rename failures are reported with context." + (test-gptel-tools-trash--with-tmp-tree + (lambda (src trash) + (let ((file (expand-file-name "doomed.txt" src))) + (with-temp-file file (insert "trash me")) + (cl-letf (((symbol-function 'rename-file) + (lambda (&rest _args) (error "rename failed")))) + (should-error (gptel--move-to-trash-perform file trash))) + (should (file-exists-p file)))))) + +(ert-deftest test-gptel-tools-trash-perform-error-permission-denied () + "Error: permission-denied rename failures get a specific message." + (test-gptel-tools-trash--with-tmp-tree + (lambda (src trash) + (let ((file (expand-file-name "denied.txt" src))) + (with-temp-file file (insert "trash me")) + (cl-letf (((symbol-function 'rename-file) + (lambda (&rest _args) + (signal 'permission-denied '("denied"))))) + (should-error (gptel--move-to-trash-perform file trash) + :type 'error)) + (should (file-exists-p file)))))) + +(ert-deftest test-gptel-tools-trash-perform-error-original-still-exists () + "Error: post-move verification catches a source path that remains." + (test-gptel-tools-trash--with-tmp-tree + (lambda (src trash) + (let ((file (expand-file-name "still-there.txt" src))) + (with-temp-file file (insert "trash me")) + (cl-letf (((symbol-function 'rename-file) + (lambda (&rest _args) nil))) + (should-error (gptel--move-to-trash-perform file trash))) + (should (file-exists-p file)))))) + +(ert-deftest test-gptel-tools-trash-perform-error-trash-missing-after-move () + "Error: post-move verification catches a missing trash target." + (test-gptel-tools-trash--with-tmp-tree + (lambda (src trash) + (let ((file (expand-file-name "missing-trash.txt" src)) + (real-file-exists-p (symbol-function 'file-exists-p))) + (with-temp-file file (insert "trash me")) + (cl-letf (((symbol-function 'rename-file) + (lambda (&rest _args) nil)) + ((symbol-function 'file-exists-p) + (lambda (path) + (cond + ((equal path file) nil) + ((string-prefix-p trash path) nil) + (t (funcall real-file-exists-p path)))))) + (should-error (gptel--move-to-trash-perform file trash))) + (should (funcall real-file-exists-p file)))))) + +(provide 'test-gptel-tools-move-to-trash) +;;; test-gptel-tools-move-to-trash.el ends here diff --git a/archive/gptel/tests/test-gptel-tools-read-buffer.el b/archive/gptel/tests/test-gptel-tools-read-buffer.el new file mode 100644 index 000000000..0a8548359 --- /dev/null +++ b/archive/gptel/tests/test-gptel-tools-read-buffer.el @@ -0,0 +1,74 @@ +;;; test-gptel-tools-read-buffer.el --- Tests for read_buffer gptel tool -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `cj/read-buffer--get-content', the testable helper that +;; backs the read_buffer gptel tool. + +;;; Code: + +(require 'ert) + +(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 'read_buffer) + +(ert-deftest test-gptel-tools-read-buffer-normal () + "Normal: returns the contents of an existing buffer." + (with-temp-buffer + (rename-buffer "test-gptel-tools-read-buffer-normal" t) + (insert "hello world") + (should (equal (cj/read-buffer--get-content (buffer-name)) "hello world")))) + +(ert-deftest test-gptel-tools-read-buffer-boundary-empty-buffer () + "Boundary: empty buffer returns the empty string." + (with-temp-buffer + (rename-buffer "test-gptel-tools-read-buffer-empty" t) + (should (equal (cj/read-buffer--get-content (buffer-name)) "")))) + +(ert-deftest test-gptel-tools-read-buffer-boundary-buffer-object () + "Boundary: accepts a buffer object as well as a name string." + (with-temp-buffer + (insert "from buffer object") + (should (equal (cj/read-buffer--get-content (current-buffer)) + "from buffer object")))) + +(ert-deftest test-gptel-tools-read-buffer-boundary-widened-content () + "Boundary: returns the whole buffer even when the buffer is narrowed." + (with-temp-buffer + (insert "visible\nhidden\n") + (narrow-to-region (point-min) (line-end-position)) + (should (equal (cj/read-buffer--get-content (current-buffer)) + "visible\nhidden\n")))) + +(ert-deftest test-gptel-tools-read-buffer-boundary-strips-text-properties () + "Boundary: the returned string has no text properties." + (with-temp-buffer + (rename-buffer "test-gptel-tools-read-buffer-props" t) + (insert (propertize "fontified" 'face 'bold)) + (let ((content (cj/read-buffer--get-content (buffer-name)))) + (should (equal content "fontified")) + (should-not (text-properties-at 0 content))))) + +(ert-deftest test-gptel-tools-read-buffer-error-missing-buffer () + "Error: nonexistent buffer name signals." + (when (get-buffer "test-gptel-tools-read-buffer-absent") + (kill-buffer "test-gptel-tools-read-buffer-absent")) + (should-error (cj/read-buffer--get-content + "test-gptel-tools-read-buffer-absent"))) + +(ert-deftest test-gptel-tools-read-buffer-error-killed-buffer-object () + "Error: a killed buffer object signals clearly." + (let ((buffer (generate-new-buffer "test-gptel-tools-read-buffer-killed"))) + (kill-buffer buffer) + (should-error (cj/read-buffer--get-content buffer)))) + +(provide 'test-gptel-tools-read-buffer) +;;; test-gptel-tools-read-buffer.el ends here diff --git a/archive/gptel/tests/test-gptel-tools-read-text-file.el b/archive/gptel/tests/test-gptel-tools-read-text-file.el new file mode 100644 index 000000000..db3d6e7ed --- /dev/null +++ b/archive/gptel/tests/test-gptel-tools-read-text-file.el @@ -0,0 +1,201 @@ +;;; test-gptel-tools-read-text-file.el --- Tests for read_text_file gptel tool -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the helpers in read_text_file.el. + +;;; 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 'read_text_file) + +;; -------------------------- helpers + +(defun test-gptel-tools-read-text-file--in-home (suffix content fn) + "Run FN with a temp file (containing CONTENT) under HOME using SUFFIX." + (let* ((name (format ".test-gptel-tools-read-text-file-%s-%s.tmp" + suffix (format-time-string "%s%N"))) + (path (expand-file-name name "~"))) + (unwind-protect + (progn + (with-temp-file path (insert content)) + (funcall fn path)) + (when (file-exists-p path) (delete-file path))))) + +;; -------------------------- validate-file-path + +(ert-deftest test-gptel-tools-read-text-file-validate-path-normal () + "Normal: an existing readable file under HOME passes." + (test-gptel-tools-read-text-file--in-home + "normal" "hi" + (lambda (path) + (should (equal (cj/validate-file-path path) (file-truename path)))))) + +(ert-deftest test-gptel-tools-read-text-file-validate-path-error-outside-home () + "Error: path outside HOME signals." + (should-error (cj/validate-file-path "/etc/hostname"))) + +(ert-deftest test-gptel-tools-read-text-file-validate-path-error-missing () + "Error: missing file signals." + (let ((path (expand-file-name + (format ".test-gptel-tools-read-text-file-missing-%s.tmp" + (format-time-string "%s%N")) + "~"))) + (when (file-exists-p path) (delete-file path)) + (should-error (cj/validate-file-path path)))) + +(ert-deftest test-gptel-tools-read-text-file-validate-path-error-directory () + "Error: a directory signals." + (should-error (cj/validate-file-path "~"))) + +(ert-deftest test-gptel-tools-read-text-file-validate-path-error-unreadable () + "Error: unreadable files signal." + (test-gptel-tools-read-text-file--in-home + "unreadable" "secret" + (lambda (path) + (cl-letf (((symbol-function 'file-readable-p) (lambda (_) nil))) + (should-error (cj/validate-file-path path)))))) + +(ert-deftest test-gptel-tools-read-text-file-validate-path-boundary-relative-home-path () + "Boundary: relative paths resolve under HOME." + (test-gptel-tools-read-text-file--in-home + "relative" "hi" + (lambda (path) + (let ((relative (file-relative-name path (expand-file-name "~")))) + (should (equal (cj/validate-file-path relative) + (file-truename path))))))) + +(ert-deftest test-gptel-tools-read-text-file-validate-path-boundary-symlink-inside-home () + "Boundary: symlinks inside HOME resolving inside HOME are accepted." + (test-gptel-tools-read-text-file--in-home + "symlink-target" "hi" + (lambda (target) + (let ((link (expand-file-name + (format ".test-gptel-tools-read-text-file-link-%s.tmp" + (format-time-string "%s%N")) + "~"))) + (unwind-protect + (progn + (make-symbolic-link target link t) + (should (equal (cj/validate-file-path link) + (file-truename target)))) + (when (file-symlink-p link) (delete-file link))))))) + +(ert-deftest test-gptel-tools-read-text-file-validate-path-error-symlink-outside-home () + "Error: symlinks inside HOME pointing outside HOME are rejected." + (let ((outside (make-temp-file "test-gptel-tools-read-text-file-outside-")) + (link (expand-file-name + (format ".test-gptel-tools-read-text-file-outside-link-%s.tmp" + (format-time-string "%s%N")) + "~"))) + (unwind-protect + (progn + (make-symbolic-link outside link t) + (should-error (cj/validate-file-path link))) + (when (file-exists-p outside) (delete-file outside)) + (when (file-symlink-p link) (delete-file link))))) + +;; -------------------------- get-file-metadata + +(ert-deftest test-gptel-tools-read-text-file-get-metadata-shape () + "Returns a plist with :size and :string keys." + (test-gptel-tools-read-text-file--in-home + "meta" "abc" + (lambda (path) + (let ((meta (cj/get-file-metadata path))) + (should (plist-get meta :size)) + (should (= 3 (plist-get meta :size))) + (should (stringp (plist-get meta :string))) + (should (string-match-p "modified" (plist-get meta :string))))))) + +;; -------------------------- check-file-size-limits + +(ert-deftest test-gptel-tools-read-text-file-size-limits-normal () + "Small size below warning limit is a no-op." + (should-not (cj/check-file-size-limits 1024 nil))) + +(ert-deftest test-gptel-tools-read-text-file-size-limits-error-hard-cap () + "Sizes above 100MB always signal." + (should-error (cj/check-file-size-limits (* 101 1024 1024) t)) + (should-error (cj/check-file-size-limits (* 101 1024 1024) nil))) + +(ert-deftest test-gptel-tools-read-text-file-size-limits-warning-with-no-confirm () + "Above 10MB but below 100MB with no-confirm passes through silently." + (should-not (cj/check-file-size-limits (* 11 1024 1024) t))) + +(ert-deftest test-gptel-tools-read-text-file-size-limits-warning-user-accepts () + "Above warning limit proceeds when the user accepts." + (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t))) + (should-not (cj/check-file-size-limits (* 11 1024 1024) nil)))) + +(ert-deftest test-gptel-tools-read-text-file-size-limits-warning-user-declines () + "Above warning limit signals when the user declines." + (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) nil))) + (should-error (cj/check-file-size-limits (* 11 1024 1024) nil)))) + +;; -------------------------- detect-binary-file + +(ert-deftest test-gptel-tools-read-text-file-detect-binary-text-file () + "Text file: detect-binary returns nil." + (test-gptel-tools-read-text-file--in-home + "text" "plain ascii content" + (lambda (path) + (should-not (cj/detect-binary-file path))))) + +(ert-deftest test-gptel-tools-read-text-file-detect-binary-with-null-byte () + "File with NUL in first 1024 bytes returns truthy." + (test-gptel-tools-read-text-file--in-home + "bin" (concat "head\0tail") + (lambda (path) + (should (cj/detect-binary-file path))))) + +;; -------------------------- handle-special-file-types + +(ert-deftest test-gptel-tools-read-text-file-handle-special-epub-error () + "EPUB special-type handler signals \"not yet implemented\"." + (should-error (cj/handle-special-file-types "/tmp/foo.epub" t))) + +(ert-deftest test-gptel-tools-read-text-file-handle-special-epub-cancel () + "EPUB special-type handler signals when user declines extraction." + (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) nil))) + (should-error (cj/handle-special-file-types "/tmp/foo.epub" nil)))) + +(ert-deftest test-gptel-tools-read-text-file-handle-special-pdf-cancel () + "PDF special-type handler signals when user declines extraction." + (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) nil))) + (should-error (cj/handle-special-file-types "/tmp/foo.pdf" nil)))) + +(ert-deftest test-gptel-tools-read-text-file-handle-special-pdf-empty-extraction () + "PDF special-type handler signals when extraction returns empty text." + (cl-letf (((symbol-function 'shell-command-to-string) (lambda (_cmd) ""))) + (should-error (cj/handle-special-file-types "/tmp/foo.pdf" t)))) + +(ert-deftest test-gptel-tools-read-text-file-handle-special-pdf-text () + "PDF special-type handler returns extracted text." + (cl-letf (((symbol-function 'shell-command-to-string) + (lambda (_cmd) "pdf text\n"))) + (should (equal (cj/handle-special-file-types "/tmp/foo.pdf" t) + "pdf text\n")))) + +(ert-deftest test-gptel-tools-read-text-file-handle-special-binary-cancel () + "Generic binary handler signals when user declines." + (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) nil))) + (should-error (cj/handle-special-file-types "/tmp/foo.bin" nil)))) + +(ert-deftest test-gptel-tools-read-text-file-handle-special-binary-returns-nil () + "Generic binary file with no-confirm returns nil to indicate normal read." + (should-not (cj/handle-special-file-types "/tmp/foo.bin" t))) + +(provide 'test-gptel-tools-read-text-file) +;;; test-gptel-tools-read-text-file.el ends here 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 000000000..10abe6eba --- /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 diff --git a/archive/gptel/tests/test-gptel-tools-write-text-file.el b/archive/gptel/tests/test-gptel-tools-write-text-file.el new file mode 100644 index 000000000..14bcb2a51 --- /dev/null +++ b/archive/gptel/tests/test-gptel-tools-write-text-file.el @@ -0,0 +1,223 @@ +;;; test-gptel-tools-write-text-file.el --- Tests for write_text_file gptel tool -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `cj/write-text-file--run' and its helpers. + +;;; 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 'write_text_file) + +;; ------------------------------------------------------- helpers + +(defun test-gptel-tools-write-text-file--in-home (suffix fn) + "Run FN with a fresh path under HOME using SUFFIX. Clean up after." + (let* ((name (format ".test-gptel-tools-write-text-file-%s-%s.tmp" + suffix (format-time-string "%s%N"))) + (path (expand-file-name name "~"))) + (unwind-protect + (funcall fn path) + (when (file-exists-p path) (delete-file path)) + (dolist (b (file-expand-wildcards (concat path "-*.bak"))) + (when (file-exists-p b) (delete-file b)))))) + +;; --------------------------------------------- validate-path + +(ert-deftest test-gptel-tools-write-text-file-validate-path-normal () + "Normal: returns the expanded path for a HOME-relative input." + (let ((result (cj/write-text-file--validate-path "foo.txt"))) + (should (string-prefix-p (expand-file-name "~") result)) + (should (string-suffix-p "/foo.txt" result)))) + +(ert-deftest test-gptel-tools-write-text-file-validate-path-error-outside-home () + "Error: a path outside HOME signals." + (should-error (cj/write-text-file--validate-path "/etc/hostname"))) + +(ert-deftest test-gptel-tools-write-text-file-validate-path-boundary-absolute-home-path () + "Boundary: absolute HOME paths are accepted." + (test-gptel-tools-write-text-file--in-home + "absolute" + (lambda (path) + (should (equal (cj/write-text-file--validate-path path) path))))) + +(ert-deftest test-gptel-tools-write-text-file-validate-path-error-existing-symlink-outside-home () + "Error: an existing symlink inside HOME pointing outside HOME is rejected." + (let ((outside (make-temp-file "test-gptel-tools-write-text-file-outside-")) + (link (expand-file-name + (format ".test-gptel-tools-write-text-file-outside-link-%s.tmp" + (format-time-string "%s%N")) + "~"))) + (unwind-protect + (progn + (make-symbolic-link outside link t) + (should-error (cj/write-text-file--validate-path link))) + (when (file-exists-p outside) (delete-file outside)) + (when (file-symlink-p link) (delete-file link))))) + +(ert-deftest test-gptel-tools-write-text-file-validate-path-error-parent-symlink-outside-home () + "Error: a parent symlink inside HOME pointing outside HOME is rejected." + (let ((outside-dir (make-temp-file "test-gptel-tools-write-text-file-outside-dir-" t)) + (link-dir (expand-file-name + (format ".test-gptel-tools-write-text-file-outside-dir-link-%s" + (format-time-string "%s%N")) + "~"))) + (unwind-protect + (progn + (make-symbolic-link outside-dir link-dir t) + (should-error + (cj/write-text-file--validate-path + (expand-file-name "child.txt" link-dir)))) + (when (file-symlink-p link-dir) (delete-file link-dir)) + (when (file-exists-p outside-dir) (delete-directory outside-dir t))))) + +;; --------------------------------------------- backup-name + +(ert-deftest test-gptel-tools-write-text-file-backup-name-shape () + "Backup names append a YYYY-MM-DD-HHMMSS suffix and .bak." + (let ((name (cj/write-text-file--backup-name "/home/user/foo.txt"))) + (should (string-prefix-p "/home/user/foo.txt-" name)) + (should (string-suffix-p ".bak" name)) + (should (string-match-p "-[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}-[0-9]\\{6\\}\\.bak\\'" + name)))) + +;; --------------------------------------------- ensure-parent + +(ert-deftest test-gptel-tools-write-text-file-ensure-parent-creates-missing () + "Normal: creates missing parent directories." + (let* ((base (make-temp-file "test-gptel-tools-write-text-file-" t)) + (deep (expand-file-name "a/b/c/file.txt" base))) + (unwind-protect + (progn + (cj/write-text-file--ensure-parent deep) + (should (file-directory-p (file-name-directory deep)))) + (delete-directory base t)))) + +(ert-deftest test-gptel-tools-write-text-file-ensure-parent-error-unwritable () + "Error: an unwritable parent signals." + (let* ((parent (make-temp-file "test-gptel-tools-write-text-file-ro-" t)) + (target (expand-file-name "child.txt" parent))) + (unwind-protect + (progn + (set-file-modes parent #o500) + (should-error (cj/write-text-file--ensure-parent target))) + (set-file-modes parent #o700) + (delete-directory parent t)))) + +(ert-deftest test-gptel-tools-write-text-file-ensure-parent-error-create-fails () + "Error: directory creation failures are wrapped with context." + (cl-letf (((symbol-function 'make-directory) + (lambda (&rest _args) (error "boom")))) + (should-error + (cj/write-text-file--ensure-parent + (expand-file-name "missing/child.txt" temporary-file-directory))))) + +;; --------------------------------------------- run + +(ert-deftest test-gptel-tools-write-text-file-run-normal () + "Normal: writes new content and returns a status string." + (test-gptel-tools-write-text-file--in-home + "new" + (lambda (path) + (let ((result (cj/write-text-file--run + (file-name-nondirectory path) "hello\n" nil))) + (should (string-match-p "Successfully wrote" result)) + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "hello\n"))))))) + +(ert-deftest test-gptel-tools-write-text-file-run-error-existing-no-overwrite () + "Error: existing file without overwrite signals." + (test-gptel-tools-write-text-file--in-home + "existing" + (lambda (path) + (with-temp-file path (insert "old content\n")) + (should-error (cj/write-text-file--run + (file-name-nondirectory path) "new content\n" nil)) + ;; File preserved + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "old content\n")))))) + +(ert-deftest test-gptel-tools-write-text-file-run-overwrite-creates-backup () + "Overwrite path makes a timestamped backup before writing." + (test-gptel-tools-write-text-file--in-home + "overwrite" + (lambda (path) + (with-temp-file path (insert "old content\n")) + (cj/write-text-file--run + (file-name-nondirectory path) "new content\n" t) + ;; New content landed + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "new content\n"))) + ;; Backup exists with old content + (let ((backups (file-expand-wildcards (concat path "-*.bak")))) + (should (= 1 (length backups))) + (with-temp-buffer + (insert-file-contents (car backups)) + (should (equal (buffer-string) "old content\n"))))))) + +(ert-deftest test-gptel-tools-write-text-file-run-boundary-empty-content () + "Boundary: nil content writes an empty file." + (test-gptel-tools-write-text-file--in-home + "empty" + (lambda (path) + (cj/write-text-file--run (file-name-nondirectory path) nil nil) + (should (file-exists-p path)) + (should (= 0 (file-attribute-size (file-attributes path))))))) + +(ert-deftest test-gptel-tools-write-text-file-run-large-user-accepts () + "Boundary: large writes proceed when the user accepts." + (test-gptel-tools-write-text-file--in-home + "large-accept" + (lambda (path) + (let ((cj/write-text-file--size-limit 3)) + (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t))) + (cj/write-text-file--run (file-name-nondirectory path) "abcdef" nil))) + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "abcdef")))))) + +(ert-deftest test-gptel-tools-write-text-file-run-large-user-declines () + "Error: large writes cancel cleanly when the user declines." + (test-gptel-tools-write-text-file--in-home + "large-decline" + (lambda (path) + (let ((cj/write-text-file--size-limit 3)) + (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) nil))) + (should-error + (cj/write-text-file--run (file-name-nondirectory path) "abcdef" nil)))) + (should-not (file-exists-p path))))) + +(ert-deftest test-gptel-tools-write-text-file-run-error-overwrite-backup-failure-preserves-file () + "Error: backup failure prevents overwrite and preserves existing file." + (test-gptel-tools-write-text-file--in-home + "backup-fails" + (lambda (path) + (with-temp-file path (insert "old\n")) + (cl-letf (((symbol-function 'copy-file) + (lambda (&rest _args) (error "copy failed")))) + (should-error + (cj/write-text-file--run (file-name-nondirectory path) "new\n" t))) + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "old\n")))))) + +(ert-deftest test-gptel-tools-write-text-file-run-error-outside-home () + "Error: a path outside HOME signals." + (should-error (cj/write-text-file--run "/etc/test-write.txt" "x" nil))) + +(provide 'test-gptel-tools-write-text-file) +;;; test-gptel-tools-write-text-file.el ends here diff --git a/archive/gptel/tests/test-update-text-file.el b/archive/gptel/tests/test-update-text-file.el new file mode 100644 index 000000000..fc4f8c36a --- /dev/null +++ b/archive/gptel/tests/test-update-text-file.el @@ -0,0 +1,473 @@ +;;; test-update-text-file.el --- Tests for update_text_file gptel tool -*- lexical-binding: t; -*- + +;;; Commentary: +;; Normal / Boundary / Error tests for each operation in +;; gptel-tools/update_text_file.el, plus file-level wrapper tests. +;; The pure-string helpers carry most of the coverage; the wrapper +;; only adds the I/O surface (backup, write, validation). + +;;; 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) + ;; Stub gptel so the tool file can be loaded without the real package. + (unless (featurep 'gptel) + (defvar gptel-tools nil) + (defun gptel-make-tool (&rest _args) nil) + (defun gptel-get-tool (&rest _args) nil) + (provide 'gptel))) + +(require 'update_text_file) + +;; ----------------------------------------------------- helpers + +(defun test-update-text-file--with-temp (content fn) + "Write CONTENT to a temp file, call FN with its path, then delete." + (let ((path (make-temp-file "test-update-text-file-"))) + (unwind-protect + (progn + (with-temp-file path (insert content)) + (funcall fn path)) + (when (file-exists-p path) (delete-file path))))) + +;; ----------------------------------------------------- replace + +(ert-deftest test-update-text-file-replace-normal () + "Normal: replace all occurrences of the literal pattern." + (should (equal (cj/update-text-file--replace "foo bar foo" "foo" "BAZ") + "BAZ bar BAZ"))) + +(ert-deftest test-update-text-file-replace-boundary-no-match () + "Boundary: pattern absent returns content unchanged." + (should (equal (cj/update-text-file--replace "abc" "xyz" "QQ") "abc"))) + +(ert-deftest test-update-text-file-replace-boundary-special-chars () + "Boundary: regex metacharacters in pattern are treated as literals." + (should (equal (cj/update-text-file--replace "a.b.c" "." "-") "a-b-c")) + (should (equal (cj/update-text-file--replace "(x)(y)" "(x)" "_") "_(y)")) + (should (equal (cj/update-text-file--replace "a$b" "$" "S") "aSb"))) + +(ert-deftest test-update-text-file-replace-boundary-unicode () + "Boundary: unicode in both pattern and replacement." + (should (equal (cj/update-text-file--replace "café résumé" "café" "thé") + "thé résumé"))) + +(ert-deftest test-update-text-file-replace-boundary-replacement-with-backref-like () + "Boundary: replacement strings with \\1 etc. are literal, not back-refs." + (should (equal (cj/update-text-file--replace "foo" "foo" "\\1bar") + "\\1bar"))) + +(ert-deftest test-update-text-file-replace-error-empty-pattern () + "Error: empty pattern signals." + (should-error (cj/update-text-file--replace "abc" "" "x"))) + +(ert-deftest test-update-text-file-replace-error-nil-pattern () + "Error: nil pattern signals." + (should-error (cj/update-text-file--replace "abc" nil "x"))) + +(ert-deftest test-update-text-file-replace-error-nil-replacement () + "Error: nil replacement signals." + (should-error (cj/update-text-file--replace "abc" "a" nil))) + +;; ----------------------------------------------------- append + +(ert-deftest test-update-text-file-append-normal () + "Normal: append adds text plus a trailing newline." + (should (equal (cj/update-text-file--append "line1\n" "line2") + "line1\nline2\n"))) + +(ert-deftest test-update-text-file-append-boundary-no-trailing-newline () + "Boundary: appends still produce a newline when content has none." + (should (equal (cj/update-text-file--append "abc" "def") + "abc\ndef\n"))) + +(ert-deftest test-update-text-file-append-boundary-empty-content () + "Boundary: appending to empty content yields just the new text + newline." + (should (equal (cj/update-text-file--append "" "hello") "hello\n"))) + +(ert-deftest test-update-text-file-append-boundary-text-with-trailing-newline () + "Boundary: text that already ends in newline isn't duplicated." + (should (equal (cj/update-text-file--append "a\n" "b\n") "a\nb\n"))) + +(ert-deftest test-update-text-file-append-error-empty-text () + "Error: empty text signals." + (should-error (cj/update-text-file--append "foo" ""))) + +(ert-deftest test-update-text-file-append-error-nil-text () + "Error: nil text signals." + (should-error (cj/update-text-file--append "foo" nil))) + +;; ----------------------------------------------------- prepend + +(ert-deftest test-update-text-file-prepend-normal () + "Normal: prepend adds text plus a separator newline." + (should (equal (cj/update-text-file--prepend "line1\n" "line0") + "line0\nline1\n"))) + +(ert-deftest test-update-text-file-prepend-boundary-empty-content () + "Boundary: prepending to empty content keeps just the new text + sep." + (should (equal (cj/update-text-file--prepend "" "hello") "hello\n"))) + +(ert-deftest test-update-text-file-prepend-boundary-text-with-trailing-newline () + "Boundary: text already terminated by newline is not double-broken." + (should (equal (cj/update-text-file--prepend "rest" "first\n") + "first\nrest"))) + +(ert-deftest test-update-text-file-prepend-error-empty-text () + "Error: empty text signals." + (should-error (cj/update-text-file--prepend "foo" ""))) + +(ert-deftest test-update-text-file-prepend-error-nil-text () + "Error: nil text signals." + (should-error (cj/update-text-file--prepend "foo" nil))) + +;; ----------------------------------------------------- insert-at-line + +(ert-deftest test-update-text-file-insert-at-line-normal () + "Normal: insert before line 2 of a 3-line file." + (should (equal (cj/update-text-file--insert-at-line "a\nb\nc\n" 2 "X") + "a\nX\nb\nc\n"))) + +(ert-deftest test-update-text-file-insert-at-line-boundary-first-line () + "Boundary: inserting at line 1 prepends." + (should (equal (cj/update-text-file--insert-at-line "a\nb\n" 1 "X") + "X\na\nb\n"))) + +(ert-deftest test-update-text-file-insert-at-line-boundary-one-past-end () + "Boundary: inserting one past the last line appends." + (should (equal (cj/update-text-file--insert-at-line "a\nb\n" 3 "X") + "a\nb\nX\n"))) + +(ert-deftest test-update-text-file-insert-at-line-boundary-no-trailing-newline () + "Boundary: works on content without a trailing newline." + (should (equal (cj/update-text-file--insert-at-line "a\nb" 2 "X") + "a\nX\nb"))) + +(ert-deftest test-update-text-file-insert-at-line-boundary-text-with-trailing-newline () + "Boundary: inserted text that ends in newline is not double-terminated." + (should (equal (cj/update-text-file--insert-at-line "a\nb\n" 2 "X\n") + "a\nX\nb\n"))) + +(ert-deftest test-update-text-file-insert-at-line-boundary-multiline-text () + "Boundary: multi-line inserted text is inserted as a block." + (should (equal (cj/update-text-file--insert-at-line "a\nb\n" 2 "X\nY") + "a\nX\nY\nb\n"))) + +(ert-deftest test-update-text-file-insert-at-line-boundary-empty-file-line-1 () + "Boundary: inserting at line 1 in an empty file works." + (should (equal (cj/update-text-file--insert-at-line "" 1 "X") + "X\n"))) + +(ert-deftest test-update-text-file-insert-at-line-error-empty-file-line-2 () + "Error: line 2 is out of range for an empty file." + (should-error (cj/update-text-file--insert-at-line "" 2 "X"))) + +(ert-deftest test-update-text-file-insert-at-line-error-out-of-range () + "Error: line number beyond file length signals." + (should-error (cj/update-text-file--insert-at-line "a\nb\n" 5 "X"))) + +(ert-deftest test-update-text-file-insert-at-line-error-zero () + "Error: line number 0 signals." + (should-error (cj/update-text-file--insert-at-line "a\n" 0 "X"))) + +(ert-deftest test-update-text-file-insert-at-line-error-negative () + "Error: negative line number signals." + (should-error (cj/update-text-file--insert-at-line "a\n" -1 "X"))) + +(ert-deftest test-update-text-file-insert-at-line-error-empty-text () + "Error: empty text signals." + (should-error (cj/update-text-file--insert-at-line "a\n" 1 ""))) + +;; ----------------------------------------------------- delete-lines + +(ert-deftest test-update-text-file-delete-lines-normal () + "Normal: removes lines containing the literal pattern." + (should (equal (cj/update-text-file--delete-lines "keep\nkill me\nkeep\n" "kill") + "keep\nkeep\n"))) + +(ert-deftest test-update-text-file-delete-lines-boundary-no-match () + "Boundary: pattern matches nothing returns content unchanged." + (should (equal (cj/update-text-file--delete-lines "a\nb\nc\n" "z") + "a\nb\nc\n"))) + +(ert-deftest test-update-text-file-delete-lines-boundary-all-lines-match () + "Boundary: every line removed yields the empty string." + (should (equal (cj/update-text-file--delete-lines "x\nx\nx\n" "x") ""))) + +(ert-deftest test-update-text-file-delete-lines-boundary-special-chars-literal () + "Boundary: regex metacharacters in pattern are treated as literals." + (should (equal (cj/update-text-file--delete-lines "a.b\naxb\n" ".") + "axb\n"))) + +(ert-deftest test-update-text-file-delete-lines-boundary-no-trailing-newline () + "Boundary: content without trailing newline keeps that shape." + (should (equal (cj/update-text-file--delete-lines "keep\ndrop" "drop") + "keep"))) + +(ert-deftest test-update-text-file-delete-lines-boundary-empty-file () + "Boundary: deleting from an empty file returns the empty string." + (should (equal (cj/update-text-file--delete-lines "" "anything") ""))) + +(ert-deftest test-update-text-file-delete-lines-boundary-backslash-literal () + "Boundary: backslashes in the pattern are literal." + (should (equal (cj/update-text-file--delete-lines "keep\npath\\name\n" "\\") + "keep\n"))) + +(ert-deftest test-update-text-file-delete-lines-error-empty-pattern () + "Error: empty pattern signals." + (should-error (cj/update-text-file--delete-lines "a\nb\n" ""))) + +(ert-deftest test-update-text-file-delete-lines-error-nil-pattern () + "Error: nil pattern signals." + (should-error (cj/update-text-file--delete-lines "a\nb\n" nil))) + +;; ----------------------------------------------------- apply-operation + +(ert-deftest test-update-text-file-apply-operation-dispatch () + "Each operation name dispatches to its transform." + (should (equal (cj/update-text-file--apply-operation "abc" "replace" "b" "B" nil) + "aBc")) + (should (equal (cj/update-text-file--apply-operation "a" "append" "b" nil nil) + "a\nb\n")) + (should (equal (cj/update-text-file--apply-operation "a" "prepend" "b" nil nil) + "b\na")) + (should (equal (cj/update-text-file--apply-operation "a\nb\n" "insert-at-line" "X" nil 2) + "a\nX\nb\n")) + (should (equal (cj/update-text-file--apply-operation "a\nb\n" "delete-lines" "a" nil nil) + "b\n"))) + +(ert-deftest test-update-text-file-apply-operation-error-unknown () + "Unknown operation signals." + (should-error (cj/update-text-file--apply-operation "x" "frobnicate" nil nil nil))) + +;; ----------------------------------------------------- validate-path + +(ert-deftest test-update-text-file-validate-path-normal () + "Normal: an existing readable+writable file under HOME passes." + (let* ((file (make-temp-file "test-update-text-file-"))) + (unwind-protect + (progn + ;; make-temp-file may land in /tmp; rebase to HOME for the test. + (let* ((home-file (expand-file-name + (concat ".test-update-text-file-" (format-time-string "%s") ".tmp") + "~"))) + (unwind-protect + (progn + (copy-file file home-file t) + (should (equal (cj/update-text-file--validate-path home-file) + (file-truename home-file)))) + (when (file-exists-p home-file) (delete-file home-file))))) + (when (file-exists-p file) (delete-file file))))) + +(ert-deftest test-update-text-file-validate-path-error-missing () + "Error: a missing file under HOME signals." + (let ((path (expand-file-name + (concat ".test-update-text-file-missing-" + (format-time-string "%s") ".tmp") + "~"))) + (when (file-exists-p path) (delete-file path)) + (should-error (cj/update-text-file--validate-path path)))) + +(ert-deftest test-update-text-file-validate-path-error-outside-home () + "Error: a path outside HOME signals." + (should-error (cj/update-text-file--validate-path "/etc/hostname"))) + +(ert-deftest test-update-text-file-validate-path-error-directory () + "Error: a directory signals." + (should-error (cj/update-text-file--validate-path "~"))) + +(ert-deftest test-update-text-file-validate-path-error-unreadable () + "Error: an unreadable file signals." + (test-update-text-file--in-home + "unreadable" "secret\n" + (lambda (path) + (cl-letf (((symbol-function 'file-readable-p) (lambda (_) nil))) + (should-error (cj/update-text-file--validate-path path)))))) + +(ert-deftest test-update-text-file-validate-path-error-unwritable () + "Error: an unwritable file signals." + (test-update-text-file--in-home + "unwritable" "locked\n" + (lambda (path) + (cl-letf (((symbol-function 'file-writable-p) (lambda (_) nil))) + (should-error (cj/update-text-file--validate-path path)))))) + +(ert-deftest test-update-text-file-validate-path-boundary-relative-home-path () + "Boundary: a relative path resolves under HOME." + (test-update-text-file--in-home + "relative" "ok\n" + (lambda (path) + (let ((relative (file-relative-name path (expand-file-name "~")))) + (should (equal (cj/update-text-file--validate-path relative) + (file-truename path))))))) + +(ert-deftest test-update-text-file-validate-path-boundary-symlink-inside-home () + "Boundary: a symlink inside HOME resolving inside HOME is accepted." + (test-update-text-file--in-home + "symlink-target" "ok\n" + (lambda (target) + (let ((link (expand-file-name + (format ".test-update-text-file-link-%s.tmp" + (format-time-string "%s%N")) + "~"))) + (unwind-protect + (progn + (make-symbolic-link target link t) + (should (equal (cj/update-text-file--validate-path link) + (file-truename target)))) + (when (file-symlink-p link) (delete-file link))))))) + +(ert-deftest test-update-text-file-validate-path-error-symlink-outside-home () + "Error: a symlink inside HOME pointing outside HOME is rejected." + (let ((outside (make-temp-file "test-update-text-file-outside-")) + (link (expand-file-name + (format ".test-update-text-file-outside-link-%s.tmp" + (format-time-string "%s%N")) + "~"))) + (unwind-protect + (progn + (make-symbolic-link outside link t) + (should-error (cj/update-text-file--validate-path link))) + (when (file-exists-p outside) (delete-file outside)) + (when (file-symlink-p link) (delete-file link))))) + +;; ----------------------------------------------------- backup-name + +(ert-deftest test-update-text-file-backup-name-shape () + "Backup names append a timestamped .bak suffix." + (let ((name (cj/update-text-file--backup-name "/home/user/foo.txt"))) + (should (string-prefix-p "/home/user/foo.txt-" name)) + (should (string-suffix-p ".bak" name)) + ;; Format is YYYY-MM-DD-HHMMSS. + (should (string-match-p "-[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}-[0-9]\\{6\\}\\.bak\\'" + name)))) + +;; ----------------------------------------------------- file-level wrapper + +(defun test-update-text-file--in-home (suffix content fn) + "Write CONTENT to a temp file under HOME with SUFFIX, call FN, then delete. +Backups (path-TS.bak) are cleaned up after FN returns." + (let* ((name (format ".test-update-text-file-%s-%s.tmp" + suffix (format-time-string "%s%N"))) + (path (expand-file-name name "~"))) + (unwind-protect + (progn + (with-temp-file path (insert content)) + (funcall fn path)) + (when (file-exists-p path) (delete-file path)) + (dolist (b (file-expand-wildcards (concat path "-*.bak"))) + (when (file-exists-p b) (delete-file b)))))) + +(ert-deftest test-update-text-file-run-replace-normal () + "Wrapper: replace operation rewrites the file and creates a backup." + (test-update-text-file--in-home + "replace" "alpha bravo alpha\n" + (lambda (path) + (let ((result (cj/update-text-file--run path "replace" "alpha" "GAMMA" nil))) + (should (string-match-p "Updated" result)) + (should (string-match-p "backup:" result)) + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "GAMMA bravo GAMMA\n"))) + (let ((backup (car (file-expand-wildcards (concat path "-*.bak"))))) + (should backup) + (with-temp-buffer + (insert-file-contents backup) + (should (equal (buffer-string) "alpha bravo alpha\n")))))))) + +(ert-deftest test-update-text-file-run-no-change-no-backup () + "Wrapper: no-op operation leaves the file untouched and creates no backup." + (test-update-text-file--in-home + "noop" "abc\n" + (lambda (path) + (let ((result (cj/update-text-file--run path "replace" "zzz" "QQ" nil))) + (should (string-match-p "No changes" result)) + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "abc\n"))) + (should-not (file-expand-wildcards (concat path "-*.bak"))))))) + +(ert-deftest test-update-text-file-run-append-normal () + "Wrapper: append operation adds a line to the file." + (test-update-text-file--in-home + "append" "first\n" + (lambda (path) + (cj/update-text-file--run path "append" "second" nil nil) + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "first\nsecond\n")))))) + +(ert-deftest test-update-text-file-run-insert-at-line-normal () + "Wrapper: insert-at-line inserts and rewrites the file." + (test-update-text-file--in-home + "insert" "a\nb\nc\n" + (lambda (path) + (cj/update-text-file--run path "insert-at-line" "X" nil 2) + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "a\nX\nb\nc\n")))))) + +(ert-deftest test-update-text-file-run-delete-lines-normal () + "Wrapper: delete-lines removes matching lines." + (test-update-text-file--in-home + "delete" "keep1\nkill\nkeep2\nkill\n" + (lambda (path) + (cj/update-text-file--run path "delete-lines" "kill" nil nil) + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "keep1\nkeep2\n")))))) + +(ert-deftest test-update-text-file-run-error-transform-leaves-file-unchanged () + "Wrapper: transform errors create no backup and leave the file unchanged." + (test-update-text-file--in-home + "transform-error" "abc\n" + (lambda (path) + (should-error (cj/update-text-file--run path "replace" "" "x" nil)) + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "abc\n"))) + (should-not (file-expand-wildcards (concat path "-*.bak")))))) + +(ert-deftest test-update-text-file-run-error-unknown-operation-leaves-file-unchanged () + "Wrapper: unknown operations create no backup and leave the file unchanged." + (test-update-text-file--in-home + "unknown-operation" "abc\n" + (lambda (path) + (should-error (cj/update-text-file--run path "frobnicate" "x" nil nil)) + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "abc\n"))) + (should-not (file-expand-wildcards (concat path "-*.bak")))))) + +(ert-deftest test-update-text-file-run-error-too-large-leaves-file-unchanged () + "Wrapper: the size guard errors before backup/write." + (test-update-text-file--in-home + "too-large" "abcdef\n" + (lambda (path) + (let ((cj/update-text-file--size-limit 3)) + (should-error (cj/update-text-file--run path "append" "x" nil nil))) + (with-temp-buffer + (insert-file-contents path) + (should (equal (buffer-string) "abcdef\n"))) + (should-not (file-expand-wildcards (concat path "-*.bak")))))) + +(ert-deftest test-update-text-file-run-error-missing-file () + "Wrapper: missing file signals." + (let ((path (expand-file-name + (concat ".test-update-text-file-absent-" + (format-time-string "%s") ".tmp") + "~"))) + (when (file-exists-p path) (delete-file path)) + (should-error (cj/update-text-file--run path "append" "x" nil nil)))) + +(ert-deftest test-update-text-file-run-error-outside-home () + "Wrapper: path outside home signals." + (should-error (cj/update-text-file--run "/etc/hostname" "append" "x" nil nil))) + +(provide 'test-update-text-file) +;;; test-update-text-file.el ends here diff --git a/archive/gptel/tests/testutil-ai-config.el b/archive/gptel/tests/testutil-ai-config.el new file mode 100644 index 000000000..c74862226 --- /dev/null +++ b/archive/gptel/tests/testutil-ai-config.el @@ -0,0 +1,81 @@ +;;; testutil-ai-config.el --- Test stubs for ai-config.el tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; Provides gptel and dependency stubs so ai-config.el can be loaded in +;; batch mode without the real gptel package. Must be required BEFORE +;; ai-config so stubs are in place when use-package :config runs. + +;;; Code: + +(setq load-prefer-newer t) + +;; Keep ai-config tests isolated from personal optional GPTel tool files. +(defvar cj/gptel-tools-directory (make-temp-file "gptel-tools-empty-" t)) +(defvar cj/gptel-local-tool-features nil) + +;; Pre-cache API keys so auth-source is never consulted +(defvar cj/anthropic-api-key-cached "test-anthropic-key") +(defvar cj/openai-api-key-cached "test-openai-key") + +;; Stub gptel variables (must exist before use-package :custom runs) +(defvar gptel-backend nil) +(defvar gptel-model nil) +(defvar gptel-mode nil) +(defvar gptel-prompt-prefix-alist nil) +(defvar gptel--debug nil) +(defvar gptel-default-mode nil) +(defvar gptel-expert-commands nil) +(defvar gptel-track-media nil) +(defvar gptel-include-reasoning nil) +(defvar gptel-log-level nil) +(defvar gptel-confirm-tool-calls nil) +(defvar gptel-directives nil) +(defvar gptel--system-message nil) +(defvar gptel-context--alist nil) +(defvar gptel-mode-map (make-sparse-keymap)) +(defvar gptel-post-response-functions nil) + +;; Stub gptel functions +(defun gptel-make-anthropic (name &rest _args) + "Stub: return a vector mimicking a gptel backend struct." + (vector 'cl-struct-gptel-backend name)) + +(defun gptel-make-openai (name &rest _args) + "Stub: return a vector mimicking a gptel backend struct." + (vector 'cl-struct-gptel-backend name)) + +(defun gptel-send (&rest _) "Stub." nil) +(defun gptel-menu (&rest _) "Stub." nil) +(defun gptel (&rest _) "Stub." nil) +(defun gptel-system-prompt (&rest _) "Stub." nil) +(defun gptel-rewrite (&rest _) "Stub." nil) +(defun gptel-add-file (&rest _) "Stub." nil) +(defun gptel-add (&rest _) "Stub." nil) +(defun gptel-backend-models (_backend) "Stub." nil) + +(provide 'gptel) +(provide 'gptel-context) + +;; Stub custom keymap (defined in user's keybinding config) +(defvar cj/custom-keymap (make-sparse-keymap)) + +;; Stub which-key +(unless (fboundp 'which-key-add-key-based-replacements) + (defun which-key-add-key-based-replacements (&rest _) "Stub." nil)) +(provide 'which-key) + +;; Stub gptel-prompts +(defun gptel-prompts-update (&rest _) "Stub." nil) +(defun gptel-prompts-add-update-watchers (&rest _) "Stub." nil) +(provide 'gptel-prompts) + +;; NOTE: gptel-magit is NOT stubbed here. ai-config.el now uses +;; with-eval-after-load 'magit instead of use-package gptel-magit, +;; so the magit integration only activates when magit is provided. +;; See test-ai-config-gptel-magit-lazy-loading.el for magit stub tests. + +;; Stub ai-conversations +(provide 'ai-conversations) + +(provide 'testutil-ai-config) +;;; testutil-ai-config.el ends here diff --git a/archive/gptel/tests/testutil-filesystem.el b/archive/gptel/tests/testutil-filesystem.el new file mode 100644 index 000000000..b1970b62d --- /dev/null +++ b/archive/gptel/tests/testutil-filesystem.el @@ -0,0 +1,180 @@ +;;; testutil-filesystem.el --- -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; This library provides reusable helper functions for GPTel filesystem tools. +;; +;; It uses f.el and core Emacs libraries for path manipulation, directory listing, +;; file info retrieval, filtering, and recursive traversal. +;; +;; Designed to be used by multiple tools that operate on the filesystem. +;; +;;; Code: + +(require 'f) +(require 'cl-lib) +(require 'subr-x) + +;; Get directory entries in PATH. Returns list of absolute paths. +;; Default excludes hidden files and directories (name begins with dot). +;; Optional INCLUDE-HIDDEN to include hidden entries. +;; Optional FILTER-PREDICATE is a function called on each absolute path to filter. +(defun cj/get--directory-entries (path &optional include-hidden filter-predicate) + "Return a list of entries (absolute paths) in directory PATH. +Entries exclude '.' and '..'. +By default, hidden entries (starting with '.') are excluded unless +INCLUDE-HIDDEN is non-nil. FILTER-PREDICATE, if non-nil, is a predicate +function called on each entry's absolute path; only entries where it returns +non-nil are included." + ;; Convert 'path' to an absolute filename string + (let* ((expanded-path (expand-file-name path)) + ;; get absolute paths in expanded directory + (entries (directory-files expanded-path t nil t)) + ;; remove "." ".." entries + (filtered-entries + (cl-remove-if + (lambda (entry) + (or (member (f-filename entry) '("." "..")) + ;; and hidden files include-hidden is non-nil. + (and (not include-hidden) + (string-prefix-p "." (f-filename entry))))) + entries))) + ;; apply filtered predicate if provided + (if filter-predicate + (seq-filter filter-predicate filtered-entries) + ;; retun filtered-entries + filtered-entries))) + +(defun cj/get-file-info (path) + "Get file information for PATH. +Returned plist keys: +:success t or nil +:error string error message if :success is nil +:path absolute file path (string) +:size file size (integer) +:last-modified last modification time (time value) +:directory boolean: t if a directory +:permissions string with symbolic permissions, e.g. \"drwxr-xr-x\" +:executable boolean: t if executable file +:owner string: owner name or UID if name unavailable +:group string: group name or GID if name unavailable" + ;; handle errors during evaluation + (condition-case err + (let* ((expanded-path (expand-file-name path))) + (if (not (file-readable-p expanded-path)) + ;; Explicit permission denied check + (list :success nil :path expanded-path :error + (format "Permission denied: %s" expanded-path)) + (let* + ;; t = return string names for uid/gid + ((attrs (file-attributes expanded-path t)) + (size (file-attribute-size attrs)) + (mod (file-attribute-modification-time attrs)) + (dirp (eq t (file-attribute-type attrs))) + (modes (file-modes expanded-path)) + (perm (cj/-mode-to-permissions modes)) + (execp (file-executable-p expanded-path)) + (owner (file-attribute-user-id attrs)) ; Get owner + (group (file-attribute-group-id attrs))) ; Get group + (list :success t :path expanded-path :size size :last-modified mod + :directory dirp :permissions perm :executable execp + :owner (or owner "unknown") + :group (or group "unknown"))))) + ;; if error, return failure plist with error info + (error (list :success nil :path path :error (error-message-string err))))) + +(defun cj/format-file-info (file-info base-path) + "Format FILE-INFO plist relative to BASE-PATH as a string. +Handles missing keys gracefully by supplying default values." + (let ((permissions (or (plist-get file-info :permissions) "")) + (executable (if (plist-get file-info :executable) "*" " ")) + (size (file-size-human-readable (or (plist-get file-info :size) 0))) + (last-modified (or (plist-get file-info :last-modified) (current-time))) + (path (or (plist-get file-info :path) base-path))) + (format " %s%s %10s %s %s" + permissions + executable + size + (format-time-string "%Y-%m-%d %H:%M" last-modified) + (file-relative-name path base-path)))) + +;; Convert file mode bits integer to string like ls -l, e.g. drwxr-xr-x +(defun cj/-mode-to-permissions (mode) + "Convert file MODE (returned by `file-modes') to symbolic permission string." + (concat + (if (eq (logand #o40000 mode) #o40000) "d" "-") + (mapconcat + (lambda (bits) + (concat (if (/= 0 (logand bits 4)) "r" "-") + (if (/= 0 (logand bits 2)) "w" "-") + (if (/= 0 (logand bits 1)) "x" "-"))) + (list (logand (/ mode 64) 7) + (logand (/ mode 8) 7) + (logand mode 7)) + ""))) + +;; Filter a list of file info plists by extension (case insensitive). +;; Always includes directories. +(defun cj/filter-by-extension (file-info-list extension) + "Keep only directories and files with EXTENSION from FILE-INFO-LIST. +EXTENSION should not include leading dot, e.g. \"org\"." + ;; return full list if no extension + (if (not extension) + file-info-list + (cl-remove-if-not + (lambda (fi) + ;; always keep directories + (or (plist-get fi :directory) + ;; and successful file entries + (and (plist-get fi :success) + ;; and file extensions that match case-insensitively + (string-suffix-p (concat "." extension) + (f-filename (plist-get fi :path)) + t)))) + file-info-list))) + +(defun cj/list-directory-recursive (path &optional include-hidden filter-predicate max-depth) + "Recursively list files under PATH applying FILTER-PREDICATE. +PATH is the directory to list. +INCLUDE-HIDDEN if non-nil, includes hidden files (those starting with '.'). +FILTER-PREDICATE, if non-nil, is a function called on file info plist and +returns non-nil to include file. +MAX-DEPTH limits recursion depth (nil or 0 = unlimited)." + ;; set up cl-recursive function with path and current depth + (cl-labels ((recurse (path depth) + (let ((expanded-path (expand-file-name path)) + ;; empty list to accumulate file info plists + (file-info-list '())) + ;; ensure we're working with directories only + (when (not (file-directory-p expanded-path)) + (error "Not a directory: %s" expanded-path)) + + ;; loop over each file in the path + (dolist (file-entry + (cj/get--directory-entries expanded-path include-hidden)) + ;; get the metadata for the file + (let ((file-metadata (cj/get-file-info file-entry))) + ;; if retrieving metadata was successful + (when (and file-metadata (plist-get file-metadata :success)) + ;; if there's no custom filter or it matches, add it to the list + (when (or (not filter-predicate) + (funcall filter-predicate file-metadata)) + (push file-metadata file-info-list)) + ;; if it's a directory and we're not at the max-depth + (when (and (plist-get file-metadata :directory) + (or (not max-depth) (< depth (1- max-depth)))) + ;; gather all the files and recurse with that file + (setq file-info-list + (nconc file-info-list (recurse file-entry (1+ depth))))) + ;; warn if recursion returned received both a success and error + (when (and (plist-get file-metadata :success) + (plist-get file-metadata :error)) + (message "Warning: %s" (plist-get file-metadata :error)))))) + ;; restore the file order (as they were pushed into reverse order) + (nreverse file-info-list)))) + ;; start recursion at the top level + (recurse path 0))) + +(provide 'testutil-filesystem) +;;; testutil-filesystem.el ends here. |
