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

   1 ;;; bug-hunter.el --- Hunt down errors in elisp files  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
   6 ;; URL: http://github.com/Malabarba/elisp-bug-hunter
   7 ;; Version: 0.2
   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 ;;
  26 ;; The Bug Hunter is an Emacs library that finds the source of an error or
  27 ;; unexpected behavior inside an elisp configuration file (typically
  28 ;; `init.el' or `.emacs').
  29 ;;
  30 ;; Usage Examples
  31 ;; ==============
  32 ;;
  33 ;;   If your Emacs init file signals an error during startup, but you don’t
  34 ;;   know why, simply issue
  35 ;;   ,----
  36 ;;   | M-x bug-hunter-init-file RET RET
  37 ;;   `----
  38 ;;   and The Bug Hunter will find it for you. Note that your `init.el' (or
  39 ;;   `.emacs') must be idempotent for this to work.
  40 ;;
  41 ;;   If Emacs starts up without errors but something is not working as it
  42 ;;   should, invoke the same command, but give it in an assertion.
  43 ;;   Essentially, if you can write a snippet that detects the issue and
  44 ;;   returns non-nil, just provide this snippet as the assertion and the
  45 ;;   Bug Hunter will do a bisection search for you.
  46 ;;
  47 ;;   For example, let’s say there’s something in your init file that’s
  48 ;;   loading the `cl' library, and you don’t want that. You /know/ you’re
  49 ;;   not loading it yourself, but how can you figure out which external
  50 ;;   package is responsible for this outrage?
  51 ;;
  52 ;;   ,----
  53 ;;   | M-x bug-hunter-init-file RET (featurep 'cl) RET
  54 ;;   `----
  55 ;;
  56 ;;   *That’s it!* You’ll be given a nice buffer reporting the results:
  57 ;;
  58 ;;   - Are you getting obscure errors when trying to open /“.tex”/ files?
  59 ;;     - Don’t despair! Just use `(find-file "dummy.tex")' as the
  60 ;;       assertion.
  61 ;;   - Did `ox-html' stop working due to some arcane misconfiguration?
  62 ;;     - Just write an assertion that does an export and checks the result.
  63 ;;   - Does some random command suddenly bind itself to `C-j' and you can’t
  64 ;;     figure out why?
  65 ;;     - `(eq (key-binding "\n") 'unwanted-command)' is the assertion for
  66 ;;       you!
  67 ;;
  68 ;;   Finally, you can also use `bug-hunter-file' to hunt in other files.
  69
  70 \f
  71 ;;; Code:
  72 (require 'seq)
  73 (require 'cl-lib)
  74
  75 (defvar bug-hunter--assertion-reminder
  76   "Remember, the assertion must be an expression that returns
  77 non-nil in your current (problematic) Emacs state, AND that
  78 returns nil on a clean Emacs instance."
  79   "Printed to the user if they provide a bad assertion.")
  80
  81 (defvar bug-hunter--current-head nil
  82   "Current list of expressions under scrutiny.  Used for user feedback.
  83 Used if the user aborts before bisection ends.")
  84
  85 (defvar bug-hunter--i 0
  86   "Current step of the bisection.  Used for user feedback.")
  87 (defvar bug-hunter--estimate 0
  88   "Estimate on how many steps the bisection can take.  Used for user feedback.
  89 This is the base 2 log of the number of expressions in the
  90 file.")
  91
  92 (defvar bug-hunter--current-file nil
  93   "File currently being debugged.")
  94
  95 (defun bug-hunter--read-buffer ()
  96   "Return all sexps after point as a list."
  97   (let (out line col)
  98     (or (condition-case er
  99             ;; Looks hacky, but comes from `byte-compile-from-buffer'.
 100             (while (progn (while (progn (skip-chars-forward " \t\n\^l")
 101                                         (looking-at ";"))
 102                             (forward-line 1))
 103                           (not (eobp)))
 104               (setq line (line-number-at-pos (point)))
 105               (setq col (current-column))
 106               (push (list (read (current-buffer)) line col)
 107                     out)
 108               nil)
 109           (end-of-file `(bug-caught (end-of-file) ,line ,col))
 110           (invalid-read-syntax `(bug-caught ,er ,line ,col))
 111           (error (error "Ran into an error we don't understand, please file a bug report: %S" er)))
 112         (nreverse out))))
 113
 114 (defun bug-hunter--read-contents (file)
 115   "Return all sexps in FILE as a list."
 116   (with-temp-buffer
 117     (insert-file-contents file)
 118     (goto-char (point-min))
 119     (bug-hunter--read-buffer)))
 120
 121 \f
 122 ;;; Reporting functions
 123 (defun bug-hunter--report-print (&rest r)
 124   "Print information on the \"*Bug-Hunter Report*\" buffer.
 125 R is passed to `format' and inserted."
 126   (with-current-buffer (get-buffer-create "*Bug-Hunter Report*")
 127     (goto-char (point-max))
 128     (let ((inhibit-read-only t))
 129       (insert "\n" (apply #'format r)))))
 130
 131 (defun bug-hunter--report (&rest r)
 132   "Report arbitrary information.
 133 R is passed to `bug-hunter--report-print'."
 134   (declare (indent 1))
 135   (apply #'bug-hunter--report-print r)
 136   (apply #'message r))
 137
 138 (defun bug-hunter--report-user-error (&rest r)
 139   "Report the user has done something wrong.
 140 R is passed to `bug-hunter--report-print'."
 141   (declare (indent 1))
 142   (apply #'bug-hunter--report-print r)
 143   (bug-hunter--report-print "\xc")
 144   (apply #'user-error r))
 145
 146 (defvar compilation-error-regexp-alist)
 147 (defun bug-hunter--init-report-buffer ()
 148   "Create and prepare the \"*Bug-Hunter Report*\" buffer."
 149   (or (get-buffer "*Bug-Hunter Report*")
 150       (with-current-buffer (get-buffer-create "*Bug-Hunter Report*")
 151         (compilation-mode "Bug Hunt")
 152         (set (make-local-variable 'compilation-error-regexp-alist)
 153              '(comma))
 154         (current-buffer))))
 155
 156 (defun bug-hunter--pretty-format (value padding)
 157   "Return a VALUE as a string with PADDING spaces on the left."
 158   (with-temp-buffer
 159     (pp value (current-buffer))
 160     (goto-char (point-min))
 161     (let ((pad (make-string padding ?\s)))
 162       (while (not (eobp))
 163         (insert pad)
 164         (forward-line 1)))
 165     (buffer-string)))
 166
 167 (defun bug-hunter--report-error (error line column &optional expression)
 168   "Print on report buffer information about ERROR.
 169 LINE and COLUMN are the coordinates where EXPRESSION started in
 170 the file."
 171   (when line
 172     (bug-hunter--report "%S, line %s pos %s:"
 173       bug-hunter--current-file line column))
 174   (bug-hunter--report "  %s"
 175     (cl-case (car error)
 176       (end-of-file
 177        "There's a missing closing parenthesis, the expression on this line never ends.")
 178       (invalid-read-syntax
 179        (let ((char (cadr error)))
 180          (if (member char '("]" ")"))
 181              (concat "There's an extra " char
 182                      " on this position. There's probably a missing "
 183                      (if (string= char ")") "(" "[")
 184                      " before that.")
 185            (concat "There's a " char
 186                    " on this position, and that is not valid elisp syntax."))))
 187       (user-aborted
 188        (let* ((print-level 2)
 189               (print-length 15)
 190               (forms (cadr error))
 191               (size (length forms)))
 192          (concat "User aborted while testing the following expressions:\n"
 193                  (mapconcat (lambda (x) (bug-hunter--pretty-format x 4))
 194                             (if (< size 16) forms (seq-take forms 7))
 195                             "")
 196                  (when (> size 16)
 197                    (format "\n    ... %s omitted expressions ...\n\n"
 198                      (- size 14)))
 199                  (when (> size 16)
 200                    (mapconcat (lambda (x) (bug-hunter--pretty-format x 4))
 201                               (seq-drop forms (- size 7)) "")))))
 202       (assertion-triggered
 203        (concat "The assertion returned the following value here:\n"
 204                (bug-hunter--pretty-format (cadr error) 4)))
 205       (t (format "The following error was signaled here:\n    %S"
 206            error))))
 207   (when expression
 208     (bug-hunter--report "  Caused by the following expression:\n%s"
 209       (bug-hunter--pretty-format expression 4)))
 210   (bug-hunter--report "\xc")
 211   `[,error ,line ,column ,expression])
 212
 213 \f
 214 ;;; Execution functions
 215 (defun bug-hunter--run-form (form)
 216   "Run FORM with \"emacs -Q\" and return the result."
 217   (let ((out-buf (generate-new-buffer "*Bug-Hunter Command*"))
 218         (exec (file-truename (expand-file-name invocation-name
 219                                                invocation-directory)))
 220         (file-name (make-temp-file "bug-hunter")))
 221     (unwind-protect
 222         (let ((print-length nil)
 223               (print-level nil))
 224           (with-temp-file file-name
 225             (print (list 'prin1 form) (current-buffer)))
 226           (call-process exec nil out-buf nil
 227                         "-Q" "--batch" "-l" file-name)
 228           (with-current-buffer out-buf
 229             (goto-char (point-max))
 230             (forward-sexp -1)
 231             (prog1 (read (current-buffer))
 232               (kill-buffer (current-buffer)))))
 233       (delete-file file-name))))
 234
 235 (defun bug-hunter--run-and-test (forms assertion)
 236   "Execute FORMS in the background and test ASSERTION.
 237 See `bug-hunter' for a description on the ASSERTION."
 238   (bug-hunter--run-form
 239    `(condition-case er
 240         (let ((server-name (make-temp-file "bug-hunter-temp-server-file")))
 241           (delete-file server-name)
 242           ,@forms
 243           (run-hooks 'after-init-hook)
 244           ,assertion)
 245       (error (cons 'bug-caught er)))))
 246
 247
 248 \f
 249 ;;; The actual bisection
 250 (defun bug-hunter--split (l)
 251   "Split list L in two lists of same size."
 252   (seq-partition l (ceiling (/ (length l) 2.0))))
 253
 254 (defun bug-hunter--bisect (assertion safe head &optional tail)
 255   "Implementation used by `bug-hunter--bisect-start'.
 256 ASSERTION is received by `bug-hunter--bisect-start'.
 257 SAFE is a list of forms confirmed to not match the ASSERTION,
 258 HEAD is a list of forms to be tested now, and TAIL is a list
 259 which will be inspected if HEAD doesn't match ASSERTION."
 260   (message "Testing: %s/%s" (cl-incf bug-hunter--i) bug-hunter--estimate)
 261   ;; Used if the user quits.
 262   (setq bug-hunter--current-head head)
 263   (let ((ret-val (bug-hunter--run-and-test (append safe head) assertion)))
 264     (cond
 265      ((not tail)
 266       (cl-assert ret-val nil)
 267       (vector (length safe) ret-val))
 268      ;; Issue in the head.
 269      ((and ret-val (< (length head) 2))
 270       (vector (length safe) ret-val))
 271      (ret-val
 272       (apply #'bug-hunter--bisect
 273         assertion
 274         safe
 275         (bug-hunter--split head)))
 276      ;; Issue in the tail.
 277      (t (apply #'bug-hunter--bisect
 278           assertion
 279           (append safe head)
 280           ;; If tail has length 1, we already know where the issue is,
 281           ;; but we still do this to get the return value.
 282           (bug-hunter--split tail))))))
 283
 284 (defun bug-hunter--bisect-start (forms assertion)
 285   "Run a bisection search on list of FORMS using ASSERTION.
 286 Returns a vector [n value], where n is the position of the first
 287 element in FORMS which trigger ASSERTION, and value is the
 288 ASSERTION's return value.
 289
 290 If ASSERTION is nil, n is the position of the first form to
 291 signal an error and value is (bug-caught . ERROR-SIGNALED)."
 292   (let ((bug-hunter--i 0)
 293         (bug-hunter--estimate (ceiling (log (length forms) 2)))
 294         (bug-hunter--current-head nil))
 295     (condition-case-unless-debug nil
 296         (apply #'bug-hunter--bisect assertion nil (bug-hunter--split forms))
 297       (quit `[nil (bug-caught user-aborted ,bug-hunter--current-head)]))))
 298
 299 \f
 300 ;;; Main functions
 301 (defun bug-hunter-hunt (rich-forms assertion)
 302   "Bisect RICH-FORMS using ASSERTION.
 303 RICH-FORMS is a list with elements of the form: (EXPR LINE COL)
 304     EXPR is an elisp expression.  LINE and COL are the coordinates
 305     in `bug-hunter--current-file' where the expression starts.
 306 It is expected that one of EXPR is either throwing an error or
 307 causing some undesirable effect (which triggers ASSERTION).
 308
 309 ASSERTION is either nil or an expression.
 310     If nil, EXPRs are bisected until we find the first one that
 311     throws errors.
 312     If it is an expression, EXPRs are bisected by testing
 313     ASSERTION.  It should return nil if all is fine (e.g. if used
 314     with \"emacs -Q\"), and should return non-nil when a problem
 315     is detected.
 316
 317 Bug hunter will refuse to hunt if (i) an error is signaled or the
 318 assertion is triggered while running emacs -Q, or (ii) no errors
 319 are signaled and the assertion is not triggered after all EXPRs
 320 are evaluated."
 321   (pop-to-buffer (bug-hunter--init-report-buffer))
 322   (let ((expressions (unless (eq (car-safe rich-forms) 'bug-caught)
 323                        (mapcar #'car rich-forms))))
 324     (cond
 325      ((not expressions)
 326       (apply #'bug-hunter--report-error (cdr rich-forms))
 327       (apply #'vector (cdr rich-forms)))
 328
 329      ;; Make sure there's a bug to hunt.
 330      ((progn (bug-hunter--report "Doing some initial tests...")
 331              (not (bug-hunter--run-and-test expressions assertion)))
 332       (bug-hunter--report-user-error "Test failed.\n%s\n%s"
 333         (if assertion
 334             (concat "The assertion returned nil after loading the entire file.\n"
 335                     bug-hunter--assertion-reminder)
 336           "No errors signaled after loading the entire file. If you're
 337 looking for something that's not an error, you need to provide an
 338 assertion. See this link for some examples:
 339     https://github.com/Bruce-Connor/elisp-bug-hunter")
 340         (or assertion "")))
 341
 342      ;; Make sure we're in a forest, not a volcano.
 343      ((bug-hunter--run-and-test nil assertion)
 344       (bug-hunter--report-user-error "Test failed.\n%s\n%s"
 345         (if assertion
 346             (concat "Assertion returned non-nil even on emacs -Q:"
 347                     bug-hunter--assertion-reminder)
 348           "Detected a signaled error even on emacs -Q. I'm sorry, but there
 349 is something seriously wrong with your Emacs installation.
 350 There's nothing more I can do here.")
 351         (or assertion "")))
 352
 353      (t
 354       ;; Perform the actual hunt.
 355       (bug-hunter--report "Initial tests done. Hunting for the cause...")
 356       (let* ((result (bug-hunter--bisect-start expressions assertion)))
 357         (if (not result)
 358             (bug-hunter--report-user-error "No problem was found, despite our initial tests.\n%s"
 359               "I have no idea what's going on.")
 360           (let* ((pos (elt result 0))
 361                  (ret (elt result 1))
 362                  (linecol (when pos (cdr (elt rich-forms pos))))
 363                  (expression (when pos (elt expressions pos))))
 364             (if (eq (car-safe ret) 'bug-caught)
 365                 (bug-hunter--report-error
 366                  (cdr ret) (car linecol) (cadr linecol) expression)
 367               (bug-hunter--report-error
 368                (list 'assertion-triggered ret)
 369                (car linecol) (cadr linecol) expression)))))))))
 370
 371 (defun bug-hunter--read-from-minibuffer ()
 372   "Read a list of expressions from the minibuffer.
 373 Wraps them in a progn if necessary."
 374   (require 'simple)
 375   (let ((exprs
 376          (with-temp-buffer
 377            ;; Copied from `read--expression'.
 378            (let ((minibuffer-completing-symbol t))
 379              (minibuffer-with-setup-hook
 380                  (lambda ()
 381                    (add-hook 'completion-at-point-functions
 382                              #'elisp-completion-at-point nil t)
 383                    (run-hooks 'eval-expression-minibuffer-setup-hook))
 384                (insert
 385                 (read-from-minibuffer
 386                  "Expression that returns nil if all is well (optional): "
 387                  nil read-expression-map nil 'read-expression-history))))
 388            (goto-char (point-min))
 389            (mapcar #'car (bug-hunter--read-buffer)))))
 390     (if (cdr exprs)
 391         (cons #'progn exprs)
 392       (car exprs))))
 393
 394 ;;;###autoload
 395 (defun bug-hunter-file (file &optional assertion)
 396   "Bisect FILE while testing ASSERTION.
 397 All sexps in FILE are read and passed to `bug-hunter-hunt' as a
 398 list.  See `bug-hunter-hunt' for how to use assertion."
 399   (interactive
 400    (list
 401     (read-file-name "File to bisect: "
 402                     (file-name-directory (or (buffer-file-name) "./"))
 403                     nil t
 404                     (file-name-nondirectory (or (buffer-file-name) "./")))
 405     (bug-hunter--read-from-minibuffer)))
 406   (let ((bug-hunter--current-file file))
 407     (bug-hunter-hunt (bug-hunter--read-contents file) assertion)))
 408
 409 ;;;###autoload
 410 (defun bug-hunter-init-file (&optional assertion)
 411   "Test ASSERTION throughout `user-init-file'.
 412 All sexps inside `user-init-file' are read and passed to
 413 `bug-hunter-hunt' as a list.  See `bug-hunter-hunt' for how to use
 414 assertion."
 415   (interactive (list (bug-hunter--read-from-minibuffer)))
 416   (bug-hunter-file user-init-file assertion))
 417
 418 (provide 'bug-hunter)
 419 ;;; bug-hunter.el ends here