commit 5f58df0ee61c74c329a081cff56f48cb89541da5
parent 4e2c04ec27a7e69272dcede8efaa7fc2d36898cf
Author: Vineet Kumar <git@vineetk.net>
Date: Tue, 26 May 2026 02:39:12 -0400
fix anchor extraction and operation parsing to handle payload lines
- avoid processing payload and comment lines via filter.
- add guard on short strings (2 and under) just in case.
- fixed args-out-of-range crash when payload lines appeared in patches.
Diffstat:
2 files changed, 72 insertions(+), 48 deletions(-)
diff --git a/llm-tools-hl-test.el b/llm-tools-hl-test.el
@@ -665,3 +665,18 @@
(let ((op (car (llm-tools--hl-parse-section section))))
(should (eq (hl-op-type op) 'insert-before))
(should (string= (hl-op-anchor op) "BOF")))))
+
+(ert-deftest llm-tools--hl-get-anchors-with-payload-lines-test ()
+ "Test that payload lines (~) are ignored during anchor extraction.
+This would have caught the args-out-of-range crash when anchor extraction
+tried to parse a line like \"~payload\" as an operation."
+ (let ((patch "@@ test.el\n+ 4ei\n~some payload\n~another line\n= 3gv..6be\n~replacement"))
+ (let ((anchors (llm-tools--hl-get-anchors patch)))
+ (should (= (length anchors) 1))
+ (let ((file-anchors (cdr (car anchors))))
+ (should (member "4ei" file-anchors))
+ (should (member "3gv" file-anchors))
+ (should (member "6be" file-anchors))
+ (should-not (member "some payload" file-anchors))
+ (should-not (member "another line" file-anchors))
+ (should-not (member "replacement" file-anchors))))))
diff --git a/llm-tools-hl.el b/llm-tools-hl.el
@@ -160,19 +160,19 @@ single string."
(defun llm-tools--hl-validate-insert-has-payload (ops)
"Check that all insert ops have at least one payload line."
(mapcan (lambda (op)
- (when (and (memq (hl-verify-op-type op) '(insert-after insert-before))
- (null (hl-verify-op-payload op)))
- (list (format "Insert operation (%s) has no payload lines following it"
- (hl-verify-op-type op)))))
+ (when (and (memq (hl-verify-op-type op) '(insert-after insert-before))
+ (null (hl-verify-op-payload op)))
+ (list (format "Insert operation (%s) has no payload lines following it"
+ (hl-verify-op-type op)))))
ops))
(defun llm-tools--hl-validate-delete-no-payload (ops)
"Check that delete ops have no payload lines."
(mapcan (lambda (op)
- (when (and (eq (hl-verify-op-type op) 'delete)
- (hl-verify-op-payload op))
- (list "Delete operation (-) must not have payload lines")))
- ops))
+ (when (and (eq (hl-verify-op-type op) 'delete)
+ (hl-verify-op-payload op))
+ (list "Delete operation (-) must not have payload lines")))
+ ops))
(defun llm-tools--hl-validate-insert-anchor (anchor)
"Return error string if ANCHOR is malformed for insert, else nil."
@@ -199,14 +199,14 @@ single string."
(defun llm-tools--hl-validate-anchors (ops)
"Check that all anchors are well-formed."
(mapcan (lambda (op)
- (pcase (hl-verify-op-type op)
- ((or 'insert-after 'insert-before)
- (when-let ((err (llm-tools--hl-validate-insert-anchor (hl-verify-op-anchor op))))
- (list err)))
- ((or 'delete 'replace)
- (when-let ((err (llm-tools--hl-validate-range-anchor (hl-verify-op-anchor op))))
- (list err)))))
- ops))
+ (pcase (hl-verify-op-type op)
+ ((or 'insert-after 'insert-before)
+ (when-let ((err (llm-tools--hl-validate-insert-anchor (hl-verify-op-anchor op))))
+ (list err)))
+ ((or 'delete 'replace)
+ (when-let ((err (llm-tools--hl-validate-range-anchor (hl-verify-op-anchor op))))
+ (list err)))))
+ ops))
(defun llm-tools--hl-verify-section (section)
"Validate a single SECTION. Returns a list of error strings."
@@ -275,7 +275,7 @@ and the cdr is the remainder of that section."
(defun llm-tools--hl-extract-anchors-from-op-line (line)
"Return a list of anchor strings from a single operation LINE.
Handles ranges by returning both endpoints."
- (when (length> line 0)
+ (when (and (stringp line) (length> line 2))
(let ((op (char-to-string (elt line 0)))
(anchor (substring line 2)))
(pcase op
@@ -283,10 +283,18 @@ Handles ranges by returning both endpoints."
((or "-" "=") (split-string anchor "\\.\\."))))))
(defun llm-tools--hl-extract-anchors-from-section (section-body)
- "Return all anchors from a section body (list of strings)."
- (flatten-list
- (mapcar #'llm-tools--hl-extract-anchors-from-op-line
- (string-lines section-body))))
+ "Return all anchors from a section body (string).
+Only lines starting with +, <, -, or = are considered."
+ (let ((ops-lines
+ (cl-remove-if-not
+ (lambda (line)
+ (let ((trimmed (string-trim line)))
+ (and (not (string-empty-p trimmed))
+ (not (string-prefix-p "#" trimmed))
+ (not (string-prefix-p "~" trimmed))
+ (member (substring trimmed 0 1) '("+" "<" "-" "=")))))
+ (string-lines section-body))))
+ (flatten-list (mapcar #'llm-tools--hl-extract-anchors-from-op-line ops-lines))))
(defun llm-tools--hl-get-anchors (patch)
"Returns an alist of (FILENAME . ANCHORS) from PATCH.
@@ -326,39 +334,40 @@ line in the on-disk file."
(string-to-number (substring anchor 0 (- (length anchor) 2))))
(defun llm-tools--hl-parse-op-line (line)
- "Parse a single operation LINE into a `hl-op` struct.
-LINE should start with `+`, `<`, `-`, or `=`."
- (pcase (substring line 0 1)
- ("+"
- (make-hl-op :type 'insert-after
- :anchor (substring line 2)))
- ("<"
- (make-hl-op :type 'insert-before
- :anchor (substring line 2)))
- ("-"
- (make-hl-op :type 'delete
- :range (split-string (substring line 2) "\\.\\.")))
- ("="
- (make-hl-op :type 'replace
- :range (split-string (substring line 2) "\\.\\.")))))
+ "Parse a single operation LINE into an `hl-op` struct.
+LINE must start with `+`, `<`, `-`, or `=`, followed by a space,
+followed by an anchor (or range)."
+ (string-match "^[+<=-] \\(.*\\)" line) ; returns index or nil
+ (unless (match-beginning 0)
+ (error "Invalid operation line: %S" line))
+ (let* ((op-char (substring line 0 1))
+ (anchor (match-string 1 line)))
+ (pcase op-char
+ ("+" (make-hl-op :type 'insert-after :anchor anchor))
+ ("<" (make-hl-op :type 'insert-before :anchor anchor))
+ ("-" (make-hl-op :type 'delete :range (split-string anchor "\\.\\.")))
+ ("=" (make-hl-op :type 'replace :range (split-string anchor "\\.\\."))))))
(defun llm-tools--hl-parse-section (section)
"Parse SECTION (body after `@@ PATH`) into a list of `hl-op` structs.
Skips comment lines (starting with `#`) and blank lines."
(let (ops op)
(dolist (line (string-lines section))
- (when (string-match "\\S-" line)
- (let ((op-char (substring line 0 1)))
- (pcase op-char
- ("~"
- (when op
- (setf (hl-op-payload op)
- (append (hl-op-payload op)
- (list (substring line 1))))))
- ("#" nil)
- (_
- (when op (push op ops))
- (setq op (llm-tools--hl-parse-op-line line)))))))
+ (let ((trimmed (string-trim-left line)))
+ (when (string-match "\\S-" trimmed)
+ (let ((op-char (substring trimmed 0 1)))
+ (pcase op-char
+ ("~"
+ (when op
+ (setf (hl-op-payload op)
+ (append (hl-op-payload op)
+ (list (substring trimmed 1))))))
+ ("#" nil)
+ (_
+ (when op (push op ops))
+ (if (< (length trimmed) 3)
+ (error "Malformed operation line (too short): %S" trimmed))
+ (setq op (llm-tools--hl-parse-op-line trimmed))))))))
(when op (push op ops))
(nreverse ops)))
