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