flycheck-ert.el (17875B)
1 ;;; flycheck-ert.el --- Flycheck: ERT extensions -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2017-2018 Flycheck contributors 4 ;; Copyright (C) 2013-2016 Sebastian Wiesner and Flycheck contributors 5 6 ;; Author: Sebastian Wiesner <swiesner@lunaryorn.com> 7 ;; Maintainer: Clément Pit-Claudel <clement.pitclaudel@live.com> 8 ;; fmdkdd <fmdkdd@gmail.com> 9 ;; URL: https://github.com/flycheck/flycheck 10 11 ;; This file is not part of GNU Emacs. 12 13 ;; This program is free software; you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation, either version 3 of the License, or 16 ;; (at your option) any later version. 17 18 ;; This program is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 25 26 ;;; Commentary: 27 28 ;; Unit testing library for Flycheck, the modern on-the-fly syntax checking 29 ;; extension for GNU Emacs. 30 31 ;; Provide various utility functions and unit test helpers to test Flycheck and 32 ;; Flycheck extensions. 33 34 ;;; Code: 35 36 (require 'flycheck) 37 (require 'ert) 38 (require 'macroexp) ; For macro utilities 39 40 41 ;;; Internal variables 42 43 (defvar flycheck-ert--resource-directory nil 44 "The directory to get resources from in this test suite.") 45 46 47 ;;; Resource management macros 48 49 (defmacro flycheck-ert-with-temp-buffer (&rest body) 50 "Eval BODY within a temporary buffer. 51 52 Like `with-temp-buffer', but resets the modification state of the 53 temporary buffer to make sure that it is properly killed even if 54 it has a backing file and is modified." 55 (declare (indent 0) (debug t)) 56 `(with-temp-buffer 57 (unwind-protect 58 ,(macroexp-progn body) 59 ;; Reset modification state of the buffer, and unlink it from its backing 60 ;; file, if any, because Emacs refuses to kill modified buffers with 61 ;; backing files, even if they are temporary. 62 (set-buffer-modified-p nil) 63 (set-visited-file-name nil 'no-query)))) 64 65 (defmacro flycheck-ert-with-file-buffer (file-name &rest body) 66 "Create a buffer from FILE-NAME and eval BODY. 67 68 BODY is evaluated with `current-buffer' being a buffer with the 69 contents FILE-NAME." 70 (declare (indent 1) (debug t)) 71 `(let ((file-name ,file-name)) 72 (unless (file-exists-p file-name) 73 (error "%s does not exist" file-name)) 74 (flycheck-ert-with-temp-buffer 75 (insert-file-contents file-name 'visit) 76 (set-visited-file-name file-name 'no-query) 77 (cd (file-name-directory file-name)) 78 ;; Mark the buffer as not modified, because we just loaded the file up to 79 ;; now. 80 (set-buffer-modified-p nil) 81 ,@body))) 82 83 (defmacro flycheck-ert-with-help-buffer (&rest body) 84 "Execute BODY and kill the help buffer afterwards. 85 86 Use this macro to test functions that create a Help buffer." 87 (declare (indent 0)) 88 `(unwind-protect 89 ,(macroexp-progn body) 90 (when (buffer-live-p (get-buffer (help-buffer))) 91 (kill-buffer (help-buffer))))) 92 93 (defmacro flycheck-ert-with-global-mode (&rest body) 94 "Execute BODY with Global Flycheck Mode enabled. 95 96 After BODY, restore the old state of Global Flycheck Mode." 97 (declare (indent 0)) 98 `(let ((old-state global-flycheck-mode)) 99 (unwind-protect 100 (progn 101 (global-flycheck-mode 1) 102 ,@body) 103 (global-flycheck-mode (if old-state 1 -1))))) 104 105 (defmacro flycheck-ert-with-env (env &rest body) 106 "Add ENV to `process-environment' in BODY. 107 108 Execute BODY with a `process-environment' which contains all 109 variables from ENV added. 110 111 ENV is an alist, where each cons cell `(VAR . VALUE)' is a 112 environment variable VAR to be added to `process-environment' 113 with VALUE." 114 (declare (indent 1)) 115 `(let ((process-environment (copy-sequence process-environment))) 116 (pcase-dolist (`(,var . ,value) ,env) 117 (setenv var value)) 118 ,@body)) 119 120 121 ;;; Test resources 122 (defun flycheck-ert-resource-filename (resource-file) 123 "Determine the absolute file name of a RESOURCE-FILE. 124 125 Relative file names are expanded against 126 `flycheck-ert--resource-directory'." 127 (expand-file-name resource-file flycheck-ert--resource-directory)) 128 129 (defmacro flycheck-ert-with-resource-buffer (resource-file &rest body) 130 "Create a temp buffer from a RESOURCE-FILE and execute BODY. 131 132 The absolute file name of RESOURCE-FILE is determined with 133 `flycheck-ert-resource-filename'." 134 (declare (indent 1)) 135 `(flycheck-ert-with-file-buffer 136 (flycheck-ert-resource-filename ,resource-file) 137 ,@body)) 138 139 140 ;;; Test suite initialization 141 142 (defun flycheck-ert-initialize (resource-dir) 143 "Initialize a test suite with RESOURCE-DIR. 144 145 RESOURCE-DIR is the directory, `flycheck-ert-resource-filename' 146 should use to lookup resource files." 147 (when flycheck-ert--resource-directory 148 (error "Test suite already initialized")) 149 (let ((tests (ert-select-tests t t))) 150 ;; Select all tests 151 (unless tests 152 (error "No tests defined. \ 153 Call `flycheck-ert-initialize' after defining all tests!")) 154 155 (setq flycheck-ert--resource-directory resource-dir))) 156 157 158 ;;; Test case definitions 159 (defmacro flycheck-ert-def-checker-test (checker language name 160 &rest keys-and-body) 161 "Define a test case for a syntax CHECKER for LANGUAGE. 162 163 CHECKER is a symbol or a list of symbols denoting syntax checkers 164 being tested by the test. The test case is skipped, if any of 165 these checkers cannot be used. LANGUAGE is a symbol or a list of 166 symbols denoting the programming languages supported by the 167 syntax checkers. This is currently only used for tagging the 168 test appropriately. 169 170 NAME is a symbol denoting the local name of the test. The test 171 itself is ultimately named 172 `flycheck-define-checker/CHECKER/NAME'. If CHECKER is a list, 173 the first checker in the list is used for naming the test. 174 175 Optionally, the keyword arguments `:tags' and `:expected-result' 176 may be given. They have the same meaning as in `ert-deftest.', 177 and are added to the tags and result expectations set up by this 178 macro. 179 180 The remaining forms KEYS-AND-BODY denote the body of the test 181 case, including assertions and setup code." 182 (declare (indent 3)) 183 (unless checker 184 (error "No syntax checkers specified")) 185 (unless language 186 (error "No languages specified")) 187 (let* ((checkers (if (symbolp checker) (list checker) checker)) 188 (checker (car checkers)) 189 (languages (if (symbolp language) (list language) language)) 190 (language-tags (mapcar (lambda (l) (intern (format "language-%s" l))) 191 languages)) 192 (checker-tags (mapcar (lambda (c) (intern (format "checker-%s" c))) 193 checkers)) 194 (local-name (or name 'default)) 195 (full-name (intern (format "flycheck-define-checker/%s/%s" 196 checker local-name))) 197 (keys-and-body (ert--parse-keys-and-body keys-and-body)) 198 (body (cadr keys-and-body)) 199 (keys (car keys-and-body)) 200 (default-tags '(syntax-checker external-tool))) 201 `(ert-deftest ,full-name () 202 :expected-result ,(or (plist-get keys :expected-result) :passed) 203 :tags (append ',(append default-tags language-tags checker-tags) 204 ,(plist-get keys :tags)) 205 ,@(mapcar (lambda (c) 206 `(skip-unless 207 ;; Ignore non-command checkers 208 (or (not (flycheck-checker-get ',c 'command)) 209 (executable-find (flycheck-checker-executable ',c))))) 210 checkers) 211 ,@body))) 212 213 214 ;;; Test case results 215 216 (defun flycheck-ert-syntax-check-timed-out-p (result) 217 "Whether RESULT denotes a timed-out test. 218 219 RESULT is an ERT test result object." 220 (and (ert-test-failed-p result) 221 (eq (car (ert-test-failed-condition result)) 222 'flycheck-ert-syntax-check-timed-out))) 223 224 225 ;;; Syntax checking in tests 226 227 (defvar-local flycheck-ert-syntax-checker-finished nil 228 "Non-nil if the current checker has finished.") 229 230 (add-hook 'flycheck-after-syntax-check-hook 231 (lambda () (setq flycheck-ert-syntax-checker-finished t))) 232 233 (defconst flycheck-ert-checker-wait-time 10 234 "Time to wait until a checker is finished in seconds. 235 236 After this time has elapsed, the checker is considered to have 237 failed, and the test aborted with failure.") 238 239 (define-error 'flycheck-ert-syntax-check-timed-out "Syntax check timed out.") 240 241 (defun flycheck-ert-wait-for-syntax-checker () 242 "Wait until the syntax check in the current buffer is finished." 243 (let ((starttime (float-time))) 244 (while (and (not flycheck-ert-syntax-checker-finished) 245 (< (- (float-time) starttime) flycheck-ert-checker-wait-time)) 246 (accept-process-output nil 0.02)) 247 (unless (< (- (float-time) starttime) flycheck-ert-checker-wait-time) 248 (flycheck-stop) 249 (signal 'flycheck-ert-syntax-check-timed-out nil))) 250 (setq flycheck-ert-syntax-checker-finished nil)) 251 252 (defun flycheck-ert-buffer-sync () 253 "Like `flycheck-buffer', but synchronously." 254 (setq flycheck-ert-syntax-checker-finished nil) 255 (should (not (flycheck-running-p))) 256 (flycheck-mode) ;; This will only start a deferred check, 257 (should (flycheck-get-checker-for-buffer)) 258 (flycheck-buffer) ;; …so we need an explicit manual check 259 ;; After starting the check, the checker should either be running now, or 260 ;; already be finished (if it was fast). 261 (should (or flycheck-current-syntax-check 262 flycheck-ert-syntax-checker-finished)) 263 ;; Also there should be no deferred check pending anymore 264 (should-not (flycheck-deferred-check-p)) 265 (flycheck-ert-wait-for-syntax-checker)) 266 267 (defun flycheck-ert-ensure-clear () 268 "Clear the current buffer. 269 270 Raise an assertion error if the buffer is not clear afterwards." 271 (flycheck-clear) 272 (should (not flycheck-current-errors)) 273 (should (not (seq-find (lambda (ov) (overlay-get ov 'flycheck-overlay)) 274 (overlays-in (point-min) (point-max)))))) 275 276 277 ;;; Test assertions 278 279 (defun flycheck-error-without-group (err) 280 "Return a copy ERR with the `group' property set to nil." 281 (let ((copy (copy-flycheck-error err))) 282 (setf (flycheck-error-group copy) nil) 283 copy)) 284 285 (defun flycheck-ert-should-overlay (error) 286 "Test that ERROR has a proper overlay in the current buffer. 287 288 ERROR is a Flycheck error object." 289 (let* ((overlay (seq-find (lambda (ov) 290 (equal (flycheck-error-without-group 291 (overlay-get ov 'flycheck-error)) 292 (flycheck-error-without-group error))) 293 (flycheck-overlays-in 0 (+ 1 (buffer-size))))) 294 (region 295 ;; Overlays of errors from other files are on the first line 296 (if (flycheck-relevant-error-other-file-p error) 297 (cons (point-min) 298 (save-excursion (goto-char (point-min)) 299 (line-end-position))) 300 (flycheck-error-region-for-mode error 'symbols))) 301 (level (flycheck-error-level error)) 302 (category (flycheck-error-level-overlay-category level)) 303 (face (get category 'face)) 304 (fringe-bitmap (flycheck-error-level-fringe-bitmap level)) 305 (fringe-face (flycheck-error-level-fringe-face level)) 306 (fringe-icon (list 'left-fringe fringe-bitmap fringe-face))) 307 (should overlay) 308 (should (overlay-get overlay 'flycheck-overlay)) 309 (should (= (overlay-start overlay) (car region))) 310 (should (= (overlay-end overlay) (cdr region))) 311 (should (eq (overlay-get overlay 'face) face)) 312 (should (equal (get-char-property 0 'display 313 (overlay-get overlay 'before-string)) 314 fringe-icon)) 315 (should (eq (overlay-get overlay 'category) category)) 316 (should (equal (flycheck-error-without-group (overlay-get overlay 317 'flycheck-error)) 318 (flycheck-error-without-group error))))) 319 320 (defun flycheck-ert-sort-errors (errors) 321 "Sort ERRORS by `flycheck-error-<'." 322 (seq-sort #'flycheck-error-< errors)) 323 324 (defun flycheck-ert-should-errors (&rest errors) 325 "Test that the current buffers has ERRORS. 326 327 ERRORS is a list of errors expected to be present in the current 328 buffer. Each error is given as a list of arguments to 329 `flycheck-error-new-at'. 330 331 If ERRORS are omitted, test that there are no errors at all in 332 the current buffer. 333 334 With ERRORS, test that each error in ERRORS is present in the 335 current buffer, and that the number of errors in the current 336 buffer is equal to the number of given ERRORS. In other words, 337 check that the buffer has all ERRORS, and no other errors." 338 (let ((expected (flycheck-ert-sort-errors 339 (mapcar (apply-partially #'apply #'flycheck-error-new-at) 340 errors))) 341 (current (flycheck-ert-sort-errors flycheck-current-errors))) 342 (should (equal (mapcar #'flycheck-error-without-group expected) 343 (mapcar #'flycheck-error-without-group current))) 344 ;; Check that related errors are the same 345 (cl-mapcar 346 (lambda (err1 err2) 347 (should (equal (flycheck-ert-sort-errors 348 (mapcar #'flycheck-error-without-group 349 (flycheck-related-errors err1 expected))) 350 (flycheck-ert-sort-errors 351 (mapcar #'flycheck-error-without-group 352 (flycheck-related-errors err2)))))) 353 expected current) 354 (mapc #'flycheck-ert-should-overlay expected)) 355 (should (= (length errors) 356 (length (flycheck-overlays-in (point-min) (point-max)))))) 357 358 (define-error 'flycheck-ert-suspicious-checker "Suspicious state from checker") 359 360 (defun flycheck-ert-should-syntax-check-in-buffer (&rest errors) 361 "Test a syntax check in BUFFER, expecting ERRORS. 362 363 This is like `flycheck-ert-should-syntax-check', but with a 364 buffer in the right mode instead of a file." 365 ;; Load safe file-local variables because some tests depend on them 366 (let ((enable-local-variables :safe) 367 ;; Disable all hooks at this place, to prevent 3rd party packages 368 ;; from interfering 369 (hack-local-variables-hook)) 370 (hack-local-variables)) 371 ;; Configure config file locating for unit tests 372 (let ((process-hook-called 0) 373 (suspicious nil)) 374 (add-hook 'flycheck-process-error-functions 375 (lambda (_err) 376 (setq process-hook-called (1+ process-hook-called)) 377 nil) 378 nil :local) 379 (add-hook 'flycheck-status-changed-functions 380 (lambda (status) 381 (when (eq status 'suspicious) 382 (setq suspicious t))) 383 nil :local) 384 (flycheck-ert-buffer-sync) 385 (when suspicious 386 (signal 'flycheck-ert-suspicious-checker nil)) 387 (apply #'flycheck-ert-should-errors errors) 388 (should (= process-hook-called (length errors)))) 389 (flycheck-ert-ensure-clear)) 390 391 (defun flycheck-ert-should-syntax-check (resource-file modes &rest errors) 392 "Test a syntax check in RESOURCE-FILE with MODES. 393 394 RESOURCE-FILE is the file to check. MODES is a single major mode 395 symbol or a list thereof, specifying the major modes to syntax 396 check with. If more than one major mode is specified, the test 397 is run for each mode separately, so if you give three major 398 modes, the entire test will run three times. ERRORS is the list 399 of expected errors, as in `flycheck-ert-should-errors'. If 400 omitted, the syntax check must not emit any errors. The errors 401 are cleared after each test. 402 403 The syntax checker is selected via standard syntax checker 404 selection. To test a specific checker, you need to set 405 `flycheck-checker' or `flycheck-disabled-checkers' accordingly 406 before using this predicate, depending on whether you want to use 407 manual or automatic checker selection. 408 409 During the syntax check, configuration files of syntax checkers 410 are also searched in the `config-files' sub-directory of the 411 resource directory." 412 (when (symbolp modes) 413 (setq modes (list modes))) 414 (dolist (mode modes) 415 (unless (fboundp mode) 416 (ert-skip (format "%S missing" mode))) 417 (flycheck-ert-with-resource-buffer resource-file 418 (funcall mode) 419 (apply #'flycheck-ert-should-syntax-check-in-buffer errors)))) 420 421 (defun flycheck-ert-at-nth-error (n) 422 "Determine whether point is at the N'th Flycheck error. 423 424 Return non-nil if the point is at the N'th Flycheck error in the 425 current buffer. Otherwise return nil." 426 (let* ((error (nth (1- n) flycheck-current-errors)) 427 (mode flycheck-highlighting-mode) 428 (region (flycheck-error-region-for-mode error mode))) 429 (and (member error (flycheck-overlay-errors-at (point))) 430 (= (point) (car region))))) 431 432 (defun flycheck-ert-explain--at-nth-error (n) 433 "Explain a failed at-nth-error predicate at N." 434 (let ((errors (flycheck-overlay-errors-at (point)))) 435 (if (null errors) 436 (format "Expected to be at error %s, but no error at point %s" 437 n (point)) 438 (let ((pos (cl-position (car errors) flycheck-current-errors))) 439 (format "Expected to be at point %s and error %s, \ 440 but point %s is at error %s" 441 (car (flycheck-error-region-for-mode 442 (nth (1- n) flycheck-current-errors) 443 flycheck-highlighting-mode)) 444 n (point) (1+ pos)))))) 445 446 (put 'flycheck-ert-at-nth-error 'ert-explainer 447 'flycheck-ert-explain--at-nth-error) 448 449 (provide 'flycheck-ert) 450 451 ;;; flycheck-ert.el ends here