code.delx.au - gnu-emacs-elpa/blob - packages/bug-hunter/bug-hunter.el

   1 ;;; bug-hunter.el --- Hunt down errors by bisecting elisp files  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
   6 ;; URL: https://github.com/Malabarba/elisp-bug-hunter
   7 ;; Version: 1.3.1
   8 ;; Keywords: lisp
   9 ;; Package-Requires: ((seq "1.3") (cl-lib "0.5"))
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25 ;; An Emacs library that finds the source of an error or unexpected
  26 ;; behavior inside an elisp configuration file (typically `init.el' or
  27 ;; `.emacs').
  28 ;;
  29 ;; Usage Examples
  30 ;; ==============
  31 ;;
  32 ;; Automated error hunting
  33 ;; ~~~~~~~~~~~~~~~~~~~~~~~
  34 ;;
  35 ;;   If your Emacs init file signals an error during startup, but you don’t
  36 ;;   know why, simply issue
  37 ;;   ,----
  38 ;;   | M-x bug-hunter-init-file RET e
  39 ;;   `----
  40 ;;   and The Bug Hunter will find it for you. Note that your `init.el' (or
  41 ;;   `.emacs') must be idempotent for this to work.
  42 ;;
  43 ;;
  44 ;; Interactive hunt
  45 ;; ~~~~~~~~~~~~~~~~
  46 ;;
  47 ;;   If Emacs starts up without errors but something is not working as it
  48 ;;   should, invoke the same command, but choose the interactive option:
  49 ;;   ,----
  50 ;;   | M-x bug-hunter-init-file RET i
  51 ;;   `----
  52 ;;   The Bug Hunter will start a separate Emacs instance several times, and
  53 ;;   then it will ask you each time whether that instance presented the
  54 ;;   problem you have. After doing this about 5--12 times, you’ll be given
  55 ;;   the results.
  56 ;;
  57 ;;
  58 ;; Assertion hunt
  59 ;; ~~~~~~~~~~~~~~
  60 ;;
  61 ;;   The Bug Hunter can also find your issue based on an assertion.
  62 ;;   Essentially, if you can write a code snippet that returns non-nil when
  63 ;;   it detects the issue, just provide this snippet as the assertion and
  64 ;;   the Bug Hunter will do the rest.
  65 ;;
  66 ;;   For example, let’s say there’s something in your init file that’s
  67 ;;   loading the `cl' library, and you don’t want that. You /know/ you’re
  68 ;;   not loading it yourself, but how can you figure out which external
  69 ;;   package is responsible for this outrage?
  70 ;;
  71 ;;   ,----
  72 ;;   | M-x bug-hunter-init-file RET a (featurep 'cl) RET
  73 ;;   `----
  74 ;;
  75 ;;   *That’s it!* You’ll be given a nice buffer reporting the results:
  76 ;;
  77 ;;   - Are you getting obscure errors when trying to open /".tex"/ files?
  78 ;;     - Don’t despair! Just use `(find-file "dummy.tex")' as the
  79 ;;       assertion.
  80 ;;   - Did `ox-html' stop working due to some arcane misconfiguration?
  81 ;;     - Just write an assertion that does an export and checks the result.
  82 ;;   - Does some random command suddenly bind itself to `C-j' and you can’t
  83 ;;     figure out why?
  84 ;;     - `(eq (key-binding "\n") 'unwanted-command)' is the assertion for
  85 ;;       you!
  86 ;;
  87 ;;   Finally, you can also use `bug-hunter-file' to hunt in other files.
  88 ;;
  89 ;;
  90 ;; init.org and other literate-style configs
  91 ;; =========================================
  92 ;;
  93 ;; Please see the full Readme on http://github.com/Malabarba/elisp-bug-hunter
  94 \f
  95 ;;; Code:
  96 (require 'seq)
  97 (require 'cl-lib)
  98
  99 (defconst bug-hunter--interactive-explanation
 100   "You have asked to do an interactive hunt, here's how it goes.
 101 1) I will start a new Emacs instance, which opens a new frame.
 102 2) You will try to reproduce your problem on the new frame.
 103 3) When you’re done, close that frame.
 104 4) I will ask you if you managed to reproduce the problem.
 105 5) We will repeat steps up to %s times, so hang tight!")
 106
 107 (defconst bug-hunter--assertion-reminder
 108   "Remember, the assertion must be an expression that returns
 109 non-nil in your current (problematic) Emacs state, AND that
 110 returns nil on a clean Emacs instance.
 111 If you're unsure how to write an assertion, you can try the interactive
 112 hunt instead, or see some examples in the Readme:
 113     https://github.com/Malabarba/elisp-bug-hunter"
 114   "Printed to the user if they provide a bad assertion.")
 115
 116 (defvar bug-hunter--current-head nil
 117   "Current list of expressions under scrutiny.  Used for user feedback.
 118 Used if the user aborts before bisection ends.")
 119
 120 (defvar bug-hunter--i 0
 121   "Current step of the bisection.  Used for user feedback.")
 122 (defvar bug-hunter--estimate 0
 123   "Estimate on how many steps the bisection can take.  Used for user feedback.
 124 This is the base 2 log of the number of expressions in the
 125 file.")
 126
 127 (defvar bug-hunter--current-file nil
 128   "File currently being debugged.")
 129
 130 (defun bug-hunter--read-buffer ()
 131   "Return all sexps after point as a list."
 132   (let (out line col)
 133     (or (condition-case er
 134             ;; Looks hacky, but comes from `byte-compile-from-buffer'.
 135             (while (progn (while (progn (skip-chars-forward " \t\n\^l")
 136                                         (looking-at ";"))
 137                             (forward-line 1))
 138                           (not (eobp)))
 139               (setq line (line-number-at-pos (point)))
 140               (setq col (current-column))
 141               (push (list (read (current-buffer)) line col)
 142                     out)
 143               nil)
 144           (end-of-file `(bug-caught (end-of-file) ,line ,col))
 145           (invalid-read-syntax `(bug-caught ,er ,line ,col))
 146           (error
 147            (if (string= (elt er 1) "Invalid modifier in string")
 148                `(bug-caught (invalid-modifier) ,line ,col)
 149              (error "Ran into an error we don't understand, please file a bug report: %S" er))))
 150         (nreverse out))))
 151
 152 (defun bug-hunter--read-contents (file)
 153   "Return all sexps in FILE as a list."
 154   (with-temp-buffer
 155     (insert-file-contents file)
 156     (goto-char (point-min))
 157     (bug-hunter--read-buffer)))
 158
 159 \f
 160 ;;; Reporting functions
 161 (defun bug-hunter--report-print (&rest r)
 162   "Print information on the \"*Bug-Hunter Report*\" buffer.
 163 R is passed to `format' and inserted."
 164   (with-current-buffer (get-buffer-create "*Bug-Hunter Report*")
 165     (goto-char (point-max))
 166     (let ((inhibit-read-only t))
 167       (insert "\n" (apply #'format r)))))
 168
 169 (defun bug-hunter--report (&rest r)
 170   "Report arbitrary information.
 171 R is passed to `bug-hunter--report-print'."
 172   (declare (indent 1))
 173   (apply #'bug-hunter--report-print r)
 174   (redisplay)
 175   (apply #'message r))
 176
 177 (defun bug-hunter--report-user-error (&rest r)
 178   "Report the user has done something wrong.
 179 R is passed to `bug-hunter--report-print'."
 180   (declare (indent 1))
 181   (apply #'bug-hunter--report-print r)
 182   (bug-hunter--report-print "\xc\n")
 183   (apply #'user-error r))
 184
 185 (defvar compilation-error-regexp-alist)
 186 (defun bug-hunter--init-report-buffer (assertion steps)
 187   "Create and prepare the \"*Bug-Hunter Report*\" buffer.
 188 Also add some descriptions depending on ASSERTION."
 189   (with-current-buffer (get-buffer-create "*Bug-Hunter Report*")
 190     (let ((inhibit-read-only t))
 191       (erase-buffer)
 192       (compilation-mode "Bug Hunt")
 193       (set (make-local-variable 'compilation-error-regexp-alist)
 194            '(comma))
 195       (pcase assertion
 196         (`interactive (insert (format bug-hunter--interactive-explanation (+ 2 steps))))))
 197     (current-buffer)))
 198
 199 (defun bug-hunter--pretty-format (value padding)
 200   "Return a VALUE as a string with PADDING spaces on the left."
 201   (with-temp-buffer
 202     (pp value (current-buffer))
 203     (goto-char (point-min))
 204     (let ((pad (make-string padding ?\s)))
 205       (while (not (eobp))
 206         (insert pad)
 207         (forward-line 1)))
 208     (buffer-string)))
 209
 210 (defun bug-hunter--report-error (error line column &optional expression)
 211   "Print on report buffer information about ERROR.
 212 LINE and COLUMN are the coordinates where EXPRESSION started in
 213 the file."
 214   (when line
 215     (bug-hunter--report "%S, line %s pos %s:"
 216       bug-hunter--current-file line column))
 217   (bug-hunter--report "  %s"
 218     (cl-case (car error)
 219       (end-of-file
 220        "There's a missing closing parenthesis, the expression on this line never ends.")
 221       (invalid-modifier (concat "There's a string on this line with an invalid modifier."
 222                                 "\n  A \"modifier\" is a \\ followed by a few characters."
 223                                 "\n  For example, \\C-; is an invalid modifier."))
 224       (invalid-read-syntax
 225        (let ((char (cadr error)))
 226          (if (member char '("]" ")"))
 227              (concat "There's an extra " char
 228                      " on this position. There's probably a missing "
 229                      (if (string= char ")") "(" "[")
 230                      " before that.")
 231            (concat "There's a " char
 232                    " on this position, and that is not valid elisp syntax."))))
 233       (user-aborted
 234        (let* ((print-level 2)
 235               (print-length 15)
 236               (forms (cadr error))
 237               (size (length forms)))
 238          (concat "User aborted while testing the following expressions:\n"
 239                  (mapconcat (lambda (x) (bug-hunter--pretty-format x 4))
 240                             (if (< size 16) forms (seq-take forms 7))
 241                             "")
 242                  (when (> size 16)
 243                    (format "\n    ... %s omitted expressions ...\n\n"
 244                            (- size 14)))
 245                  (when (> size 16)
 246                    (mapconcat (lambda (x) (bug-hunter--pretty-format x 4))
 247                               (seq-drop forms (- size 7)) "")))))
 248       (assertion-triggered
 249        (concat "The assertion returned the following value here:\n"
 250                (bug-hunter--pretty-format (cadr error) 4)))
 251       (t (format "The following error was signaled here:\n    %S"
 252                  error))))
 253   (when expression
 254     (bug-hunter--report "  Caused by the following expression:\n%s"
 255       (bug-hunter--pretty-format expression 4)))
 256   (bug-hunter--report "\xc\n")
 257   `[,error ,line ,column ,expression])
 258
 259 \f
 260 ;;; Execution functions
 261 (defun bug-hunter--print-to-temp (sexp)
 262   "Print SEXP to a temp file and return the file name."
 263   (let ((print-length nil)
 264         (print-level nil)
 265         (file (make-temp-file "bug-hunter")))
 266     (with-temp-file file
 267       (print sexp (current-buffer)))
 268     file))
 269
 270 (defun bug-hunter--run-emacs (file &rest args)
 271   "Start an Emacs process to run FILE and return the output buffer.
 272 ARGS are passed before \"-l FILE\"."
 273   (let ((out-buf (generate-new-buffer "*Bug-Hunter Command*"))
 274         (exec (file-truename (expand-file-name invocation-name
 275                                                invocation-directory))))
 276     (apply #'call-process exec nil out-buf nil
 277            (append args (list "-l" file)))
 278     out-buf))
 279
 280 (defun bug-hunter--run-form (form)
 281   "Run FORM with \"emacs -Q\" and return the result."
 282   (let ((file-name (bug-hunter--print-to-temp (list 'prin1 form))))
 283     (unwind-protect
 284         (with-current-buffer (bug-hunter--run-emacs file-name "-Q" "--batch")
 285           (goto-char (point-max))
 286           (forward-sexp -1)
 287           (prog1 (read (current-buffer))
 288             (kill-buffer (current-buffer))))
 289       (delete-file file-name))))
 290
 291 (defun bug-hunter--run-form-interactively (form)
 292   "Run FORM in a graphical instance and ask user about the outcome."
 293   (let ((file-name (bug-hunter--print-to-temp (list 'prin1 form))))
 294     (unwind-protect
 295         (bug-hunter--run-emacs file-name "-Q")
 296       (delete-file file-name))
 297     (y-or-n-p "Did you find the problem/bug in this instance (if you encounter some other issue, answer `n')? ")))
 298
 299 (defun bug-hunter--wrap-forms-for-eval (forms)
 300   "Return FORMS wrapped in initialization code."
 301   `(let ((server-name (make-temp-file "bug-hunter-temp-server-file")))
 302      (delete-file server-name)
 303      (if site-run-file (load site-run-file t t))
 304      (run-hooks 'before-init-hook)
 305      ,@forms
 306      (package-initialize)
 307      (run-hooks 'after-init-hook)))
 308
 309 (defun bug-hunter--run-and-test (forms assertion)
 310   "Execute FORMS in the background and test ASSERTION.
 311 See `bug-hunter' for a description on the ASSERTION.
 312
 313 If ASSERTION is `interactive', the form is run through
 314 `bug-hunter--run-form-interactively'.  Otherwise, a slightly
 315 modified version of the form combined with ASSERTION is run
 316 through `bug-hunter--run-form'."
 317   (if (eq assertion 'interactive)
 318       (bug-hunter--run-form-interactively
 319        (bug-hunter--wrap-forms-for-eval forms))
 320     (bug-hunter--run-form
 321      `(condition-case er
 322           ,(append (bug-hunter--wrap-forms-for-eval forms)
 323                    (list assertion))
 324         (error (cons 'bug-caught er))))))
 325
 326
 327 \f
 328 ;;; The actual bisection
 329 (defun bug-hunter--split (l)
 330   "Split list L in two lists of same size."
 331   (seq-partition l (ceiling (/ (length l) 2.0))))
 332
 333 (defun bug-hunter--bisect (assertion safe head &optional tail)
 334   "Implementation used by `bug-hunter--bisect-start'.
 335 ASSERTION is received by `bug-hunter--bisect-start'.
 336 SAFE is a list of forms confirmed to not match the ASSERTION,
 337 HEAD is a list of forms to be tested now, and TAIL is a list
 338 which will be inspected if HEAD doesn't match ASSERTION."
 339   (message "Testing: %s/%s" (cl-incf bug-hunter--i) bug-hunter--estimate)
 340   ;; Used if the user quits.
 341   (setq bug-hunter--current-head head)
 342   (let ((ret-val (bug-hunter--run-and-test (append safe head) assertion)))
 343     (cond
 344      ((not tail)
 345       (cl-assert ret-val nil)
 346       (vector (length safe) ret-val))
 347      ;; Issue in the head.
 348      ((and ret-val (< (length head) 2))
 349       (vector (length safe) ret-val))
 350      (ret-val
 351       (apply #'bug-hunter--bisect
 352              assertion
 353              safe
 354              (bug-hunter--split head)))
 355      ;; Issue in the tail.
 356      (t (apply #'bug-hunter--bisect
 357                assertion
 358                (append safe head)
 359                ;; If tail has length 1, we already know where the issue is,
 360                ;; but we still do this to get the return value.
 361                (bug-hunter--split tail))))))
 362
 363 (defun bug-hunter--bisect-start (forms assertion)
 364   "Run a bisection search on list of FORMS using ASSERTION.
 365 Returns a vector [n value], where n is the position of the first
 366 element in FORMS which trigger ASSERTION, and value is the
 367 ASSERTION's return value.
 368
 369 If ASSERTION is nil, n is the position of the first form to
 370 signal an error and value is (bug-caught . ERROR-SIGNALED)."
 371   (let ((bug-hunter--i 0)
 372         (bug-hunter--current-head nil))
 373     (condition-case-unless-debug nil
 374         (apply #'bug-hunter--bisect assertion nil (bug-hunter--split forms))
 375       (quit `[nil (bug-caught user-aborted ,bug-hunter--current-head)]))))
 376
 377 \f
 378 ;;; Main functions
 379 (defun bug-hunter-hunt (rich-forms assertion)
 380   "Bisect RICH-FORMS using ASSERTION.
 381 RICH-FORMS is a list with elements of the form: (EXPR LINE COL)
 382     EXPR is an elisp expression.  LINE and COL are the coordinates
 383     in `bug-hunter--current-file' where the expression starts.
 384 It is expected that one of EXPR is either throwing an error or
 385 causing some undesirable effect (which triggers ASSERTION).
 386
 387 ASSERTION is either nil or an expression.
 388     If nil, EXPRs are bisected until we find the first one that
 389     throws errors.
 390     If it is an expression, EXPRs are bisected by testing
 391     ASSERTION.  It should return nil if all is fine (e.g. if used
 392     with \"emacs -Q\"), and should return non-nil when a problem
 393     is detected.
 394
 395 Bug hunter will refuse to hunt if (i) an error is signaled or the
 396 assertion is triggered while running emacs -Q, or (ii) no errors
 397 are signaled and the assertion is not triggered after all EXPRs
 398 are evaluated."
 399   (let ((expressions (unless (eq (car-safe rich-forms) 'bug-caught)
 400                        (mapcar #'car rich-forms)))
 401         (bug-hunter--estimate (ceiling (log (length rich-forms) 2))))
 402     ;; Prepare buffer, and make sure they've seen it.
 403     (switch-to-buffer (bug-hunter--init-report-buffer assertion bug-hunter--estimate))
 404     (when (eq assertion 'interactive)
 405       (read-char-choice "Please read the instructions above and type 6 when ready. " '(?6)))
 406
 407     (cond
 408      ;; Check for errors when reading the init file.
 409      ((not expressions)
 410       (apply #'bug-hunter--report-error (cdr rich-forms))
 411       (apply #'vector (cdr rich-forms)))
 412
 413      ;; Make sure there's a bug to hunt.
 414      ((progn (bug-hunter--report "Doing some initial tests...")
 415              (not (bug-hunter--run-and-test expressions assertion)))
 416       (bug-hunter--report-user-error "Test failed.\n%s\n%s"
 417         (if assertion
 418             (concat "The assertion returned nil after loading the entire file.\n"
 419                     bug-hunter--assertion-reminder)
 420           "No errors signaled after loading the entire file.
 421 If you're looking for something that's not an error, use the
 422 interactive hunt instead of the error hunt.  If you have some
 423 elisp proficiency, you can also use the assertion hunt, see this
 424 link for some examples:
 425     https://github.com/Malabarba/elisp-bug-hunter")
 426         (or assertion "")))
 427
 428      ;; Make sure we're in a forest, not a volcano.
 429      ((bug-hunter--run-and-test nil assertion)
 430       (bug-hunter--report-user-error "Test failed.\n%s\n%s"
 431         (if assertion
 432             (concat "Assertion returned non-nil even on emacs -Q:"
 433                     bug-hunter--assertion-reminder)
 434           "Detected a signaled error even on emacs -Q. This could mean three
 435 things things:
 436 1. The problem happens inside `package-initialize'.
 437 2. You wrote the assertion wrong.
 438 3. There's something seriously wrong with your Emacs installation.")
 439         (or assertion "")))
 440
 441      (t
 442       ;; Perform the actual hunt.
 443       (bug-hunter--report "Initial tests done. Hunting for the cause...")
 444       (let* ((result (bug-hunter--bisect-start expressions assertion)))
 445         (if (not result)
 446             (bug-hunter--report-user-error "No problem was found, despite our initial tests.\n%s"
 447               "I have no idea what's going on.")
 448           (let* ((pos (elt result 0))
 449                  (ret (elt result 1))
 450                  (linecol (when pos (cdr (elt rich-forms pos))))
 451                  (expression (when pos (elt expressions pos))))
 452             (if (eq (car-safe ret) 'bug-caught)
 453                 (bug-hunter--report-error
 454                  (cdr ret) (car linecol) (cadr linecol) expression)
 455               (bug-hunter--report-error
 456                (list 'assertion-triggered ret)
 457                (car linecol) (cadr linecol) expression)))))))))
 458
 459 (defconst bug-hunter--hunt-type-prompt
 460   "To bisect interactively, type i
 461 To use automatic error detection, type e
 462 To provide a lisp assertion, type a
 463 => ")
 464
 465 (defun bug-hunter--read-from-minibuffer ()
 466   "Read a list of expressions from the minibuffer.
 467 Wraps them in a progn if necessary to always return a single
 468 form.
 469
 470 The user may decide to not provide input, in which case
 471 `interactive' is returned.  Note, this is different from the user
 472 typing RET at an empty prompt, in which case nil is returned."
 473   (pcase (read-char-choice (if (display-graphic-p)
 474                                bug-hunter--hunt-type-prompt
 475                              (replace-regexp-in-string "To bisect interactively,.*\n" ""
 476                                                        bug-hunter--hunt-type-prompt))
 477                            '(?i ?e ?a))
 478     (`?i
 479      (unless (display-graphic-p)
 480        (user-error "Sorry, but `interactive' bisection needs a graphical frame"))
 481      'interactive)
 482     (`?e nil)
 483     (_
 484      (require 'simple)
 485      (let ((exprs
 486             (with-temp-buffer
 487               ;; Copied from `read--expression'.
 488               (let ((minibuffer-completing-symbol t))
 489                 (minibuffer-with-setup-hook
 490                     (lambda ()
 491                       (add-hook 'completion-at-point-functions
 492                                 (if (fboundp 'elisp-completion-at-point)
 493                                     #'elisp-completion-at-point
 494                                   (with-no-warnings
 495                                     #'lisp-completion-at-point))
 496                                 nil t)
 497                       (run-hooks 'eval-expression-minibuffer-setup-hook))
 498                   (insert
 499                    (read-from-minibuffer
 500                     "Provide an assertion.  This is a lisp expression that returns nil if (and only if) everything is fine:\n => "
 501                     nil read-expression-map nil 'read-expression-history))))
 502               (goto-char (point-min))
 503               (mapcar #'car (bug-hunter--read-buffer)))))
 504        (if (cdr exprs)
 505            (cons #'progn exprs)
 506          (car exprs))))))
 507
 508 ;;;###autoload
 509 (defun bug-hunter-file (file &optional assertion)
 510   "Bisect FILE while testing ASSERTION.
 511 All sexps in FILE are read and passed to `bug-hunter-hunt' as a
 512 list.  See `bug-hunter-hunt' for how to use ASSERTION."
 513   (interactive
 514    (list
 515     (read-file-name "File to bisect: "
 516                     (file-name-directory (or (buffer-file-name) "./"))
 517                     nil t
 518                     (file-name-nondirectory (or (buffer-file-name) "./")))
 519     (bug-hunter--read-from-minibuffer)))
 520   (let ((bug-hunter--current-file file))
 521     (bug-hunter-hunt (bug-hunter--read-contents file) assertion)))
 522
 523 ;;;###autoload
 524 (defun bug-hunter-init-file (&optional assertion)
 525   "Test ASSERTION throughout `user-init-file'.
 526 All sexps inside `user-init-file' are read and passed to
 527 `bug-hunter-hunt' as a list.  See `bug-hunter-hunt' for how to use
 528 ASSERTION."
 529   (interactive (list (bug-hunter--read-from-minibuffer)))
 530   (bug-hunter-file user-init-file assertion))
 531
 532 (provide 'bug-hunter)
 533 ;;; bug-hunter.el ends here