;;; 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