You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

141 lines
5.4 KiB

;;; run.el --- Flycheck: Test runner -*- lexical-binding: t; -*-
;; Copyright (C) 2017-2018 Flycheck contributors
;; Copyright (C) 2014-2016 Sebastian Wiesner and Flycheck contributors
;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
;; Maintainer: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; fmdkdd <fmdkdd@gmail.com>
;; URL: https://www.flycheck.org
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Flycheck test runner.
;;; Code:
(defun flycheck-run-check-selector (selector)
"Check SELECTOR if it fails loading."
(with-temp-buffer
(insert selector)
(goto-char (point-min))
(condition-case nil
(progn
(check-parens)
(message "Invalid selector: %S" selector))
(error
(message "Unbalanced parenthesis in selector %S at %s"
selector (1+ (current-column)))))))
(defun flycheck-transform-selector (selector)
"Transform SELECTOR to implement some custom selectors.
This function adds the following custom selectors:
`(language FOO)' -> `(tag language-FOO)'
`(checker FOO)' -> `(tag checker-FOO)'"
(pcase selector
(`(language ,(and language (pred symbolp)))
(list 'tag (intern (concat "language-" (symbol-name language)))))
(`(checker ,(and checker (pred symbolp)))
(list 'tag (intern (concat "checker-" (symbol-name checker)))))
(`(new-checker-for ,(and language (pred symbolp)))
;; For a new checker for a language we need to run the documentation and
;; style tests, and all tests for the corresponding language, in order to
;; make sure that all chaining still works, and that the order of checkers
;; is still correct.
(flycheck-transform-selector `(or (tag documentation)
(tag style)
(language ,language))))
(`(,group . ,body)
(cons group (mapcar #'flycheck-transform-selector body)))
(simple simple)))
(defun flycheck-read-whole-string (str)
"Read from whole STR."
(pcase-let ((`(,obj . ,index) (read-from-string str)))
(if (/= index (length str))
(error "Can't read whole string")
obj)))
(defun flycheck-run-tests-batch-and-exit ()
"Run test cases matching tags in `argv' and exit.
Read an ERT test selector from the first command line argument,
run matching tests and exit. See `ert-select-tests' and Info
Node `(ert)Test Selectors' for information about test selectors."
(when (string= (car argv) "--")
;; Skip over the command line argument separator
(pop argv))
(let ((selector (pop argv)))
(when argv
;; Warn about unused trailing arguments, and remove them, to prevent Emacs
;; from trying to parse them.
(message "WARNING: Unused trailing arguments: %S" argv)
(setq argv nil))
(setq selector
`(and "flycheck-"
,(cond
((not selector) t)
((= (length selector) 0)
(message "Warning: Empty test selector, defaulting to t")
t)
(t (condition-case nil
(flycheck-read-whole-string selector)
(error
(flycheck-run-check-selector selector)
(kill-emacs 1)))))))
(flycheck-run-unlimit-ert-pretty-printer)
(ert-run-tests-batch-and-exit (flycheck-transform-selector selector))))
;; ERT in batch mode will truncate long output by default. We don't want that,
;; as it's easier to fix failures with the full output, since we cannot always
;; easily reproduce locally (for integration tests running on CI).
(defun flycheck-run-unlimit-ert-pretty-printer ()
"Install advice to unlimit the ERT output."
(advice-add 'ert--pp-with-indentation-and-newline :around
(lambda (orig &rest args)
(let ((print-length nil)
(print-level nil))
(apply orig args)))))
(defvar flycheck-runner-file
(if load-in-progress load-file-name (buffer-file-name)))
(defun flycheck-run-tests-main ()
"Main entry point of the test runner."
(let* ((load-prefer-newer t)
(source-directory (locate-dominating-file flycheck-runner-file "Cask"))
(pkg-rel-dir (format ".cask/%s.%S/elpa"
emacs-major-version
emacs-minor-version)))
;; Standardise on the C locale to prevent programs from writing fancy
;; unicode characters and thus make test output predictable
(setenv "LC_ALL" "C")
(setq package-user-dir (expand-file-name pkg-rel-dir source-directory))
(package-initialize)
(message "Running tests on Emacs %s, built at %s"
emacs-version (format-time-string "%F" emacs-build-time))
(let ((debug-on-error t))
(flycheck-run-tests-batch-and-exit))))
;;; run.el ends here