search

lastquestion / explain-pause-mode

top, but for Emacs.
GNU General Public License v3.0
241 stars 6 forks source link

explain-pause-top breaks notmuch thread view (root cause: `:stderr` option of `make-process` when given a BUFFER does not work) #64

Closed apmanol closed 4 years ago

apmanol commented 4 years ago

With explain-pause-top the threads in notmuch are not accessible.

This is the error in Messages or: Wrong type argument: explain-pause-command-record, nil

yantar92 commented 4 years ago

I am using notmuch and explain-pause-top. I have never seen such error. You should probably provide a more accurate recepy to replicate the issue. Ideally, starting from emacs -Q.

apmanol commented 4 years ago

Sure how can I provide a more detailed report? The threads appear like that:

(:thread "00000000000187d9" :timestamp 1594036110 :date_relative "13 mins. ago" :matched 1 :total 7 :authors

GNU Emacs 27.0.91 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.13, cairo version 1.16.0) of 2020-06-22

apmanol commented 4 years ago

And debug-on-error stack trace:

Debugger entered--Lisp error: (wrong-type-argument explain-pause-command-record nil)
  signal(wrong-type-argument (explain-pause-command-record nil))
  (or (and (memq (type-of current-command) cl-struct-explain-pause-command-record-tags) t) (signal 'wrong-type-argument (list 'explain-pause-command-record current-command)))
  (progn (or (and (memq (type-of current-command) cl-struct-explain-pause-command-record-tags) t) (signal 'wrong-type-argument (list 'explain-pause-command-record current-command))) (aref current-command 8))
  (record 'explain-pause-command-record command native parent 0 nil nil nil (progn (or (and (memq (type-of current-command) cl-struct-explain-pause-command-record-tags) t) (signal 'wrong-type-argument (list 'explain-pause-command-record current-command))) (aref current-command 8)) nil (1+ (progn (or (and (memq (type-of parent) cl-struct-explain-pause-command-record-tags) t) (signal 'wrong-type-argument (list 'explain-pause-command-record parent))) (aref parent 10))))
  explain-pause--command-record-from-parent(nil nil process-sentinel)
  (explain-pause--generate-wrapper (explain-pause--command-record-from-parent process-frame process-frame 'process-sentinel) original-callback)
  (list arg-process (explain-pause--generate-wrapper (explain-pause--command-record-from-parent process-frame process-frame 'process-sentinel) original-callback))
  (apply orig (list arg-process (explain-pause--generate-wrapper (explain-pause--command-record-from-parent process-frame process-frame 'process-sentinel) original-callback)))
  (let* ((process-frame (process-get arg-process 'explain-pause-process-frame)) (result (apply orig (list arg-process (explain-pause--generate-wrapper (explain-pause--command-record-from-parent process-frame process-frame 'process-sentinel) original-callback))))) (process-put arg-process 'explain-pause-original-sentinel original-callback) result)
  (if (not original-callback) (let ((result (apply orig args))) (process-put arg-process 'explain-pause-original-sentinel nil) result) (let* ((process-frame (process-get arg-process 'explain-pause-process-frame)) (result (apply orig (list arg-process (explain-pause--generate-wrapper (explain-pause--command-record-from-parent process-frame process-frame ...) original-callback))))) (process-put arg-process 'explain-pause-original-sentinel original-callback) result))
  (let ((arg-process x49) (original-callback x48)) (if (not original-callback) (let ((result (apply orig args))) (process-put arg-process 'explain-pause-original-sentinel nil) result) (let* ((process-frame (process-get arg-process 'explain-pause-process-frame)) (result (apply orig (list arg-process (explain-pause--generate-wrapper ... original-callback))))) (process-put arg-process 'explain-pause-original-sentinel original-callback) result)))
  (let* ((x48 (seq--elt-safe args 1)) (x49 (seq--elt-safe args 0))) (let ((arg-process x49) (original-callback x48)) (if (not original-callback) (let ((result (apply orig args))) (process-put arg-process 'explain-pause-original-sentinel nil) result) (let* ((process-frame (process-get arg-process 'explain-pause-process-frame)) (result (apply orig (list arg-process ...)))) (process-put arg-process 'explain-pause-original-sentinel original-callback) result))))
  explain-pause--wrap-set-process-sentinel-callback(#<subr set-process-sentinel> #<process notmuch-search stderr> notmuch-start-notmuch-error-sentinel)
  apply(explain-pause--wrap-set-process-sentinel-callback #<subr set-process-sentinel> (#<process notmuch-search stderr> notmuch-start-notmuch-error-sentinel))
  set-process-sentinel(#<process notmuch-search stderr> notmuch-start-notmuch-error-sentinel)
  notmuch-start-notmuch("notmuch-search" #<buffer *notmuch-saved-search-today,no-list*> notmuch-search-process-sentinel "search" "--format=sexp" "--format-version=4" "--sort=oldest-first" "date:today and not tag:list")
  notmuch-search("date:today and not tag:list" t nil 8 t)
  notmuch-search-refresh-view()
  #<subr funcall-interactively>(notmuch-search-refresh-view)
  apply(#<subr funcall-interactively> notmuch-search-refresh-view)
  funcall-interactively(notmuch-search-refresh-view)
  #<subr call-interactively>(notmuch-search-refresh-view)
  apply(#<subr call-interactively> notmuch-search-refresh-view)
  (unwind-protect (apply original-func args) (let ((top-frame explain-pause--current-command-record)) (if extra-frame (cond ((and (eq (progn ... ...) target-function) (eq (progn ... ...) command-frame)) (explain-pause--command-record-and-store top-frame) (if (progn (or ... ...) (aref top-frame 7)) (progn (explain-pause--command-record--save-and-stop-profiling top-frame))) (explain-pause-log--send-command-exit top-frame) (explain-pause--run-measure-hook top-frame) (explain-pause-log--send-command-exit command-frame) (explain-pause--run-measure-hook command-frame)) ((eq top-frame command-frame) (explain-pause--command-record-and-store top-frame) (explain-pause-log--send-command-exit top-frame) (explain-pause--run-measure-hook top-frame)) (t (explain-pause-report-measuring-bug "call-interactively extra-frame" top-frame target-function))) (if (not (eq top-frame command-frame)) (explain-pause-report-measuring-bug "call interactively" top-frame command-frame) (explain-pause--command-record-and-store command-frame) (if (progn (or (and ... t) (signal ... ...)) (aref command-frame 7)) (progn (explain-pause--command-record--save-and-stop-profiling command-frame))) (explain-pause-log--send-command-exit command-frame) (explain-pause--run-measure-hook command-frame)))) (if (eq parent explain-pause-root-command-loop) nil (progn (or (and (memq (type-of parent) cl-struct-explain-pause-command-record-tags) t) (signal 'wrong-type-argument (list 'explain-pause-command-record parent))) (let* ((v parent)) (aset v 5 (current-time))))) (setq explain-pause--current-command-record parent))
  (let ((parent explain-pause--current-command-record) (target-function (car args)) (command-frame nil) (extra-frame nil)) (if (eq parent explain-pause-root-command-loop) nil (explain-pause--command-record-and-store parent)) (if (or (eq target-function #'self-insert-command) (eq target-function #'newline) (eq target-function #'next-line) (eq target-function #'previous-line) (eq target-function #'delete-forward-char)) nil (let ((i-spec (car (cdr (interactive-form target-function))))) (if (and (stringp i-spec) (explain-pause--interactive-form-needs-frame-p i-spec)) (progn (setq command-frame (explain-pause--command-record-from-parent parent parent 'call-interactively-interactive t)) (setq extra-frame t))))) (if extra-frame nil (setq command-frame (explain-pause--command-record-from-parent parent parent target-function))) (explain-pause-log--send-command-entry parent command-frame) (setq explain-pause--current-command-record command-frame) (progn (or (and (memq (type-of command-frame) cl-struct-explain-pause-command-record-tags) t) (signal 'wrong-type-argument (list 'explain-pause-command-record command-frame))) (let* ((v command-frame)) (aset v 5 (current-time)))) (if (and (not extra-frame) (explain-pause--command-record-profile-p command-frame)) (progn (explain-pause--command-record-start-profiling command-frame))) (unwind-protect (apply original-func args) (let ((top-frame explain-pause--current-command-record)) (if extra-frame (cond ((and (eq ... target-function) (eq ... command-frame)) (explain-pause--command-record-and-store top-frame) (if (progn ... ...) (progn ...)) (explain-pause-log--send-command-exit top-frame) (explain-pause--run-measure-hook top-frame) (explain-pause-log--send-command-exit command-frame) (explain-pause--run-measure-hook command-frame)) ((eq top-frame command-frame) (explain-pause--command-record-and-store top-frame) (explain-pause-log--send-command-exit top-frame) (explain-pause--run-measure-hook top-frame)) (t (explain-pause-report-measuring-bug "call-interactively extra-frame" top-frame target-function))) (if (not (eq top-frame command-frame)) (explain-pause-report-measuring-bug "call interactively" top-frame command-frame) (explain-pause--command-record-and-store command-frame) (if (progn (or ... ...) (aref command-frame 7)) (progn (explain-pause--command-record--save-and-stop-profiling command-frame))) (explain-pause-log--send-command-exit command-frame) (explain-pause--run-measure-hook command-frame)))) (if (eq parent explain-pause-root-command-loop) nil (progn (or (and (memq (type-of parent) cl-struct-explain-pause-command-record-tags) t) (signal 'wrong-type-argument (list 'explain-pause-command-record parent))) (let* ((v parent)) (aset v 5 (current-time))))) (setq explain-pause--current-command-record parent)))
  explain-pause--wrap-call-interactively(#<subr call-interactively> notmuch-search-refresh-view)
  apply(explain-pause--wrap-call-interactively #<subr call-interactively> notmuch-search-refresh-view)
  call-interactively(notmuch-search-refresh-view)
  notmuch-refresh-this-buffer()
  #<subr funcall-interactively>(notmuch-refresh-this-buffer)
  apply(#<subr funcall-interactively> notmuch-refresh-this-buffer)
  funcall-interactively(notmuch-refresh-this-buffer)
  #<subr call-interactively>(notmuch-refresh-this-buffer nil nil)
  apply(#<subr call-interactively> (notmuch-refresh-this-buffer nil nil))
  (unwind-protect (apply original-func args) (let ((top-frame explain-pause--current-command-record)) (if extra-frame (cond ((and (eq (progn ... ...) target-function) (eq (progn ... ...) command-frame)) (explain-pause--command-record-and-store top-frame) (if (progn (or ... ...) (aref top-frame 7)) (progn (explain-pause--command-record--save-and-stop-profiling top-frame))) (explain-pause-log--send-command-exit top-frame) (explain-pause--run-measure-hook top-frame) (explain-pause-log--send-command-exit command-frame) (explain-pause--run-measure-hook command-frame)) ((eq top-frame command-frame) (explain-pause--command-record-and-store top-frame) (explain-pause-log--send-command-exit top-frame) (explain-pause--run-measure-hook top-frame)) (t (explain-pause-report-measuring-bug "call-interactively extra-frame" top-frame target-function))) (if (not (eq top-frame command-frame)) (explain-pause-report-measuring-bug "call interactively" top-frame command-frame) (explain-pause--command-record-and-store command-frame) (if (progn (or (and ... t) (signal ... ...)) (aref command-frame 7)) (progn (explain-pause--command-record--save-and-stop-profiling command-frame))) (explain-pause-log--send-command-exit command-frame) (explain-pause--run-measure-hook command-frame)))) (if (eq parent explain-pause-root-command-loop) nil (progn (or (and (memq (type-of parent) cl-struct-explain-pause-command-record-tags) t) (signal 'wrong-type-argument (list 'explain-pause-command-record parent))) (let* ((v parent)) (aset v 5 (current-time))))) (setq explain-pause--current-command-record parent))
  (let ((parent explain-pause--current-command-record) (target-function (car args)) (command-frame nil) (extra-frame nil)) (if (eq parent explain-pause-root-command-loop) nil (explain-pause--command-record-and-store parent)) (if (or (eq target-function #'self-insert-command) (eq target-function #'newline) (eq target-function #'next-line) (eq target-function #'previous-line) (eq target-function #'delete-forward-char)) nil (let ((i-spec (car (cdr (interactive-form target-function))))) (if (and (stringp i-spec) (explain-pause--interactive-form-needs-frame-p i-spec)) (progn (setq command-frame (explain-pause--command-record-from-parent parent parent 'call-interactively-interactive t)) (setq extra-frame t))))) (if extra-frame nil (setq command-frame (explain-pause--command-record-from-parent parent parent target-function))) (explain-pause-log--send-command-entry parent command-frame) (setq explain-pause--current-command-record command-frame) (progn (or (and (memq (type-of command-frame) cl-struct-explain-pause-command-record-tags) t) (signal 'wrong-type-argument (list 'explain-pause-command-record command-frame))) (let* ((v command-frame)) (aset v 5 (current-time)))) (if (and (not extra-frame) (explain-pause--command-record-profile-p command-frame)) (progn (explain-pause--command-record-start-profiling command-frame))) (unwind-protect (apply original-func args) (let ((top-frame explain-pause--current-command-record)) (if extra-frame (cond ((and (eq ... target-function) (eq ... command-frame)) (explain-pause--command-record-and-store top-frame) (if (progn ... ...) (progn ...)) (explain-pause-log--send-command-exit top-frame) (explain-pause--run-measure-hook top-frame) (explain-pause-log--send-command-exit command-frame) (explain-pause--run-measure-hook command-frame)) ((eq top-frame command-frame) (explain-pause--command-record-and-store top-frame) (explain-pause-log--send-command-exit top-frame) (explain-pause--run-measure-hook top-frame)) (t (explain-pause-report-measuring-bug "call-interactively extra-frame" top-frame target-function))) (if (not (eq top-frame command-frame)) (explain-pause-report-measuring-bug "call interactively" top-frame command-frame) (explain-pause--command-record-and-store command-frame) (if (progn (or ... ...) (aref command-frame 7)) (progn (explain-pause--command-record--save-and-stop-profiling command-frame))) (explain-pause-log--send-command-exit command-frame) (explain-pause--run-measure-hook command-frame)))) (if (eq parent explain-pause-root-command-loop) nil (progn (or (and (memq (type-of parent) cl-struct-explain-pause-command-record-tags) t) (signal 'wrong-type-argument (list 'explain-pause-command-record parent))) (let* ((v parent)) (aset v 5 (current-time))))) (setq explain-pause--current-command-record parent)))
  explain-pause--wrap-call-interactively(#<subr call-interactively> notmuch-refresh-this-buffer nil nil)
  apply(explain-pause--wrap-call-interactively #<subr call-interactively> (notmuch-refresh-this-buffer nil nil))
  call-interactively(notmuch-refresh-this-buffer nil nil)
  command-execute(notmuch-refresh-this-buffer)
lastquestion commented 4 years ago

Hi, thanks so much for taking the time to get on github and report a bug!

What happened here is that explain-pause-mode assumes all processes have been hooked by it, so it can see how much time the process filters and sentinels spend, but somehow this particular process was not hooked, and thus died.

This should "never happen", of course. 😭

Luckily the callstack gave me sufficient details to repro this! Looks like it seems you did this:

Luckily I found the notmuch source code, https://github.com/notmuch/notmuch/blob/master/emacs/notmuch-lib.el#L925-L936.

Reduced repro is:

 (setq err-buffer (generate-new-buffer " *notmuch-stderr*"))
#<buffer  *notmuch-stderr*>

(setq proc (make-process
            :name "test"
            :buffer "testbuff"
            :command '("cat")
            :connection-type 'pipe
            :stderr err-buffer)
      err-proc (get-buffer-process err-buffer))
#<process test stderr>

(defun my-func () t)
my-func

;; crashes
(set-process-sentinel err-proc 'my-func)
lastquestion commented 4 years ago

The docs say that stderr is supposed to be a PROCESS:

:stderr stderr Associate stderr with the standard error of the process. A non-nil value should be either a buffer or a pipe process created with make-pipe-process, described below.

But notmuch is directly giving a new buffer created normally via generate-new-buffer, which is unexpected.

lastquestion commented 4 years ago

Oh, it's because I read the english wrong. the OR means either a buffer OR a pipe process. In fact, the english improved, because on emacs HEAD it says

:stderr STDERR -- STDERR is either a buffer or a pipe process attached
to the standard error of subprocess.  Specifying this implies
‘:connection-type’ is set to ‘pipe’.

which is way more readable.

lastquestion commented 4 years ago

make_pipe_process is called directly in C code here https://github.com/emacs-mirror/emacs/blob/master/src/process.c#L1746-L1756 when the stderr is not a process

and then it is set here https://github.com/emacs-mirror/emacs/blob/master/src/process.c#L1788

Change the filter for make-process to check whether stderr is a process or not, and if not, wait for make-process to finish and then get the buffer via Fget_buffer_create and then pull the process from that via get-buffer-process, just like notmuch does, and then advise that stderr process before returning control back to user code.

lastquestion commented 4 years ago

After a nice breakfast, I have a fix ^. I'll want to re-read and review it again later today before merging it, but this should fix the bug @apmanol 💯

apmanol commented 4 years ago

Thanks a lot for fixing the bug and the nice problem analysis.