diff options
| -rw-r--r-- | gptel-tools/git_diff.el | 8 | ||||
| -rw-r--r-- | gptel-tools/git_log.el | 8 | ||||
| -rw-r--r-- | gptel-tools/git_status.el | 8 | ||||
| -rw-r--r-- | gptel-tools/move_to_trash.el | 23 | ||||
| -rw-r--r-- | gptel-tools/read_buffer.el | 4 | ||||
| -rw-r--r-- | gptel-tools/read_text_file.el | 20 | ||||
| -rw-r--r-- | gptel-tools/update_text_file.el | 30 | ||||
| -rw-r--r-- | gptel-tools/web_fetch.el | 2 | ||||
| -rw-r--r-- | gptel-tools/write_text_file.el | 15 | ||||
| -rw-r--r-- | tests/test-gptel-tools-git-diff.el | 26 | ||||
| -rw-r--r-- | tests/test-gptel-tools-git-log.el | 52 | ||||
| -rw-r--r-- | tests/test-gptel-tools-git-status.el | 26 | ||||
| -rw-r--r-- | tests/test-gptel-tools-list-directory-files.el | 95 | ||||
| -rw-r--r-- | tests/test-gptel-tools-move-to-trash.el | 83 | ||||
| -rw-r--r-- | tests/test-gptel-tools-read-buffer.el | 14 | ||||
| -rw-r--r-- | tests/test-gptel-tools-read-text-file.el | 84 | ||||
| -rw-r--r-- | tests/test-gptel-tools-web-fetch.el | 72 | ||||
| -rw-r--r-- | tests/test-gptel-tools-write-text-file.el | 82 | ||||
| -rw-r--r-- | tests/test-update-text-file.el | 123 |
19 files changed, 736 insertions, 39 deletions
diff --git a/gptel-tools/git_diff.el b/gptel-tools/git_diff.el index daccdc20..47db8dae 100644 --- a/gptel-tools/git_diff.el +++ b/gptel-tools/git_diff.el @@ -23,11 +23,17 @@ "Validate PATH for a git diff call. Return the expanded path on success. Same contract as the other git_* validators: under HOME, a directory, inside a git working tree." - (let ((full (expand-file-name (or path "~") "~"))) + (let* ((home (file-name-as-directory (file-truename (expand-file-name "~")))) + (full (expand-file-name (or path "~") "~"))) (unless (string-prefix-p (expand-file-name "~") full) (error "Path must be within home directory: %s" path)) (unless (file-directory-p full) (error "Not a directory: %s" full)) + (let ((resolved (file-truename full))) + (unless (or (string= resolved (directory-file-name home)) + (string-prefix-p home resolved)) + (error "Resolved path must be within home directory: %s" path)) + (setq full resolved)) (let ((default-directory full)) (unless (zerop (process-file "git" nil nil nil "rev-parse" "--is-inside-work-tree")) diff --git a/gptel-tools/git_log.el b/gptel-tools/git_log.el index 9cfae263..324435dc 100644 --- a/gptel-tools/git_log.el +++ b/gptel-tools/git_log.el @@ -25,11 +25,17 @@ "Validate PATH for a git log call. Return the expanded path on success. Same contract as the git_status validator: must be under HOME, must be a directory, must be inside a git working tree." - (let ((full (expand-file-name (or path "~") "~"))) + (let* ((home (file-name-as-directory (file-truename (expand-file-name "~")))) + (full (expand-file-name (or path "~") "~"))) (unless (string-prefix-p (expand-file-name "~") full) (error "Path must be within home directory: %s" path)) (unless (file-directory-p full) (error "Not a directory: %s" full)) + (let ((resolved (file-truename full))) + (unless (or (string= resolved (directory-file-name home)) + (string-prefix-p home resolved)) + (error "Resolved path must be within home directory: %s" path)) + (setq full resolved)) (let ((default-directory full)) (unless (zerop (process-file "git" nil nil nil "rev-parse" "--is-inside-work-tree")) diff --git a/gptel-tools/git_status.el b/gptel-tools/git_status.el index 300d5da5..de76a985 100644 --- a/gptel-tools/git_status.el +++ b/gptel-tools/git_status.el @@ -23,11 +23,17 @@ PATH must resolve under the user's home directory, must be an existing directory, and must be inside a git working tree. Returns the expanded path string on success; signals `error' otherwise." - (let ((full (expand-file-name (or path "~") "~"))) + (let* ((home (file-name-as-directory (file-truename (expand-file-name "~")))) + (full (expand-file-name (or path "~") "~"))) (unless (string-prefix-p (expand-file-name "~") full) (error "Path must be within home directory: %s" path)) (unless (file-directory-p full) (error "Not a directory: %s" full)) + (let ((resolved (file-truename full))) + (unless (or (string= resolved (directory-file-name home)) + (string-prefix-p home resolved)) + (error "Resolved path must be within home directory: %s" path)) + (setq full resolved)) (let ((default-directory full)) (unless (zerop (process-file "git" nil nil nil "rev-parse" "--is-inside-work-tree")) diff --git a/gptel-tools/move_to_trash.el b/gptel-tools/move_to_trash.el index 6ea97995..923da790 100644 --- a/gptel-tools/move_to_trash.el +++ b/gptel-tools/move_to_trash.el @@ -41,7 +41,7 @@ YYYY-MM-DD-HH-MM-SS." (let* ((extension (file-name-extension base-name t)) (name-sans-ext (file-name-sans-extension base-name)) (timestamp (format-time-string "%Y-%m-%d-%H-%M-%S")) - (new-name (if extension + (new-name (if (and extension (not (string= extension ""))) (concat name-sans-ext "-" timestamp extension) (concat base-name "-" timestamp)))) (expand-file-name new-name trash-dir))))) @@ -51,15 +51,18 @@ YYYY-MM-DD-HH-MM-SS." Returns the expanded path if valid, signals an error otherwise. Ensures path is within home directory or /tmp, and prevents trashing of critical system directories." - (let ((expanded-path (expand-file-name path)) - (home-dir (expand-file-name "~")) - (critical-dirs (list (expand-file-name "~") - (expand-file-name "~/.emacs.d") - (expand-file-name "~/.config") - "/tmp"))) + (let* ((expanded-path (expand-file-name path)) + (resolved-path (and (file-exists-p expanded-path) + (file-truename expanded-path))) + (home-dir (file-name-as-directory (file-truename (expand-file-name "~")))) + (tmp-dir (file-name-as-directory (file-truename "/tmp"))) + (critical-dirs (list (directory-file-name home-dir) + (file-truename (expand-file-name "~/.emacs.d")) + (file-truename (expand-file-name "~/.config")) + (directory-file-name tmp-dir)))) ;; Security check: must be within allowed directories (unless (or (string-prefix-p home-dir expanded-path) - (string-prefix-p "/tmp" expanded-path)) + (string-prefix-p tmp-dir expanded-path)) (error "Path must be within home directory or /tmp: %s" path)) ;; Prevent trashing critical directories @@ -70,6 +73,10 @@ trashing of critical system directories." (unless (file-exists-p expanded-path) (error "File or directory does not exist: %s" path)) + (unless (or (string-prefix-p home-dir resolved-path) + (string-prefix-p tmp-dir resolved-path)) + (error "Resolved path must be within home directory or /tmp: %s" path)) + expanded-path)) (defun gptel--move-to-trash-perform (expanded-path trash-dir) diff --git a/gptel-tools/read_buffer.el b/gptel-tools/read_buffer.el index 1b4fc904..c9136e3c 100644 --- a/gptel-tools/read_buffer.el +++ b/gptel-tools/read_buffer.el @@ -14,7 +14,9 @@ error when no live buffer matches." (unless (buffer-live-p (get-buffer buffer)) (error "Buffer %s is not live" buffer)) (with-current-buffer buffer - (buffer-substring-no-properties (point-min) (point-max)))) + (save-restriction + (widen) + (buffer-substring-no-properties (point-min) (point-max))))) (gptel-make-tool :name "read_buffer" diff --git a/gptel-tools/read_text_file.el b/gptel-tools/read_text_file.el index 8e0433a9..f35c9494 100644 --- a/gptel-tools/read_text_file.el +++ b/gptel-tools/read_text_file.el @@ -25,19 +25,21 @@ ;; Helper functions for read_text_file tool (defun cj/validate-file-path (path) "Validate PATH is within home directory and exists." - (let ((full-path (expand-file-name path "~"))) + (let* ((home (file-name-as-directory (file-truename (expand-file-name "~")))) + (full-path (expand-file-name path "~"))) (unless (string-prefix-p (expand-file-name "~") full-path) (error "Path must be within home directory")) (unless (file-exists-p full-path) (error "File not found: %s" full-path)) - (when (file-directory-p full-path) - (error "Path is a directory, not a file: %s" full-path)) - (unless (file-readable-p full-path) - (error "No read permission for file: %s" full-path)) - ;; Follow symlinks - (if (file-symlink-p full-path) - (file-truename full-path) - full-path))) + (let ((resolved (file-truename full-path))) + (unless (or (string= resolved (directory-file-name home)) + (string-prefix-p home resolved)) + (error "Resolved path must be within home directory: %s" path)) + (when (file-directory-p resolved) + (error "Path is a directory, not a file: %s" resolved)) + (unless (file-readable-p resolved) + (error "No read permission for file: %s" resolved)) + resolved))) (defun cj/get-file-metadata (path) "Return formatted metadata string for file at PATH." diff --git a/gptel-tools/update_text_file.el b/gptel-tools/update_text_file.el index 492ed554..f8b58025 100644 --- a/gptel-tools/update_text_file.el +++ b/gptel-tools/update_text_file.el @@ -40,20 +40,23 @@ PATH must resolve inside the user's home directory, must exist, must be a regular file, and must be readable and writable." - (let ((full (expand-file-name path "~"))) + (let* ((home (file-name-as-directory (file-truename (expand-file-name "~")))) + (full (expand-file-name path "~"))) (unless (string-prefix-p (expand-file-name "~") full) (error "Path must be within home directory: %s" path)) (unless (file-exists-p full) (error "File not found: %s" full)) - (when (file-directory-p full) - (error "Path is a directory, not a file: %s" full)) - (unless (file-readable-p full) - (error "No read permission for file: %s" full)) - (unless (file-writable-p full) - (error "No write permission for file: %s" full)) - (if (file-symlink-p full) - (file-truename full) - full))) + (let ((resolved (file-truename full))) + (unless (or (string= resolved (directory-file-name home)) + (string-prefix-p home resolved)) + (error "Resolved path must be within home directory: %s" path)) + (when (file-directory-p resolved) + (error "Path is a directory, not a file: %s" resolved)) + (unless (file-readable-p resolved) + (error "No read permission for file: %s" resolved)) + (unless (file-writable-p resolved) + (error "No write permission for file: %s" resolved)) + resolved))) (defun cj/update-text-file--backup-name (path) "Return a backup filename for PATH timestamped to the current second." @@ -113,9 +116,10 @@ on out-of-range LINE-NUM or empty TEXT." ;; extra empty element at the end. Trim it so the line count ;; matches what a human would say. (trailing-newline (string-suffix-p "\n" content)) - (line-count (if trailing-newline - (1- (length lines)) - (length lines)))) + (line-count (cond + ((string-empty-p content) 0) + (trailing-newline (1- (length lines))) + (t (length lines))))) (when (> line-num (1+ line-count)) (error "Line %d out of range (file has %d lines)" line-num line-count)) (let* ((to-insert (if (string-suffix-p "\n" text) diff --git a/gptel-tools/web_fetch.el b/gptel-tools/web_fetch.el index 1f950a31..b2f80c5f 100644 --- a/gptel-tools/web_fetch.el +++ b/gptel-tools/web_fetch.el @@ -62,7 +62,7 @@ from the response status line, or nil when the line is unrecognized." (let* ((status (when (re-search-forward "^HTTP/[0-9.]+ \\([0-9]+\\)" (point-max) t) (string-to-number (match-string 1)))) - (body-start (when (re-search-forward "\n\n" nil t) + (body-start (when (re-search-forward "\r?\n\r?\n" nil t) (point)))) (cons status (if body-start diff --git a/gptel-tools/write_text_file.el b/gptel-tools/write_text_file.el index 40482c66..1bda5446 100644 --- a/gptel-tools/write_text_file.el +++ b/gptel-tools/write_text_file.el @@ -22,9 +22,22 @@ (defun cj/write-text-file--validate-path (path) "Validate PATH for write. Return the expanded path on success. PATH must resolve inside the user's home directory." - (let ((full (expand-file-name path "~"))) + (let* ((home (file-name-as-directory (file-truename (expand-file-name "~")))) + (full (expand-file-name path "~")) + (existing (and (file-exists-p full) (file-truename full))) + (parent (file-name-directory full)) + (resolved-parent (and parent + (file-exists-p parent) + (file-truename parent)))) (unless (string-prefix-p (expand-file-name "~") full) (error "Path must be within home directory: %s" path)) + (when (and existing + (not (string-prefix-p home existing))) + (error "Resolved path must be within home directory: %s" path)) + (when (and resolved-parent + (not (or (string= resolved-parent (directory-file-name home)) + (string-prefix-p home resolved-parent)))) + (error "Resolved parent must be within home directory: %s" path)) full)) (defun cj/write-text-file--backup-name (path) diff --git a/tests/test-gptel-tools-git-diff.el b/tests/test-gptel-tools-git-diff.el index 59666a32..114fec29 100644 --- a/tests/test-gptel-tools-git-diff.el +++ b/tests/test-gptel-tools-git-diff.el @@ -102,6 +102,26 @@ (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 () @@ -133,5 +153,11 @@ (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/tests/test-gptel-tools-git-log.el b/tests/test-gptel-tools-git-log.el index 708819b6..c0503039 100644 --- a/tests/test-gptel-tools-git-log.el +++ b/tests/test-gptel-tools-git-log.el @@ -36,8 +36,13 @@ Call FN with the absolute path, clean up after." (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) - (call-process "git" nil nil nil "commit" "--allow-empty" - "--quiet" "-m" (format "commit %d" i)))) + (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))))) @@ -92,6 +97,26 @@ Call FN with the absolute path, clean up after." (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 () @@ -112,6 +137,29 @@ Call FN with the absolute path, clean up after." (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" diff --git a/tests/test-gptel-tools-git-status.el b/tests/test-gptel-tools-git-status.el index 734abb31..47193853 100644 --- a/tests/test-gptel-tools-git-status.el +++ b/tests/test-gptel-tools-git-status.el @@ -68,6 +68,18 @@ (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 () @@ -94,5 +106,19 @@ (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/tests/test-gptel-tools-list-directory-files.el b/tests/test-gptel-tools-list-directory-files.el index a91a7e79..9588ce8b 100644 --- a/tests/test-gptel-tools-list-directory-files.el +++ b/tests/test-gptel-tools-list-directory-files.el @@ -72,6 +72,14 @@ (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 () @@ -96,6 +104,18 @@ "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 () @@ -133,6 +153,49 @@ (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 @@ -142,6 +205,17 @@ (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 () @@ -158,5 +232,26 @@ "/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/tests/test-gptel-tools-move-to-trash.el b/tests/test-gptel-tools-move-to-trash.el index a6ab1200..77f88627 100644 --- a/tests/test-gptel-tools-move-to-trash.el +++ b/tests/test-gptel-tools-move-to-trash.el @@ -91,6 +91,10 @@ "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 "~")) @@ -107,6 +111,18 @@ (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 () @@ -132,5 +148,72 @@ (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/tests/test-gptel-tools-read-buffer.el b/tests/test-gptel-tools-read-buffer.el index 75efd604..0a854835 100644 --- a/tests/test-gptel-tools-read-buffer.el +++ b/tests/test-gptel-tools-read-buffer.el @@ -40,6 +40,14 @@ (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 @@ -56,5 +64,11 @@ (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/tests/test-gptel-tools-read-text-file.el b/tests/test-gptel-tools-read-text-file.el index 3a4f6662..db3d6e7e 100644 --- a/tests/test-gptel-tools-read-text-file.el +++ b/tests/test-gptel-tools-read-text-file.el @@ -59,6 +59,53 @@ "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 () @@ -87,6 +134,16 @@ "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 () @@ -109,6 +166,33 @@ "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))) diff --git a/tests/test-gptel-tools-web-fetch.el b/tests/test-gptel-tools-web-fetch.el index 0206af3f..b6dbefcc 100644 --- a/tests/test-gptel-tools-web-fetch.el +++ b/tests/test-gptel-tools-web-fetch.el @@ -109,6 +109,71 @@ (cl-letf (((symbol-function 'executable-find) (lambda (_) 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) (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) (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 () @@ -140,6 +205,13 @@ (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>" diff --git a/tests/test-gptel-tools-write-text-file.el b/tests/test-gptel-tools-write-text-file.el index 258ae8cc..14bcb2a5 100644 --- a/tests/test-gptel-tools-write-text-file.el +++ b/tests/test-gptel-tools-write-text-file.el @@ -45,6 +45,43 @@ "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 () @@ -78,6 +115,14 @@ (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 () @@ -133,6 +178,43 @@ (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))) diff --git a/tests/test-update-text-file.el b/tests/test-update-text-file.el index d689274a..fc4f8c36 100644 --- a/tests/test-update-text-file.el +++ b/tests/test-update-text-file.el @@ -148,6 +148,25 @@ (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"))) @@ -190,6 +209,15 @@ (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" ""))) @@ -253,6 +281,61 @@ "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 () @@ -291,7 +374,11 @@ Backups (path-TS.bak) are cleaned up after FN returns." (with-temp-buffer (insert-file-contents path) (should (equal (buffer-string) "GAMMA bravo GAMMA\n"))) - (should (file-expand-wildcards (concat path "-*.bak"))))))) + (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." @@ -335,6 +422,40 @@ Backups (path-TS.bak) are cleaned up after FN returns." (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 |