diff options
Diffstat (limited to '.ai/scripts')
| -rw-r--r-- | .ai/scripts/lint-org.el | 53 | ||||
| -rw-r--r-- | .ai/scripts/tests/test-lint-org.el | 108 |
2 files changed, 161 insertions, 0 deletions
diff --git a/.ai/scripts/lint-org.el b/.ai/scripts/lint-org.el index 928f83b..33dc52f 100644 --- a/.ai/scripts/lint-org.el +++ b/.ai/scripts/lint-org.el @@ -306,6 +306,52 @@ Craig-specific annotation marker rather than Babel src-block syntax." (lo--goto-line line) (looking-at-p "^[ \t]*#\\+begin_src[ \t]+cj:"))) +(defvar-local lo--matched-blocks-cache nil + "Cons of (TICK . REGIONS) memoizing `lo--matched-block-regions'. +TICK is the `buffer-chars-modified-tick' the regions were computed at, so a +fix applied mid-pass invalidates them.") + +(defun lo--matched-block-regions () + "Return ((BEGIN-LINE . END-LINE) ...) for every correctly paired block. +Scans lines directly rather than asking org, because org's own parser is what +mis-reads these blocks: a heading-shaped line inside a verbatim body reads as a +structural break and loses the open block. The scan applies org's real rule — +once a block is open, only its own `#+end_TYPE' closes it, so a nested +`#+begin_' or a foreign `#+end_' in the body is just text." + (let ((tick (buffer-chars-modified-tick))) + (if (eql (car lo--matched-blocks-cache) tick) + (cdr lo--matched-blocks-cache) + (let ((case-fold-search t) + (regions nil) (open-type nil) (open-line nil) (line 0)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (setq line (1+ line)) + (let ((text (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))) + (cond + (open-type + (when (string-match + (format "\\`[ \t]*#\\+end_%s[ \t]*\\'" + (regexp-quote open-type)) + text) + (push (cons open-line line) regions) + (setq open-type nil open-line nil))) + ((string-match "\\`[ \t]*#\\+begin_\\([^ \t\n]+\\)" text) + (setq open-type (match-string 1 text) + open-line line)))) + (forward-line 1))) + (setq lo--matched-blocks-cache (cons tick (nreverse regions))) + (cdr lo--matched-blocks-cache))))) + +(defun lo--in-matched-block-p (line) + "Non-nil when LINE sits within a correctly paired block, delimiters included. +org-lint reports `invalid-block' at the delimiter lines themselves, so the +range has to be inclusive for the suppression to reach them." + (cl-some (lambda (region) + (and (>= line (car region)) (<= line (cdr region)))) + (lo--matched-block-regions))) + (defun lo--handle-item (item) (let ((name (lo--checker-name item)) (line (lo--line item)) @@ -318,6 +364,13 @@ Craig-specific annotation marker rather than Babel src-block syntax." wrong-header-argument)) (lo--cj-comment-block-opener-p line)) nil) + ;; `invalid-block' on a block that is in fact correctly paired — the + ;; checker is org-lint's own, so this filters its output rather than + ;; fixing a local checker. A genuinely unterminated block isn't in any + ;; matched region, so it still reports. + ((and (eq name 'invalid-block) + (lo--in-matched-block-p line)) + nil) ((eq name 'item-number) (lo--apply-or-preview name line msg #'lo-fix-item-number)) ((eq name 'missing-language-in-src-block) diff --git a/.ai/scripts/tests/test-lint-org.el b/.ai/scripts/tests/test-lint-org.el index d398c4c..ceee209 100644 --- a/.ai/scripts/tests/test-lint-org.el +++ b/.ai/scripts/tests/test-lint-org.el @@ -193,6 +193,65 @@ real suspicious-language warning here #+end_src ") +;; invalid-block, false-positive case — a correctly paired example block whose +;; body holds a heading-shaped line. org's parser reads the `** ' inside the +;; verbatim body as a structural break, loses the open block, and flags BOTH +;; delimiters as "Possible incomplete block". +(defconst lo-test--verbatim-heading-block "\ +* Heading + +#+begin_example +** Feature Name or Topic +Body line. +#+end_example + +Trailing prose. +") + +;; invalid-block, literal-delimiter case — a paired src block whose body holds +;; a literal `#+end_example' plus a heading-shaped line. Only `#+end_src' +;; closes a src block, so all three findings here are false. +(defconst lo-test--literal-end-in-src "\ +* Heading + +#+begin_src text +#+end_example +** heading shaped +#+end_src +") + +;; invalid-block, uppercase-delimiter case — org accepts #+BEGIN_/#+END_ in +;; either case, and the pre-fix script flagged both delimiters here too. +(defconst lo-test--uppercase-verbatim-block "\ +* Heading + +#+BEGIN_EXAMPLE +** heading shaped +#+END_EXAMPLE +") + +;; invalid-block, genuine case — a block that really is never closed. The +;; suppression must not reach this one. +(defconst lo-test--unterminated-block "\ +* Heading + +#+begin_example +truly unterminated block body +") + +;; A genuinely unterminated block *after* a correctly paired one — verifies the +;; suppression is scoped per block rather than per file. +(defconst lo-test--paired-then-unterminated "\ +* Heading + +#+begin_example +** heading shaped +#+end_example + +#+begin_example +never closed +") + ;; Mixed fixture — each category once. (defconst lo-test--mixed "\ * Mixed @@ -392,6 +451,55 @@ suspicious-language judgment." (should (= 1 suspicious)))) ;;; --------------------------------------------------------------------------- +;;; invalid-block — false positives on correctly paired verbatim blocks + +(ert-deftest lo-verbatim-heading-block-emits-no-invalid-block () + "Normal: a paired example block containing a heading-shaped body line emits +no invalid-block judgment. Both delimiters are flagged by org-lint because the +parser treats the `** ' inside the verbatim body as a structural break." + (let* ((out (lo-test--run lo-test--verbatim-heading-block)) + (res (plist-get out :result)) + (judgments (lo-test--judgments (plist-get out :issues)))) + ;; File untouched, no fixes applied — suppression only, never a rewrite. + (should (equal lo-test--verbatim-heading-block res)) + (should (= 0 (plist-get out :fixes))) + (should-not (member 'invalid-block (lo-test--checkers judgments))))) + +(ert-deftest lo-literal-end-delimiter-in-src-emits-no-invalid-block () + "Boundary: a paired src block whose body holds a literal `#+end_example' and +a heading-shaped line emits no invalid-block judgment. Only `#+end_src' closes +a src block, so the interior delimiter is body text." + (let* ((out (lo-test--run lo-test--literal-end-in-src)) + (judgments (lo-test--judgments (plist-get out :issues)))) + (should-not (member 'invalid-block (lo-test--checkers judgments))))) + +(ert-deftest lo-uppercase-verbatim-block-emits-no-invalid-block () + "Boundary: block delimiters are case-insensitive in org, so an uppercase +`#+BEGIN_EXAMPLE' pair is suppressed the same as a lowercase one." + (let* ((out (lo-test--run lo-test--uppercase-verbatim-block)) + (judgments (lo-test--judgments (plist-get out :issues)))) + (should-not (member 'invalid-block (lo-test--checkers judgments))))) + +(ert-deftest lo-unterminated-block-still-emits-invalid-block () + "Error: a block that is never closed still emits its invalid-block judgment. +This is the finding the checker exists for — the suppression must not mask it." + (let* ((out (lo-test--run lo-test--unterminated-block)) + (judgments (lo-test--judgments (plist-get out :issues)))) + (should (member 'invalid-block (lo-test--checkers judgments))))) + +(ert-deftest lo-invalid-block-suppression-is-scoped-per-block () + "Boundary: a paired block and an unterminated block in the same file — the +paired one is suppressed and the unterminated one still reports. Exactly one +invalid-block judgment, and it points at the unterminated opener (line 7)." + (let* ((out (lo-test--run lo-test--paired-then-unterminated)) + (judgments (lo-test--judgments (plist-get out :issues))) + (invalid (cl-remove-if-not + (lambda (i) (eq (plist-get i :checker) 'invalid-block)) + judgments))) + (should (= 1 (length invalid))) + (should (= 7 (plist-get (car invalid) :line))))) + +;;; --------------------------------------------------------------------------- ;;; --check mode (ert-deftest lo-check-mode-does-not-modify-file () |