bug#57883: compilation-get-file-structure mishandles buffers

bug#57883: compilation-get-file-structure mishandles buffers

[JD Smith]

[-- Attachment #1: Type: text/plain, Size: 876 bytes --]


As reported <https://lists.gnu.org/archive/html/emacs-devel/2022-02/msg00496.html> on emacs-devel, a bug is present in `compilation-get-file-structure’ when the “file” matched by the `compilation-parse-errors’ is not a file, but a buffer name.  Both filenames and buffer names are explicitly allowed in errors.  From the `compilation-error-regexp-alist’ docstring (emphasis added):

Or FILE can also be a function that returns (FILENAME) or (RELATIVE-FILENAME . DIRNAME). In the former case, FILENAME may be relative or absolute, or it may be a buffer.

Note that this is useful for modes which report errors in text from open buffers, which may have no associated file.   The issue is this line in `compilation-get-file-structure’:

	(if (file-name-absolute-p filename)
	    (setq filename (concat comint-file-name-prefix filename)))

which signals an 

[-- Attachment #2: Type: text/html, Size: 3361 bytes --]

bug#57883: compilation-get-file-structure mishandles buffers

[Lars Ingebrigtsen]

JD Smith <jdtsmith@gmail.com> writes:

> Note that this is useful for modes which report errors in text from open buffers, which
> may have no associated file.   The issue is this line in `compilation-get-file-structure’:
>
> (if (file-name-absolute-p filename) 
>    (setq filename (concat comint-file-name-prefix filename))) 
> which signals an 

This is how your email ended, so I think your message may have been cut
off?

In any case, do you have a recipe to reproduce the problem, starting
from "emacs -Q"?

bug#57883: compilation-get-file-structure mishandles buffers

[Stefan Kangas]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> JD Smith <jdtsmith@gmail.com> writes:
>
>> Note that this is useful for modes which report errors in text from open buffers, which
>> may have no associated file.   The issue is this line in `compilation-get-file-structure’:
>>
>> (if (file-name-absolute-p filename)
>>    (setq filename (concat comint-file-name-prefix filename)))
>> which signals an
>
> This is how your email ended, so I think your message may have been cut
> off?
>
> In any case, do you have a recipe to reproduce the problem, starting
> from "emacs -Q"?

More information was requested, but none was given within 12 months, so
I'm closing this bug.

If this is still an issue, please reply to this email (use "Reply to
all" in your email client) and we can reopen the bug report.

bug#57883: compilation-get-file-structure mishandles buffers

[JD Smith]

[-- Attachment #1: Type: text/plain, Size: 14101 bytes --]

Thanks for the query.  This is still an issue in Emacs 29 with emacs -Q.  

Short summary: `compilation-error-regexp-alist’ explicitly allows returning *buffers* from a specified file-name function .  But parsing errors using such a buffer-returning function fails, since `compilation-get-file-structure’ explicitly assumes that a file name is returned, checking it with `file-name-absolute-p’.  In my code I’ve worked around this bug by cl-letf’ing the `file-name-absolute-p’ function like:

(defun my/traceback--file-name-absolute-p (file-or-buffer)
  "A patch for `file-name-absolute-p' to handle buffer names.
`compilation-get-file-structure' has a bug in which it calls
`file-name-absolute-p' on a file parsed from an error, which
explicitly allows FILE-OR-BUFFER to be a buffer."
  (and (not (bufferp file-or-buffer))
       (funcall #’my/traceback--orig-file-name-absolute-p file-or-buffer)))

Reproducer: The reproduction recipe was in the linked emacs-devel <https://lists.gnu.org/archive/html/emacs-devel/2022-02/msg00496.html> thread.  Here it is again (with Emacs 29 updates in [brackets]):

++++

Reproducing is fairly straightforward.  First, evaluate this simple “error line” pattern:

(defun my/filename-function () (list (get-buffer (match-string 1))))
(defvar my/compilation-error-regexp
  `((,(rx line-start 
	  "Buffer \"" (group (+ (not "\""))) "\", " ; 1: buffer name
	  "line" (+ space) (group (+ digit))	    ; 2: line
	  (* nonl) ?\n)
     my/filename-function
     2
     nil nil 1)))

Then, in a buffer like *compile* put the following fake error for it to match (including a final newline):

Buffer "*scratch*", line 2

In that buffer, evaluate (e.g. via M-:):

(progn (compilation-setup)
       (setq compilation-error-regexp-alist my/compilation-error-regexp)
       (compilation-parse-errors (point-min) (point-max)))

You should see error 1.) pertaining to searching the (nil) filename for /bin/sh (which may have been fixed in Emacs 28 already). [Emacs 29 update: it has]

[Update: This step is unnecessary in emacs 29] Now, let’s eliminate that error by evaluating (again in *compile*):

(setq compilation-transform-file-match-alist nil)

To stop the transform check.  Now evaluate again:

(compilation-parse-errors (point-min) (point-max))

and you will see a different error (2.) from `compilation-get-file-structure', which does not appreciate being handed a buffer instead of a file, despite the documented validity of this input:

Debugger entered--Lisp error: (wrong-type-argument stringp #<buffer *scratch*>)
  #<subr file-name-absolute-p>(#<buffer *scratch*>)
  apply(#<subr file-name-absolute-p> #<buffer *scratch*>)
  #f(compiled-function (body &rest args) #<bytecode 0x1a0bc3925a352795>)(#<subr file-name-absolute-p> #<buffer *scratch*>)
  apply(#f(compiled-function (body &rest args) #<bytecode 0x1a0bc3925a352795>) #<subr file-name-absolute-p> #<buffer *scratch*>)
  file-name-absolute-p(#<buffer *scratch*>)
  compilation-get-file-structure((#<buffer *scratch*>) nil)
  compilation-internal-error-properties((#<buffer *scratch*>) 2 nil nil nil 2 nil nil)
  compilation-error-properties(my/filename-function 2 nil nil nil 2 nil nil)
  (setq props (compilation-error-properties file line end-line col end-col (or type 2) fmt rule))
  (if (setq props (compilation-error-properties file line end-line col end-col (or type 2) fmt rule)) (progn (if file (progn (let ((this-type (if ... ... ...))) (compilation--note-type this-type) (compilation--put-prop file 'font-lock-face (symbol-value (aref ... this-type)))))) (compilation--put-prop line 'font-lock-face compilation-line-face) (compilation--put-prop end-line 'font-lock-face compilation-line-face) (compilation--put-prop col 'font-lock-face compilation-column-face) (compilation--put-prop end-col 'font-lock-face compilation-column-face) (let ((tail (nthcdr 6 item))) (while tail (let ((extra-item (car tail))) (let ((mn ...)) (if (match-beginning mn) (progn ...))) (setq tail (cdr tail))))) (let ((mn (or (nth 5 item) 0))) (if compilation-debug (progn (font-lock-append-text-property (match-beginning 0) (match-end 0) 'compilation-debug (vector 'std item props)))) (add-text-properties (match-beginning mn) (match-end mn) (cdr (cdr props))) (font-lock-append-text-property (match-beginning mn) (match-end mn) 'font-lock-face (car (cdr props))))))
  (while (and pat (re-search-forward pat end t)) (if (setq props (compilation-error-properties file line end-line col end-col (or type 2) fmt rule)) (progn (if file (progn (let ((this-type ...)) (compilation--note-type this-type) (compilation--put-prop file 'font-lock-face (symbol-value ...))))) (compilation--put-prop line 'font-lock-face compilation-line-face) (compilation--put-prop end-line 'font-lock-face compilation-line-face) (compilation--put-prop col 'font-lock-face compilation-column-face) (compilation--put-prop end-col 'font-lock-face compilation-column-face) (let ((tail (nthcdr 6 item))) (while tail (let ((extra-item ...)) (let (...) (if ... ...)) (setq tail (cdr tail))))) (let ((mn (or (nth 5 item) 0))) (if compilation-debug (progn (font-lock-append-text-property (match-beginning 0) (match-end 0) 'compilation-debug (vector ... item props)))) (add-text-properties (match-beginning mn) (match-end mn) (cdr (cdr props))) (font-lock-append-text-property (match-beginning mn) (match-end mn) 'font-lock-face (car (cdr props)))))))
  (let* ((item (if (symbolp rule-item) (cdr (assq rule-item compilation-error-regexp-alist-alist)) rule-item)) (pat (car item)) (file (nth 1 item)) (line (nth 2 item)) (col (nth 3 item)) (type (nth 4 item)) (rule (and (symbolp rule-item) rule-item)) end-line end-col fmt props) (cond ((or (not omake-included) (not pat)) nil) ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) nil) (t (setq pat (concat "^\\(?:      \\)?" (substring pat 1))))) (if (and (consp file) (not (functionp file))) (progn (setq fmt (cdr file)) (setq file (car file)))) (if (and (consp line) (not (functionp line))) (progn (setq end-line (cdr line)) (setq line (car line)))) (if (and (consp col) (not (functionp col))) (progn (setq end-col (cdr col)) (setq col (car col)))) (if (or (null (nth 5 item)) (integerp (nth 5 item))) nil (error "HYPERLINK should be an integer: %s" (nth 5 item))) (goto-char start) (while (and pat (re-search-forward pat end t)) (if (setq props (compilation-error-properties file line end-line col end-col (or type 2) fmt rule)) (progn (if file (progn (let (...) (compilation--note-type this-type) (compilation--put-prop file ... ...)))) (compilation--put-prop line 'font-lock-face compilation-line-face) (compilation--put-prop end-line 'font-lock-face compilation-line-face) (compilation--put-prop col 'font-lock-face compilation-column-face) (compilation--put-prop end-col 'font-lock-face compilation-column-face) (let ((tail (nthcdr 6 item))) (while tail (let (...) (let ... ...) (setq tail ...)))) (let ((mn (or ... 0))) (if compilation-debug (progn (font-lock-append-text-property ... ... ... ...))) (add-text-properties (match-beginning mn) (match-end mn) (cdr (cdr props))) (font-lock-append-text-property (match-beginning mn) (match-end mn) 'font-lock-face (car (cdr props))))))))
  (let ((rule-item (car tail))) (let* ((item (if (symbolp rule-item) (cdr (assq rule-item compilation-error-regexp-alist-alist)) rule-item)) (pat (car item)) (file (nth 1 item)) (line (nth 2 item)) (col (nth 3 item)) (type (nth 4 item)) (rule (and (symbolp rule-item) rule-item)) end-line end-col fmt props) (cond ((or (not omake-included) (not pat)) nil) ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) nil) (t (setq pat (concat "^\\(?:      \\)?" (substring pat 1))))) (if (and (consp file) (not (functionp file))) (progn (setq fmt (cdr file)) (setq file (car file)))) (if (and (consp line) (not (functionp line))) (progn (setq end-line (cdr line)) (setq line (car line)))) (if (and (consp col) (not (functionp col))) (progn (setq end-col (cdr col)) (setq col (car col)))) (if (or (null (nth 5 item)) (integerp (nth 5 item))) nil (error "HYPERLINK should be an integer: %s" (nth 5 item))) (goto-char start) (while (and pat (re-search-forward pat end t)) (if (setq props (compilation-error-properties file line end-line col end-col (or type 2) fmt rule)) (progn (if file (progn (let ... ... ...))) (compilation--put-prop line 'font-lock-face compilation-line-face) (compilation--put-prop end-line 'font-lock-face compilation-line-face) (compilation--put-prop col 'font-lock-face compilation-column-face) (compilation--put-prop end-col 'font-lock-face compilation-column-face) (let ((tail ...)) (while tail (let ... ... ...))) (let ((mn ...)) (if compilation-debug (progn ...)) (add-text-properties (match-beginning mn) (match-end mn) (cdr ...)) (font-lock-append-text-property (match-beginning mn) (match-end mn) 'font-lock-face (car ...))))))) (setq tail (cdr tail)))
  (while tail (let ((rule-item (car tail))) (let* ((item (if (symbolp rule-item) (cdr (assq rule-item compilation-error-regexp-alist-alist)) rule-item)) (pat (car item)) (file (nth 1 item)) (line (nth 2 item)) (col (nth 3 item)) (type (nth 4 item)) (rule (and (symbolp rule-item) rule-item)) end-line end-col fmt props) (cond ((or (not omake-included) (not pat)) nil) ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) nil) (t (setq pat (concat "^\\(?:      \\)?" (substring pat 1))))) (if (and (consp file) (not (functionp file))) (progn (setq fmt (cdr file)) (setq file (car file)))) (if (and (consp line) (not (functionp line))) (progn (setq end-line (cdr line)) (setq line (car line)))) (if (and (consp col) (not (functionp col))) (progn (setq end-col (cdr col)) (setq col (car col)))) (if (or (null (nth 5 item)) (integerp (nth 5 item))) nil (error "HYPERLINK should be an integer: %s" (nth 5 item))) (goto-char start) (while (and pat (re-search-forward pat end t)) (if (setq props (compilation-error-properties file line end-line col end-col (or type 2) fmt rule)) (progn (if file (progn ...)) (compilation--put-prop line 'font-lock-face compilation-line-face) (compilation--put-prop end-line 'font-lock-face compilation-line-face) (compilation--put-prop col 'font-lock-face compilation-column-face) (compilation--put-prop end-col 'font-lock-face compilation-column-face) (let (...) (while tail ...)) (let (...) (if compilation-debug ...) (add-text-properties ... ... ...) (font-lock-append-text-property ... ... ... ...)))))) (setq tail (cdr tail))))
  (let ((tail (or rules compilation-error-regexp-alist))) (while tail (let ((rule-item (car tail))) (let* ((item (if (symbolp rule-item) (cdr ...) rule-item)) (pat (car item)) (file (nth 1 item)) (line (nth 2 item)) (col (nth 3 item)) (type (nth 4 item)) (rule (and (symbolp rule-item) rule-item)) end-line end-col fmt props) (cond ((or (not omake-included) (not pat)) nil) ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) nil) (t (setq pat (concat "^\\(?:      \\)?" ...)))) (if (and (consp file) (not (functionp file))) (progn (setq fmt (cdr file)) (setq file (car file)))) (if (and (consp line) (not (functionp line))) (progn (setq end-line (cdr line)) (setq line (car line)))) (if (and (consp col) (not (functionp col))) (progn (setq end-col (cdr col)) (setq col (car col)))) (if (or (null (nth 5 item)) (integerp (nth 5 item))) nil (error "HYPERLINK should be an integer: %s" (nth 5 item))) (goto-char start) (while (and pat (re-search-forward pat end t)) (if (setq props (compilation-error-properties file line end-line col end-col ... fmt rule)) (progn (if file ...) (compilation--put-prop line ... compilation-line-face) (compilation--put-prop end-line ... compilation-line-face) (compilation--put-prop col ... compilation-column-face) (compilation--put-prop end-col ... compilation-column-face) (let ... ...) (let ... ... ... ...))))) (setq tail (cdr tail)))))
  (let ((case-fold-search compilation-error-case-fold-search) (omake-included (memq 'omake compilation-error-regexp-alist))) (let ((tail (or rules compilation-error-regexp-alist))) (while tail (let ((rule-item (car tail))) (let* ((item (if ... ... rule-item)) (pat (car item)) (file (nth 1 item)) (line (nth 2 item)) (col (nth 3 item)) (type (nth 4 item)) (rule (and ... rule-item)) end-line end-col fmt props) (cond ((or ... ...) nil) ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) nil) (t (setq pat ...))) (if (and (consp file) (not ...)) (progn (setq fmt ...) (setq file ...))) (if (and (consp line) (not ...)) (progn (setq end-line ...) (setq line ...))) (if (and (consp col) (not ...)) (progn (setq end-col ...) (setq col ...))) (if (or (null ...) (integerp ...)) nil (error "HYPERLINK should be an integer: %s" (nth 5 item))) (goto-char start) (while (and pat (re-search-forward pat end t)) (if (setq props ...) (progn ... ... ... ... ... ... ...)))) (setq tail (cdr tail))))))
  compilation-parse-errors(1 28)
  eval-expression((compilation-parse-errors (point-min) (point-max)) nil nil 127)
  funcall-interactively(eval-expression (compilation-parse-errors (point-min) (point-max)) nil nil 127)
  command-execute(eval-expression)

+++

> On Sep 3, 2023, at 5:18 AM, Stefan Kangas <stefankangas@gmail.com> wrote:
> 
> Lars Ingebrigtsen <larsi@gnus.org> writes:
> 
>> JD Smith <jdtsmith@gmail.com> writes:
>> 
>>> Note that this is useful for modes which report errors in text from open buffers, which
>>> may have no associated file.   The issue is this line in `compilation-get-file-structure’:
>>> 
>>> (if (file-name-absolute-p filename)
>>>   (setq filename (concat comint-file-name-prefix filename)))
>>> which signals an
>> 
>> This is how your email ended, so I think your message may have been cut
>> off?
>> 
>> In any case, do you have a recipe to reproduce the problem, starting
>> from "emacs -Q"?
> 
> More information was requested, but none was given within 12 months, so
> I'm closing this bug.
> 
> If this is still an issue, please reply to this email (use "Reply to
> all" in your email client) and we can reopen the bug report.


[-- Attachment #2: Type: text/html, Size: 18528 bytes --]

bug#57883: compilation-get-file-structure mishandles buffers

[Stefan Kangas]

reopen 57883
thanks

JD Smith <jdtsmith@gmail.com> writes:

> Thanks for the query.  This is still an issue in Emacs 29 with emacs -Q.

Thanks, reopened.

> Reproducer: The reproduction recipe was in the linked emacs-devel
> <https://lists.gnu.org/archive/html/emacs-devel/2022-02/msg00496.html>
> thread.  Here it is again (with Emacs 29 updates in [brackets]):

I've tried editing your recipe down into something that's a little bit
easier for me to work with.

All of this is pasted into an emacs -Q "*scratch*" buffer:

(progn
  (require 'compile)
  (defun my/filename-function () (list (get-buffer (match-string 1))))
  (defvar my/compilation-error-regexp
    `((,(rx line-start
	    "Buffer \"" (group (+ (not "\""))) "\", " ; 1: buffer name
	    "line" (+ space) (group (+ digit))	    ; 2: line
	    (* nonl) ?\n)
       my/filename-function
       2
       nil nil 1)))
  (progn (compilation-setup)
         (setq compilation-error-regexp-alist my/compilation-error-regexp)
         (compilation-parse-errors (point-min) (point-max)))
  (compilation-parse-errors (point-min) (point-max)))

But this doesn't give me any error when evaluating it either Emacs 29.1
or current master.  Did I miss something?  Perhaps there is some step
missing in my edited recipe?

bug#57883: compilation-get-file-structure mishandles buffers

[Stefan Kangas]

Stefan Kangas <stefankangas@gmail.com> writes:

> reopen 57883
> thanks
>
> JD Smith <jdtsmith@gmail.com> writes:
>
>> Thanks for the query.  This is still an issue in Emacs 29 with emacs -Q.
>
> Thanks, reopened.
>
>> Reproducer: The reproduction recipe was in the linked emacs-devel
>> <https://lists.gnu.org/archive/html/emacs-devel/2022-02/msg00496.html>
>> thread.  Here it is again (with Emacs 29 updates in [brackets]):
>
> I've tried editing your recipe down into something that's a little bit
> easier for me to work with.
>
> All of this is pasted into an emacs -Q "*scratch*" buffer:
>
> (progn
>   (require 'compile)
>   (defun my/filename-function () (list (get-buffer (match-string 1))))
>   (defvar my/compilation-error-regexp
>     `((,(rx line-start
> 	    "Buffer \"" (group (+ (not "\""))) "\", " ; 1: buffer name
> 	    "line" (+ space) (group (+ digit))	    ; 2: line
> 	    (* nonl) ?\n)
>        my/filename-function
>        2
>        nil nil 1)))
>   (progn (compilation-setup)
>          (setq compilation-error-regexp-alist my/compilation-error-regexp)
>          (compilation-parse-errors (point-min) (point-max)))
>   (compilation-parse-errors (point-min) (point-max)))
>
> But this doesn't give me any error when evaluating it either Emacs 29.1
> or current master.  Did I miss something?  Perhaps there is some step
> missing in my edited recipe?

More information was requested, but none was given within 4 months, so
I'm closing this bug.

If this is still an issue, please reply to this email (use "Reply to
all" in your email client) and we can reopen the bug report.

bug#57883: compilation-get-file-structure mishandles buffers

[JD Smith]

Apologies, I had missed this request.  The problem with your version of the code is it doesn’t actually create any error text for parse-errors to match.  Here’s a small tweak to your code to do this.  It is still producing the same error in v29.1:

(progn
 (require 'compile)
 (defun my/filename-function () (list (get-buffer (match-string 1))))
 (defvar my/compilation-error-regexp
   `((,(rx line-start
	    "Buffer \"" (group (+ (not "\""))) "\", " ; 1: buffer name
	    "line" (+ space) (group (+ digit))	    ; 2: line
	    (* nonl) ?\n)
      my/filename-function
      2
      nil nil 1)))
 (with-current-buffer (get-buffer-create "*exhibit-compilation-error*")
   (erase-buffer)
   (compilation-setup)
   (setq compilation-error-regexp-alist my/compilation-error-regexp)
   (insert "Buffer \"*scratch*\", line 2\n")
   (compilation-parse-errors (point-min) (point-max))))



> On Jan 10, 2024, at 5:55 AM, Stefan Kangas <stefankangas@gmail.com> wrote:
> 
> Stefan Kangas <stefankangas@gmail.com> writes:
> 
>> reopen 57883
>> thanks
>> 
>> JD Smith <jdtsmith@gmail.com> writes:
>> 
>>> Thanks for the query.  This is still an issue in Emacs 29 with emacs -Q.
>> 
>> Thanks, reopened.
>> 
>>> Reproducer: The reproduction recipe was in the linked emacs-devel
>>> <https://lists.gnu.org/archive/html/emacs-devel/2022-02/msg00496.html>
>>> thread.  Here it is again (with Emacs 29 updates in [brackets]):
>> 
>> I've tried editing your recipe down into something that's a little bit
>> easier for me to work with.
>> 
>> All of this is pasted into an emacs -Q "*scratch*" buffer:
>> 
>> (progn
>>  (require 'compile)
>>  (defun my/filename-function () (list (get-buffer (match-string 1))))
>>  (defvar my/compilation-error-regexp
>>    `((,(rx line-start
>> 	    "Buffer \"" (group (+ (not "\""))) "\", " ; 1: buffer name
>> 	    "line" (+ space) (group (+ digit))	    ; 2: line
>> 	    (* nonl) ?\n)
>>       my/filename-function
>>       2
>>       nil nil 1)))
>>  (progn (compilation-setup)
>>         (setq compilation-error-regexp-alist my/compilation-error-regexp)
>>         (compilation-parse-errors (point-min) (point-max)))
>>  (compilation-parse-errors (point-min) (point-max)))
>> 
>> But this doesn't give me any error when evaluating it either Emacs 29.1
>> or current master.  Did I miss something?  Perhaps there is some step
>> missing in my edited recipe?
> 
> More information was requested, but none was given within 4 months, so
> I'm closing this bug.
> 
> If this is still an issue, please reply to this email (use "Reply to
> all" in your email client) and we can reopen the bug report.

bug#57883: compilation-get-file-structure mishandles buffers

[Stefan Kangas]

reopen 57883
thanks

JD Smith <jdtsmith@gmail.com> writes:

> Apologies, I had missed this request.  The problem with your version
> of the code is it doesn’t actually create any error text for
> parse-errors to match.  Here’s a small tweak to your code to do this.
> It is still producing the same error in v29.1:

Thanks, so I'm reopening this bug.