procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Flymake backends can report multiple times per check

Browse source 
Rewrote a significant part of the Flymake backend API.  Flymake now
ignores the return value of backend functions: a function can either
returns or errors.  If it doesn't error, a backend is no longer
constrained to call REPORT-FN exactly once.  It may do so any number
of times, cumulatively reporting diagnostics.  Flymake keeps track of
outdated REPORT-FN instances and disconsiders obsolete reports.
Backends should avoid reporting obsolete data by cancelling any
ongoing processing at every renewed call to the backend function.

Consolidated flymake.el internal data structures to require less
buffer-local variables.  Adjusted Flymake's mode-line indicator to the
new semantics.

Adapted and simplified the implementation of elisp and legacy
backends, fixing potential race conditions when calling backends in
rapid succession.

Added a new test for a backend that calls REPORT-FN multiple
times.  Simplify test infrastructure.

* lisp/progmodes/flymake-elisp.el (flymake-elisp-checkdoc)
(flymake-elisp-byte-compile): Error instead of returning nil
if not in emacs-lisp-mode.
(flymake-elisp--byte-compile-process): New buffer-local variable.
(flymake-elisp-byte-compile): Mark (and kill) previous process
obsolete process before starting a new one.  Don't report if
obsolete process.

* lisp/progmodes/flymake-proc.el
(flymake-proc--current-process): New buffer-local variable.
(flymake-proc--processes): Remove.
(flymake-proc--process-filter): Don't bind
flymake-proc--report-fn.
(flymake-proc--process-sentinel): Rewrite.  Don't report if
obsolete process.
(flymake-proc-legacy-flymake): Rewrite.  Mark (and kill)
previous process obsolete process before starting a new
one.  Integrate flymake-proc--start-syntax-check-process
helper.
(flymake-proc--start-syntax-check-process): Delete.
(flymake-proc-stop-all-syntax-checks): Don't use
flymake-proc--processes, iterate buffers.
(flymake-proc-compile):

* lisp/progmodes/flymake.el (subr-x): Require it
explicitly.
(flymake-diagnostic-functions): Reword docstring.
(flymake--running-backends, flymake--disabled-backends)
(flymake--diagnostics-table): Delete.
(flymake--backend-state): New buffer-local variable and new defstruct.
(flymake--with-backend-state, flymake--collect)
(flymake-running-backends, flymake-disabled-backends)
(flymake-reporting-backends): New helpers.
(flymake-is-running): Use flymake-running-backends.
(flymake--handle-report): Rewrite.
(flymake-make-report-fn): Ensure REPORT-FN runs in the correct
buffer or not at all.
(flymake--disable-backend, flymake--run-backend): Rewrite.
(flymake-start): Rewrite.
(flymake-mode): Set flymake--backend-state.
(flymake--mode-line-format): Rewrite.

* test/lisp/progmodes/flymake-tests.el
(flymake-tests--wait-for-backends): New helper.
(flymake-tests--call-with-fixture): Use it.
(included-c-header-files): Fix whitespace.
(flymake-tests--diagnose-words): New helper.
(dummy-backends): Rewrite for new semantics.  Use cl-letf.
(flymake-tests--assert-set): Use quote.
(recurrent-backend): New test.
This commit is contained in:
João Távora 2017-09-30 17:32:53 +01:00
parent 22a7372fab
commit f6e909b41e
4 changed files with 599 additions and 460 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

94
lisp/progmodes/flymake-elisp.el
View file

