Klimi's new dotfiles with stow.
Du kan inte välja fler än 25 ämnen Ämnen måste starta med en bokstav eller siffra, kan innehålla bindestreck ('-') och vara max 35 tecken långa.

483 rader
19 KiB

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