@ -48,14 +48,15 @@
(defun flymake-elisp-checkdoc (report-fn)
"A flymake backend for `checkdoc'.
Calls REPORT-FN directly."
(when (derived-mode-p 'emacs-lisp-mode)
(funcall report-fn
(cl-loop for (text start end _unfixable) in
(flymake-elisp--checkdoc-1)
collect
(flymake-make-diagnostic
(current-buffer)
start end :note text)))))
(unless (derived-mode-p 'emacs-lisp-mode)
(error "Can only work on `emacs-lisp-mode' buffers"))
(funcall report-fn
(cl-loop for (text start end _unfixable) in
(flymake-elisp--checkdoc-1)
collect
(flymake-make-diagnostic
(current-buffer)
start end :note text))))
(defun flymake-elisp--byte-compile-done (report-fn
origin-buffer
@ -94,40 +95,59 @@ Calls REPORT-FN directly."
(kill-buffer output-buffer)
(ignore-errors (delete-file temp-file))))
(defvar-local flymake-elisp--byte-compile-process nil
"Buffer-local process started for byte-compiling the buffer.")
(defun flymake-elisp-byte-compile (report-fn)
"A flymake backend for elisp byte compilation.
"A Flymake backend for elisp byte compilation.
Spawn an Emacs process that byte-compiles a file representing the
current buffer state and calls REPORT-FN when done."
(interactive (list (lambda (stuff)
(message "aha %s" stuff))))
(when (derived-mode-p 'emacs-lisp-mode)
(let ((temp-file (make-temp-file "flymake-elisp-byte-compile"))
(origin-buffer (current-buffer)))
(save-restriction
(widen)
(write-region (point-min) (point-max) temp-file nil 'nomessage))
(let* ((output-buffer (generate-new-buffer " *flymake-elisp-byte-compile*")))
(make-process
:name "flymake-elisp-byte-compile"
:buffer output-buffer
:command (list (expand-file-name invocation-name invocation-directory)
"-Q"
"--batch"
;; "--eval" "(setq load-prefer-newer t)" ; for testing
"-L" default-directory
"-l" "flymake-elisp"
"-f" "flymake-elisp--batch-byte-compile"
temp-file)
:connection-type 'pipe
:sentinel
(lambda (proc _event)
(unless (process-live-p proc)
(flymake-elisp--byte-compile-done report-fn
origin-buffer
output-buffer
temp-file))))
:stderr null-device
:noquery t))))
(unless (derived-mode-p 'emacs-lisp-mode)
(error "Can only work on `emacs-lisp-mode' buffers"))
(when flymake-elisp--byte-compile-process
(process-put flymake-elisp--byte-compile-process 'flymake-elisp--obsolete t)
(when (process-live-p flymake-elisp--byte-compile-process)
(kill-process flymake-elisp--byte-compile-process)))
(let ((temp-file (make-temp-file "flymake-elisp-byte-compile"))
(origin-buffer (current-buffer)))
(save-restriction
(widen)
(write-region (point-min) (point-max) temp-file nil 'nomessage))
(let* ((output-buffer (generate-new-buffer " *flymake-elisp-byte-compile*")))
(setq
flymake-elisp--byte-compile-process
(make-process
:name "flymake-elisp-byte-compile"
:buffer output-buffer
:command (list (expand-file-name invocation-name invocation-directory)
"-Q"
"--batch"
;; "--eval" "(setq load-prefer-newer t)" ; for testing
"-L" default-directory
"-l" "flymake-elisp"
"-f" "flymake-elisp--batch-byte-compile"
temp-file)
:connection-type 'pipe
:sentinel
(lambda (proc _event)
(unless (process-live-p proc)
(unwind-protect
(cond
((zerop (process-exit-status proc))
(flymake-elisp--byte-compile-done report-fn
origin-buffer
output-buffer
temp-file))
((process-get proc 'flymake-elisp--obsolete)
(flymake-log 3 "proc %s considered obsolete" proc))
(t
(funcall report-fn
:panic
:explanation (format "proc %s died violently" proc)))))))))
:stderr null-device
:noquery t)))
(defun flymake-elisp--batch-byte-compile (&optional file)
"Helper for `flymake-elisp-byte-compile'.

245
lisp/progmodes/flymake-proc.el
View file

@ -109,12 +109,9 @@ NAME is the file name function to use, default `flymake-proc-get-real-file-name'
(const :tag "flymake-proc-get-real-file-name" nil)
function))))
(defvar-local flymake-proc--process nil
(defvar-local flymake-proc--current-process nil
"Currently active flymake process for a buffer, if any.")
(defvar flymake-proc--processes nil
"List of currently active flymake processes.")
(defvar flymake-proc--report-fn nil
"If bound, function used to report back to flymake's UI.")
@ -543,9 +540,7 @@ Create parent directories as needed."
"Parse STRING and collect diagnostics info."
(flymake-log 3 "received %d byte(s) of output from process %d"
(length string) (process-id proc))
(let ((output-buffer (process-get proc 'flymake-proc--output-buffer))
(flymake-proc--report-fn
(process-get proc 'flymake-proc--report-fn)))
(let ((output-buffer (process-get proc 'flymake-proc--output-buffer)))
(when (and (buffer-live-p (process-buffer proc))
output-buffer)
(with-current-buffer output-buffer
@ -578,49 +573,55 @@ Create parent directories as needed."
(defun flymake-proc--process-sentinel (proc _event)
"Sentinel for syntax check buffers."
(when (memq (process-status proc) '(signal exit))
(let* ((exit-status (process-exit-status proc))
(command (process-command proc))
(source-buffer (process-buffer proc))
(flymake-proc--report-fn (process-get proc
'flymake-proc--report-fn))
(cleanup-f (flymake-proc--get-cleanup-function
(buffer-file-name source-buffer)))
(diagnostics (process-get
proc
'flymake-proc--collected-diagnostics))
(interrupted (process-get proc 'flymake-proc--interrupted))
(panic nil)
(output-buffer (process-get proc 'flymake-proc--output-buffer)))
(flymake-log 2 "process %d exited with code %d"
(process-id proc) exit-status)
(condition-case-unless-debug err
(progn
(flymake-log 3 "cleaning up using %s" cleanup-f)
(with-current-buffer source-buffer
(funcall cleanup-f)
(cond ((equal 0 exit-status)
(funcall flymake-proc--report-fn diagnostics))
(interrupted
(flymake-proc--panic :stopped interrupted))
(diagnostics
;; non-zero exit but some diagnostics is quite
;; normal...
(funcall flymake-proc--report-fn diagnostics))
((null diagnostics)
;; ...but no diagnostics is strange, so panic.
(setq panic t)
(flymake-proc--panic
:configuration-error
(format "Command %s errored, but no diagnostics"
command))))))
(delete-process proc)
(setq flymake-proc--processes
(delq proc flymake-proc--processes))
(if panic
(flymake-log 1 "Output buffer %s kept alive for debugging"
output-buffer)
(kill-buffer output-buffer))))))
(let (debug
(pid (process-id proc))
(source-buffer (process-buffer proc)))
(unwind-protect
(when (buffer-live-p source-buffer)
(with-current-buffer source-buffer
(cond ((process-get proc 'flymake-proc--obsolete)
(flymake-log 3 "proc %s considered obsolete"
pid))
((process-get proc 'flymake-proc--interrupted)
(flymake-log 3 "proc %s interrupted by user"
pid))
((not (process-live-p proc))
(let* ((exit-status (process-exit-status proc))
(command (process-command proc))
(diagnostics (process-get
proc
'flymake-proc--collected-diagnostics)))
(flymake-log 2 "process %d exited with code %d"
pid exit-status)
(cond
((equal 0 exit-status)
(funcall flymake-proc--report-fn diagnostics
:explanation (format "a gift from %s" (process-id proc))
))
(diagnostics
;; non-zero exit but some diagnostics is quite
;; normal...
(funcall flymake-proc--report-fn diagnostics
:explanation (format "a gift from %s" (process-id proc))))
((null diagnostics)
;; ...but no diagnostics is strange, so panic.
(setq debug debug-on-error)
(flymake-proc--panic
:configuration-error
(format "Command %s errored, but no diagnostics"
command)))))))))
(let ((output-buffer (process-get proc 'flymake-proc--output-buffer)))
(cond (debug
(flymake-log 3 "Output buffer %s kept alive for debugging"
output-buffer))
(t
(when (buffer-live-p source-buffer)
(with-current-buffer source-buffer
(let ((cleanup-f (flymake-proc--get-cleanup-function
(buffer-file-name))))
(flymake-log 3 "cleaning up using %s" cleanup-f)
(funcall cleanup-f))))
(kill-buffer output-buffer)))))))
(defun flymake-proc--panic (problem explanation)
"Tell flymake UI about a fatal PROBLEM with this backend.
@ -729,87 +730,85 @@ can also be executed interactively independently of
diags
(append args '(:force t))))
t))
(cond
((process-live-p flymake-proc--process)
(when interactive
(user-error
"There's already a flymake process running in this buffer")))
((and buffer-file-name
;; Since we write temp files in current dir, there's no point
;; trying if the directory is read-only (bug#8954).
(file-writable-p (file-name-directory buffer-file-name))
(or (not flymake-proc-compilation-prevents-syntax-check)
(not (flymake-proc--compilation-is-running))))
(let ((init-f (flymake-proc--get-init-function buffer-file-name)))
(unless init-f (error "Can find a suitable init function"))
(flymake-proc--clear-buildfile-cache)
(flymake-proc--clear-project-include-dirs-cache)
(let ((proc flymake-proc--current-process)
(flymake-proc--report-fn report-fn))
(when (processp proc)
(process-put proc 'flymake-proc--obsolete t)
(flymake-log 3 "marking %s obsolete" (process-id proc))
(when (process-live-p proc)
(when interactive
(user-error
"There's already a flymake process running in this buffer")
(kill-process proc))))
(when
;; A number of situations make us not want to error right away
;; (and disable ourselves), in case the situation changes in
;; the near future.
(and buffer-file-name
;; Since we write temp files in current dir, there's no point
;; trying if the directory is read-only (bug#8954).
(file-writable-p (file-name-directory buffer-file-name))
(or (not flymake-proc-compilation-prevents-syntax-check)
(not (flymake-proc--compilation-is-running))))
(let ((init-f (flymake-proc--get-init-function buffer-file-name)))
(unless init-f (error "Can find a suitable init function"))
(flymake-proc--clear-buildfile-cache)
(flymake-proc--clear-project-include-dirs-cache)
(let* ((flymake-proc--report-fn report-fn)
(cleanup-f (flymake-proc--get-cleanup-function buffer-file-name))
(cmd-and-args (funcall init-f))
(cmd (nth 0 cmd-and-args))
(args (nth 1 cmd-and-args))
(dir (nth 2 cmd-and-args)))
(cond ((not cmd-and-args)
(progn
(flymake-log 0 "init function %s for %s failed, cleaning up"
init-f buffer-file-name)
(funcall cleanup-f)))
(t
(setq flymake-last-change-time nil)
(flymake-proc--start-syntax-check-process cmd
args
dir)
t)))))))
(let* ((cleanup-f (flymake-proc--get-cleanup-function buffer-file-name))
(cmd-and-args (funcall init-f))
(cmd (nth 0 cmd-and-args))
(args (nth 1 cmd-and-args))
(dir (nth 2 cmd-and-args))
(success nil))
(unwind-protect
(cond
((not cmd-and-args)
(flymake-log 0 "init function %s for %s failed, cleaning up"
init-f buffer-file-name))
(t
(setq flymake-last-change-time nil)
(setq proc
(let ((default-directory (or dir default-directory)))
(when dir
(flymake-log 3 "starting process on dir %s" dir))
(make-process
:name "flymake-proc"
:buffer (current-buffer)
:command (cons cmd args)
:noquery t
:filter
(lambda (proc string)
(let ((flymake-proc--report-fn report-fn))
(flymake-proc--process-filter proc string)))
:sentinel
(lambda (proc event)
(let ((flymake-proc--report-fn report-fn))
(flymake-proc--process-sentinel proc event))))))
(process-put proc 'flymake-proc--output-buffer
(generate-new-buffer
(format " *flymake output for %s*" (current-buffer))))
(setq flymake-proc--current-process proc)
(flymake-log 2 "started process %d, command=%s, dir=%s"
(process-id proc) (process-command proc)
default-directory)
(setq success t)))
(unless success
(funcall cleanup-f))))))))
(define-obsolete-function-alias 'flymake-start-syntax-check
'flymake-proc-legacy-flymake "26.1")
(defun flymake-proc--start-syntax-check-process (cmd args dir)
"Start syntax check process."
(condition-case-unless-debug err
(let* ((process
(let ((default-directory (or dir default-directory)))
(when dir
(flymake-log 3 "starting process on dir %s" dir))
(make-process :name "flymake-proc"
:buffer (current-buffer)
:command (cons cmd args)
:noquery t
:filter 'flymake-proc--process-filter
:sentinel 'flymake-proc--process-sentinel))))
(process-put process 'flymake-proc--output-buffer
(generate-new-buffer
(format " *flymake output for %s*" (current-buffer))))
(process-put process 'flymake-proc--report-fn
flymake-proc--report-fn)
(setq-local flymake-proc--process process)
(push process flymake-proc--processes)
(setq flymake-is-running t)
(setq flymake-last-change-time nil)
(flymake-log 2 "started process %d, command=%s, dir=%s"
(process-id process) (process-command process)
default-directory)
process)
(error
(flymake-proc--panic :make-process-error
(format-message
"Failed to launch syntax check process `%s' with args %s: %s"
cmd args (error-message-string err)))
(funcall (flymake-proc--get-cleanup-function buffer-file-name)))))
(defun flymake-proc-stop-all-syntax-checks (&optional reason)
"Kill all syntax check processes."
(interactive (list "Interrupted by user"))
(mapc (lambda (proc)
(kill-process proc)
(process-put proc 'flymake-proc--interrupted reason)
(flymake-log 2 "killed process %d" (process-id proc)))
flymake-proc--processes))
(dolist (buf (buffer-list))
(with-current-buffer buf
(let (p flymake-proc--current-process)
(when (process-live-p p)
(kill-process p)
(process-put p 'flymake-proc--interrupted reason)
(flymake-log 2 "killed process %d" (process-id p)))))))
(defun flymake-proc--compilation-is-running ()
(and (boundp 'compilation-in-progress)

474
lisp/progmodes/flymake.el
View file

@ -36,7 +36,7 @@
(require 'thingatpt) ; end-of-thing
(require 'warnings) ; warning-numeric-level, display-warning
(require 'compile) ; for some faces
(eval-when-compile (require 'subr-x)) ; when-let*, if-let*
(require 'subr-x) ; when-let*, if-let*, hash-table-keys, hash-table-values
(defgroup flymake nil
"Universal on-the-fly syntax checker."
@ -315,42 +315,39 @@ about where and how to annotate problems diagnosed in a buffer.
Whenever Flymake or the user decides to re-check the buffer, each
function is called with a common calling convention, a single
REPORT-FN argument, detailed below. Backend functions are first
expected to quickly and inexpensively announce the feasibility of
checking the buffer via the return value (i.e. they aren't
required to immediately start checking the buffer):
REPORT-FN argument, detailed below. Backend functions are
expected to initiate the buffer check, but aren't required to
complete it check before exiting: if the computation involved is
expensive, especially for large buffers, that task can be
scheduled for the future using asynchronous processes or other
asynchronous mechanisms.
* If the backend function returns nil, Flymake forgets about this
backend for the current check, but will call it again for the
next one;
In any case, backend functions are expected to return quickly or
signal an error, in which case the backend is disabled. Flymake
will not try disabled backends again for any future checks of
this buffer. Certain commands, like turning `flymake-mode' off
and on again, reset the list of disabled backends.
* If the backend function returns non-nil, Flymake expects this
backend to check the buffer and call its REPORT-FN callback
function exactly once. If the computation involved is
inexpensive, the backend function may do so synchronously,
before returning. If it is not, it should do so after
returning, using idle timers, asynchronous processes or other
asynchronous mechanisms.
* If the backend function signals an error, it is disabled,
i.e. Flymake will not use it again for the current or any
future checks of this buffer. Certain commands, like turning
`flymake-mode' on and off again, resets the list of disabled
backends.
Backends are required to call REPORT-FN with a single argument
ACTION followed by an optional list of keywords parameters and
If the function returns, Flymake considers the backend to be
\"running\". If it has not done so already, the backend is
expected to call the function REPORT-FN with a single argument
ACTION followed by an optional list of keyword arguments and
their values (:KEY1 VALUE1 :KEY2 VALUE2...).
The possible values for ACTION are.
* A (possibly empty) list of objects created with
* A (possibly empty) list of diagnostic objects created with
`flymake-make-diagnostic', causing Flymake to annotate the
buffer with this information and consider the backend has
having finished its check normally.
buffer with this information.
* The symbol `:progress', signalling that the backend is still
working and will call REPORT-FN again in the future.
A backend may call REPORT-FN repeatedly in this manner, but
only until Flymake considers that the most recently requested
buffer check is now obsolete because, say, buffer contents have
changed in the meantime. The backend is only given notice of
this via a renewed call to the backend function. Thus, to
prevent making obsolete reports and wasting resources, backend
functions should first cancel any ongoing processing from
previous calls.
* The symbol `:panic', signalling that the backend has
encountered an exceptional situation and should be disabled.
@ -360,8 +357,8 @@ The recognized optional keyword arguments are:
* ‘:explanation’: value should give user-readable details of
the situation encountered, if any.
* ‘:force’: value should be a boolean forcing the Flymake UI
to consider the report even if was somehow unexpected.")
* ‘:force’: value should be a boolean suggesting that the Flymake
considers the report even if was somehow unexpected.")
(defvar flymake-diagnostic-types-alist
`((:error
@ -493,122 +490,189 @@ associated `flymake-category' return DEFAULT."
;; third-party compatibility.
(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1")
(defvar-local flymake--running-backends nil
"List of currently active flymake backends.
An active backend is a member of `flymake-diagnostic-functions'
that has been invoked but hasn't reported any final status yet.")
(defvar-local flymake--backend-state nil
"Buffer-local hash table of a Flymake backend's state.
The keys to this hash table are functions as found in
`flymake-diagnostic-functions'. The values are structures
of the type `flymake--backend-state', with these slots
(defvar-local flymake--disabled-backends nil
"List of currently disabled flymake backends.
A backend is disabled if it reported `:panic'.")
`running', a symbol to keep track of a backend's replies via its
REPORT-FN argument. A backend is running if this key is
present. If the key is absent if the backend isn't expecting any
replies from the backend.
(defvar-local flymake--diagnostics-table nil
"Hash table of all diagnostics indexed by backend.")
`diags', a (possibly empty) list of diagnostic objects created
with `flymake-make-diagnostic'. This key is absent if the
backend hasn't reported anything yet.
`reported-p', a boolean indicating if the backend has replied
since it last was contacted.
`disabled', a string with the explanation for a previous
exceptional situation reported by the backend. If this key is
present the backend is disabled.")
(cl-defstruct (flymake--backend-state
(:constructor flymake--make-backend-state))
running reported-p disabled diags)
(defmacro flymake--with-backend-state (backend state-var &rest body)
"Bind BACKEND's STATE-VAR to its state, run BODY."
(declare (indent 2) (debug (sexp sexp &rest form)))
(let ((b (make-symbol "b")))
`(let* ((,b ,backend)
(,state-var
(or (gethash ,b flymake--backend-state)
(puthash ,b (flymake--make-backend-state)
flymake--backend-state))))
,@body)))
(defun flymake-is-running ()
"Tell if flymake has running backends in this buffer"
flymake--running-backends)
(flymake-running-backends))
(defun flymake--disable-backend (backend action &optional explanation)
(cl-pushnew backend flymake--disabled-backends)
(flymake-log :warning "Disabled the backend %s due to reports of %s (%s)"
backend action explanation))
(cl-defun flymake--handle-report (backend token action &key explanation force)
"Handle reports from BACKEND identified by TOKEN.
(cl-defun flymake--handle-report (backend action &key explanation force)
"Handle reports from flymake backend identified by BACKEND.
BACKEND, ACTION and EXPLANATION, and FORCE conform to the calling
convention described in `flymake-diagnostic-functions' (which
see). Optional FORCE says to handle a report even if TOKEN was
not expected."
(let* ((state (gethash backend flymake--backend-state))
(first-report (not (flymake--backend-state-reported-p state))))
(setf (flymake--backend-state-reported-p state) t)
(let (expected-token
new-diags)
(cond
((null state)
(flymake-error
"Unexpected report from unknown backend %s" backend))
((flymake--backend-state-disabled state)
(flymake-error
"Unexpected report from disabled backend %s" backend))
((progn
(setq expected-token (flymake--backend-state-running state))
(null expected-token))
;; should never happen
(flymake-error "Unexpected report from stopped backend %s" backend))
((and (not (eq expected-token token))
(not force))
(flymake-error "Obsolete report from backend %s with explanation %s"
backend explanation))
((eq :panic action)
(flymake--disable-backend backend explanation))
((not (listp action))
(flymake--disable-backend backend
(format "Unknown action %S" action))
(flymake-error "Expected report, but got unknown key %s" action))
(t
(setq new-diags action)
(save-restriction
(widen)
;; only delete overlays if this is the first report
(when first-report
(flymake-delete-own-overlays
(lambda (ov)
(eq backend
(flymake--diag-backend
(overlay-get ov 'flymake--diagnostic))))))
(mapc (lambda (diag)
(flymake--highlight-line diag)
(setf (flymake--diag-backend diag) backend))
new-diags)
(setf (flymake--backend-state-diags state)
(append new-diags (flymake--backend-state-diags state)))
(when flymake-check-start-time
(flymake-log :debug "backend %s reported %d diagnostics in %.2f second(s)"
backend
(length new-diags)
(- (float-time) flymake-check-start-time)))))))))
BACKEND, ACTION and EXPLANATION conform to the calling convention
described in `flymake-diagnostic-functions' (which see). Optional
FORCE says to handle a report even if it was not expected."
(cond
((and (not (memq backend flymake--running-backends))
(not force))
(flymake-error "Ignoring unexpected report from backend %s" backend))
((eq action :progress)
(flymake-log 3 "Backend %s reports progress: %s" backend explanation))
((eq :panic action)
(flymake--disable-backend backend action explanation))
((listp action)
(let ((diagnostics action))
(save-restriction
(widen)
(flymake-delete-own-overlays
(lambda (ov)
(eq backend
(flymake--diag-backend
(overlay-get ov 'flymake--diagnostic)))))
(puthash backend diagnostics flymake--diagnostics-table)
(mapc (lambda (diag)
(flymake--highlight-line diag)
(setf (flymake--diag-backend diag) backend))
diagnostics)
(when flymake-check-start-time
(flymake-log 2 "backend %s reported %d diagnostics in %.2f second(s)"
backend
(length diagnostics)
(- (float-time) flymake-check-start-time))))))
(t
(flymake--disable-backend "?"
:strange
(format "unknown action %s (%s)"
action explanation))))
(unless (eq action :progress)
(flymake--stop-backend backend)))
(defun flymake-make-report-fn (backend)
(defun flymake-make-report-fn (backend &optional token)
"Make a suitable anonymous report function for BACKEND.
BACKEND is used to help flymake distinguish diagnostic
sources."
(lambda (&rest args)
(apply #'flymake--handle-report backend args)))
BACKEND is used to help flymake distinguish different diagnostic
sources. If provided, TOKEN helps flymake distinguish between
different runs of the same backend."
(let ((buffer (current-buffer)))
(lambda (&rest args)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(apply #'flymake--handle-report backend token args))))))
(defun flymake--stop-backend (backend)
"Stop the backend BACKEND."
(setq flymake--running-backends (delq backend flymake--running-backends)))
(defun flymake--collect (fn)
(let (retval)
(maphash (lambda (backend state)
(when (funcall fn state) (push backend retval)))
flymake--backend-state)
retval))
(defun flymake-running-backends ()
"Compute running Flymake backends in current buffer."
(flymake--collect #'flymake--backend-state-running))
(defun flymake-disabled-backends ()
"Compute disabled Flymake backends in current buffer."
(flymake--collect #'flymake--backend-state-disabled))
(defun flymake-reporting-backends ()
"Compute reporting Flymake backends in current buffer."
(flymake--collect #'flymake--backend-state-reported-p))
(defun flymake--disable-backend (backend &optional explanation)
"Disable BACKEND because EXPLANATION.
If is is running also stop it."
(flymake-log :warning "Disabling backend %s because %s" backend explanation)
(flymake--with-backend-state backend state
(setf (flymake--backend-state-running state) nil
(flymake--backend-state-disabled state) explanation
(flymake--backend-state-reported-p state) t)))
(defun flymake--run-backend (backend)
"Run the backend BACKEND."
(push backend flymake--running-backends)
(remhash backend flymake--diagnostics-table)
;; FIXME: Should use `condition-case-unless-debug' here, but that
;; won't let me catch errors from inside `ert-deftest' where
;; `debug-on-error' is always t
(condition-case err
(unless (funcall backend
(flymake-make-report-fn backend))
(flymake--stop-backend backend))
(error
(flymake--disable-backend backend :error
err)
(flymake--stop-backend backend))))
"Run the backend BACKEND, reenabling if necessary."
(flymake-log :debug "Running backend %s" backend)
(let ((run-token (cl-gensym "backend-token")))
(flymake--with-backend-state backend state
(setf (flymake--backend-state-running state) run-token
(flymake--backend-state-disabled state) nil
(flymake--backend-state-diags state) nil
(flymake--backend-state-reported-p state) nil))
;; FIXME: Should use `condition-case-unless-debug' here, for don't
;; for two reasons: (1) that won't let me catch errors from inside
;; `ert-deftest' where `debug-on-error' appears to be always
;; t. (2) In cases where the user is debugging elisp somewhere
;; else, and using flymake, the presence of a frequently
;; misbehaving backend in the global hook (most likely the legacy
;; backend) will trigger an annoying backtrace.
;;
(condition-case err
(funcall backend
(flymake-make-report-fn backend run-token))
(error
(flymake--disable-backend backend err)))))
(defun flymake-start (&optional deferred interactive)
(defun flymake-start (&optional deferred force)
"Start a syntax check.
Start it immediately, or after current command if DEFERRED is
non-nil. With optional INTERACTIVE or interactively, clear any
stale information about running and automatically disabled
backends."
(interactive (list nil t))
non-nil. With optional FORCE run even disabled backends.
Interactively, with a prefix arg, FORCE is t."
(interactive (list nil current-prefix-arg))
(cl-labels
((start
()
(remove-hook 'post-command-hook #'start 'local)
(setq flymake-check-start-time (float-time))
(when interactive
(setq flymake--diagnostics-table (make-hash-table)
flymake--running-backends nil
flymake--disabled-backends nil))
(run-hook-wrapped
'flymake-diagnostic-functions
(lambda (backend)
(cond ((memq backend flymake--running-backends)
(flymake-log :debug "Backend %s still running, not restarting"
backend))
((memq backend flymake--disabled-backends)
(flymake-log :debug "Backend %s is disabled, not starting"
backend))
(t
(flymake--run-backend backend)))
(cond
((and (not force)
(flymake--with-backend-state backend state
(flymake--backend-state-disabled state)))
(flymake-log :debug "Backend %s is disabled, not starting"
backend))
(t
(flymake--run-backend backend)))
nil))))
(if (and deferred
this-command)
@ -623,8 +687,6 @@ backends."
;;;###autoload
(define-minor-mode flymake-mode nil
:group 'flymake :lighter flymake--mode-line-format :keymap flymake-mode-map
(setq flymake--running-backends nil
flymake--disabled-backends nil)
(cond
;; Turning the mode ON.
(flymake-mode
@ -636,7 +698,7 @@ backends."
(add-hook 'after-save-hook 'flymake-after-save-hook nil t)
(add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
(setq flymake--diagnostics-table (make-hash-table))
(setq flymake--backend-state (make-hash-table))
(when flymake-start-syntax-check-on-find-file
(flymake-start)))))
@ -797,20 +859,26 @@ applied."
(defun flymake--mode-line-format ()
"Produce a pretty minor mode indicator."
(let ((running flymake--running-backends)
(reported (cl-plusp
(hash-table-count flymake--diagnostics-table))))
(let* ((known (hash-table-keys flymake--backend-state))
(running (flymake-running-backends))
(disabled (flymake-disabled-backends))
(reported (flymake-reporting-backends))
(diags-by-type (make-hash-table))
(all-disabled (and disabled (null running)))
(some-waiting (cl-set-difference running reported)))
(maphash (lambda (_b state)
(mapc (lambda (diag)
(push diag
(gethash (flymake--diag-type diag)
diags-by-type)))
(flymake--backend-state-diags state)))
flymake--backend-state)
`((:propertize " Flymake"
mouse-face mode-line-highlight
,@(when (not reported)
`(face compilation-mode-line-fail))
help-echo
,(concat (format "%s registered backends\n"
(length flymake-diagnostic-functions))
(format "%s running\n"
(length running))
(format "%s disabled\n"
(length flymake--disabled-backends))
,(concat (format "%s known backends\n" (length known))
(format "%s running\n" (length running))
(format "%s disabled\n" (length disabled))
"mouse-1: go to log buffer ")
keymap
,(let ((map (make-sparse-keymap)))
@ -819,69 +887,73 @@ applied."
(interactive "e")
(switch-to-buffer "*Flymake log*")))
map))
,@(when running
`(":" (:propertize "Run"
face compilation-mode-line-run
help-echo
,(format "%s running backends"
(length running)))))
,@(when reported
(let ((by-type (make-hash-table)))
(maphash (lambda (_backend diags)
(mapc (lambda (diag)
(push diag
(gethash (flymake--diag-type diag)
by-type)))
diags))
flymake--diagnostics-table)
(cl-loop
for (type . severity)
in (cl-sort (mapcar (lambda (type)
(cons type (flymake--lookup-type-property
type
'severity
(warning-numeric-level :error))))
(cl-union (hash-table-keys by-type)
'(:error :warning)))
#'>
:key #'cdr)
for diags = (gethash type by-type)
for face = (flymake--lookup-type-property type
'mode-line-face
'compilation-error)
when (or diags
(>= severity (warning-numeric-level :warning)))
collect `(:propertize
,(format "%d" (length diags))
face ,face
mouse-face mode-line-highlight
keymap
,(let ((map (make-sparse-keymap))
(type type))
(define-key map [mode-line mouse-4]
(lambda (_event)
(interactive "e")
(flymake-goto-prev-error 1 (list type) t)))
(define-key map [mode-line mouse-5]
(lambda (_event)
(interactive "e")
(flymake-goto-next-error 1 (list type) t)))
map)
help-echo
,(concat (format "%s diagnostics of type %s\n"
(propertize (format "%d"
(length diags))
'face face)
(propertize (format "%s" type)
'face face))
"mouse-4/mouse-5: previous/next of this type\n"))
into forms
finally return
`((:propertize "[")
,@(cl-loop for (a . rest) on forms by #'cdr
collect a when rest collect
'(:propertize " "))
(:propertize "]"))))))))
,@(pcase-let ((`(,ind ,face ,explain)
(cond ((null known)
`("?" mode-line "No known backends"))
(some-waiting
`("Wait" compilation-mode-line-run
,(format "Waiting for %s running backends"
(length running))))
(all-disabled
`("!" compilation-mode-line-run
"All backends disabled"))
(t
`(nil nil nil)))))
(when ind
`((":"
(:propertize ,ind
face ,face
help-echo ,explain)))))
,@(unless (or all-disabled
(null known))
(cl-loop
for (type . severity)
in (cl-sort (mapcar (lambda (type)
(cons type (flymake--lookup-type-property
type
'severity
(warning-numeric-level :error))))
(cl-union (hash-table-keys diags-by-type)
'(:error :warning)))
#'>
:key #'cdr)
for diags = (gethash type diags-by-type)
for face = (flymake--lookup-type-property type
'mode-line-face
'compilation-error)
when (or diags
(>= severity (warning-numeric-level :warning)))
collect `(:propertize
,(format "%d" (length diags))
face ,face
mouse-face mode-line-highlight
keymap
,(let ((map (make-sparse-keymap))
(type type))
(define-key map [mode-line mouse-4]
(lambda (_event)
(interactive "e")
(flymake-goto-prev-error 1 (list type) t)))
(define-key map [mode-line mouse-5]
(lambda (_event)
(interactive "e")
(flymake-goto-next-error 1 (list type) t)))
map)
help-echo
,(concat (format "%s diagnostics of type %s\n"
(propertize (format "%d"
(length diags))
'face face)
(propertize (format "%s" type)
'face face))
"mouse-4/mouse-5: previous/next of this type\n"))
into forms
finally return
`((:propertize "[")
,@(cl-loop for (a . rest) on forms by #'cdr
collect a when rest collect
'(:propertize " "))
(:propertize "]")))))))

246
test/lisp/progmodes/flymake-tests.el
View file

@ -36,6 +36,26 @@
;;
;;
(defun flymake-tests--wait-for-backends ()
;; Weirdness here... http://debbugs.gnu.org/17647#25
;; ... meaning `sleep-for', and even
;; `accept-process-output', won't suffice as ways to get
;; process filters and sentinels to run, though they do work
;; fine in a non-interactive batch session. The only thing
;; that will indeed unblock pending process output is
;; reading an input event, so, as a workaround, use a dummy
;; `read-event' with a very short timeout.
(unless noninteractive (read-event "" nil 0.1))
(cl-loop repeat 5
for notdone = (cl-set-difference (flymake-running-backends)
(flymake-reporting-backends))
while notdone
unless noninteractive do (read-event "" nil 0.1)
do (sleep-for (+ 0.5 flymake-no-changes-timeout))
finally (when notdone (ert-fail
(format "Some backends not reporting yet %s"
notdone)))))
(cl-defun flymake-tests--call-with-fixture (fn file
&key (severity-predicate
nil sev-pred-supplied-p))
@ -46,7 +66,6 @@ SEVERITY-PREDICATE is used to setup
(visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file)))
(process-environment (cons "LC_ALL=C" process-environment))
(i 0)
(warning-minimum-log-level :error))
(unwind-protect
(with-current-buffer buffer
@ -55,18 +74,7 @@ SEVERITY-PREDICATE is used to setup
(setq-local flymake-proc-diagnostic-type-pred severity-predicate))
(goto-char (point-min))
(unless flymake-mode (flymake-mode 1))
;; Weirdness here... http://debbugs.gnu.org/17647#25
;; ... meaning `sleep-for', and even
;; `accept-process-output', won't suffice as ways to get
;; process filters and sentinels to run, though they do work
;; fine in a non-interactive batch session. The only thing
;; that will indeed unblock pending process output is
;; reading an input event, so, as a workaround, use a dummy
;; `read-event' with a very short timeout.
(unless noninteractive (read-event "" nil 0.1))
(while (and (flymake-is-running) (< (setq i (1+ i)) 10))
(unless noninteractive (read-event "" nil 0.1))
(sleep-for (+ 0.5 flymake-no-changes-timeout)))
(flymake-tests--wait-for-backends)
(funcall fn)))
(and buffer
(not visiting)
@ -119,38 +127,37 @@ SEVERITY-PREDICATE is used to setup
(ert-deftest different-diagnostic-types ()
"Test GCC warning via function predicate."
(skip-unless (and (executable-find "gcc") (executable-find "make")))
(flymake-tests--with-flymake
("errors-and-warnings.c")
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-note (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(let ((flymake-wrap-around nil))
(should-error (flymake-goto-next-error nil nil t))) ))
(let ((flymake-wrap-around nil))
(flymake-tests--with-flymake
("errors-and-warnings.c")
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-note (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(should-error (flymake-goto-next-error nil nil t)))))
(ert-deftest included-c-header-files ()
"Test inclusion of .h header files."
(skip-unless (and (executable-find "gcc") (executable-find "make")))
(flymake-tests--with-flymake
("some-problems.h")
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point)))
(let ((flymake-wrap-around nil))
(should-error (flymake-goto-next-error nil nil t))) )
(flymake-tests--with-flymake
("no-problems.h")
(let ((flymake-wrap-around nil))
(should-error (flymake-goto-next-error nil nil t))) ))
(let ((flymake-wrap-around nil))
(flymake-tests--with-flymake
("some-problems.h")
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point)))
(should-error (flymake-goto-next-error nil nil t)))
(flymake-tests--with-flymake
("no-problems.h")
(should-error (flymake-goto-next-error nil nil t)))))
(defmacro flymake-tests--assert-set (set
should
@ -159,19 +166,15 @@ SEVERITY-PREDICATE is used to setup
`(progn
,@(cl-loop
for s in should
collect `(should (memq ,s ,set)))
collect `(should (memq (quote ,s) ,set)))
,@(cl-loop
for s in should-not
collect `(should-not (memq ,s ,set)))))
collect `(should-not (memq (quote ,s) ,set)))))
(ert-deftest dummy-backends ()
"Test GCC warning via function predicate."
(with-temp-buffer
(cl-labels
((diagnose
(report-fn type words)
(funcall
report-fn
(defun flymake-tests--diagnose-words
(report-fn type words)
"Helper. Call REPORT-FN with diagnostics for WORDS in buffer."
(funcall report-fn
(cl-loop
for word in words
append
@ -184,32 +187,34 @@ SEVERITY-PREDICATE is used to setup
(match-end 0)
type
(concat word " is wrong")))))))
(error-backend
(report-fn)
(run-with-timer
0.5 nil
#'diagnose report-fn :error '("manha" "prognata")))
(warning-backend
(report-fn)
(run-with-timer
0.5 nil
#'diagnose report-fn :warning '("ut" "dolor")))
(sync-backend
(report-fn)
(diagnose report-fn :note '("quis" "commodo")))
(refusing-backend
(_report-fn)
nil)
(panicking-backend
(report-fn)
(run-with-timer
0.5 nil
report-fn :panic :explanation "The spanish inquisition!"))
(crashing-backend
(_report-fn)
;; HACK: Shoosh log during tests
(setq-local warning-minimum-log-level :emergency)
(error "crashed")))
(ert-deftest dummy-backends ()
"Test many different kinds of backends."
(with-temp-buffer
(cl-letf
(((symbol-function 'error-backend)
(lambda (report-fn)
(run-with-timer
0.5 nil
#'flymake-tests--diagnose-words report-fn :error '("manha" "prognata"))))
((symbol-function 'warning-backend)
(lambda (report-fn)
(run-with-timer
0.5 nil
#'flymake-tests--diagnose-words report-fn :warning '("ut" "dolor"))))
((symbol-function 'sync-backend)
(lambda (report-fn)
(flymake-tests--diagnose-words report-fn :note '("quis" "commodo"))))
((symbol-function 'panicking-backend)
(lambda (report-fn)
(run-with-timer
0.5 nil
report-fn :panic :explanation "The spanish inquisition!")))
((symbol-function 'crashing-backend)
(lambda (_report-fn)
;; HACK: Shoosh log during tests
(setq-local warning-minimum-log-level :emergency)
(error "crashed"))))
(insert "Lorem ipsum dolor sit amet, consectetur adipiscing
elit, sed do eiusmod tempor incididunt ut labore et dolore
manha aliqua. Ut enim ad minim veniam, quis nostrud
@ -220,31 +225,27 @@ SEVERITY-PREDICATE is used to setup
sunt in culpa qui officia deserunt mollit anim id est
laborum.")
(let ((flymake-diagnostic-functions
(list #'error-backend #'warning-backend #'sync-backend
#'refusing-backend #'panicking-backend
#'crashing-backend
)))
(list 'error-backend 'warning-backend 'sync-backend
'panicking-backend
'crashing-backend
))
(flymake-wrap-around nil))
(flymake-mode)
;; FIXME: accessing some flymake-ui's internals here...
(flymake-tests--assert-set flymake--running-backends
(#'error-backend #'warning-backend #'panicking-backend)
(#'sync-backend #'crashing-backend #'refusing-backend))
(flymake-tests--assert-set flymake--disabled-backends
(#'crashing-backend)
(#'error-backend #'warning-backend #'sync-backend
#'panicking-backend #'refusing-backend))
(flymake-tests--assert-set (flymake-running-backends)
(error-backend warning-backend panicking-backend)
(crashing-backend))
(cl-loop repeat 10 while (flymake-is-running)
unless noninteractive do (read-event "" nil 0.1)
do (sleep-for (+ 0.5 flymake-no-changes-timeout)))
(flymake-tests--assert-set (flymake-disabled-backends)
(crashing-backend)
(error-backend warning-backend sync-backend
panicking-backend))
(should (eq flymake--running-backends '()))
(flymake-tests--wait-for-backends)
(flymake-tests--assert-set flymake--disabled-backends
(#'crashing-backend #'panicking-backend)
(#'error-backend #'warning-backend #'sync-backend
#'refusing-backend))
(flymake-tests--assert-set (flymake-disabled-backends)
(crashing-backend panicking-backend)
(error-backend warning-backend sync-backend))
(goto-char (point-min))
(flymake-goto-next-error)
@ -265,8 +266,55 @@ SEVERITY-PREDICATE is used to setup
(should (eq 'flymake-warning (face-at-point))) ; dolor
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point))) ; prognata
(let ((flymake-wrap-around nil))
(should-error (flymake-goto-next-error nil nil t)))))))
(should-error (flymake-goto-next-error nil nil t))))))
(ert-deftest recurrent-backend ()
"Test a backend that calls REPORT-FN multiple times"
(with-temp-buffer
(let (tick)
(cl-letf
(((symbol-function 'eager-backend)
(lambda (report-fn)
(funcall report-fn nil :explanation "very eager but no diagnostics")
(display-buffer (current-buffer))
(run-with-timer
0.5 nil
(lambda ()
(flymake-tests--diagnose-words report-fn :warning '("consectetur"))
(setq tick t)
(run-with-timer
0.5 nil
(lambda ()
(flymake-tests--diagnose-words report-fn :error '("fugiat"))
(setq tick t))))))))
(insert "Lorem ipsum dolor sit amet, consectetur adipiscing
elit, sed do eiusmod tempor incididunt ut labore et dolore
manha aliqua. Ut enim ad minim veniam, quis nostrud
exercitation ullamco laboris nisi ut aliquip ex ea commodo
consequat. Duis aute irure dolor in reprehenderit in
voluptate velit esse cillum dolore eu fugiat nulla
pariatur. Excepteur sint occaecat cupidatat non prognata
sunt in culpa qui officia deserunt mollit anim id est
laborum.")
(let ((flymake-diagnostic-functions
(list 'eager-backend))
(flymake-wrap-around nil))
(flymake-mode)
(flymake-tests--assert-set (flymake-running-backends)
(eager-backend) ())
(cl-loop until tick repeat 4 do (sleep-for 0.2))
(setq tick nil)
(goto-char (point-max))
(flymake-goto-prev-error)
(should (eq 'flymake-warning (face-at-point))) ; consectetur
(should-error (flymake-goto-prev-error nil nil t))
(cl-loop until tick repeat 4 do (sleep-for 0.2))
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point))) ; fugiat
(flymake-goto-prev-error)
(should (eq 'flymake-warning (face-at-point))) ; back at consectetur
(should-error (flymake-goto-prev-error nil nil t))
)))))
(provide 'flymake-tests)