Files
emacs.d/elpa/racket-mode-20171116.1435/racket-tests.el
Mateus Pinto Rodrigues 2362e805bd Add new packages installed
2018-03-27 20:52:59 -03:00

189 lines
7.0 KiB
EmacsLisp

;;; racket-tests.el --- Major mode for Racket language.
;; Copyright (c) 2013-2016 by Greg Hendershott.
;; License:
;; This 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 2, or (at your option)
;; any later version. This 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. See
;; http://www.gnu.org/licenses/ for details.
(require 'ert)
(require 'racket-mode)
(require 'racket-repl)
(require 'racket-edit)
(require 'edmacro)
(require 'faceup)
(require 'racket-common)
(defconst racket-tests/here-dir (faceup-this-file-directory)
"The directory this file is located in.")
;;; Utility functions for "integration" testing
(defun racket-tests/type (typing)
(let ((blink-matching-paren nil)) ;suppress "Matches " messages
(execute-kbd-macro (string-to-vector typing))
(redisplay)))
(defun racket-tests/press (binding)
(racket-tests/type (edmacro-parse-keys binding)))
(defun racket-tests/type&press (typing binding)
(racket-tests/type typing)
(racket-tests/press binding))
(defun racket-tests/see-rx (rx)
(let ((one-second-attempts (if (getenv "TRAVIS_CI")
(* 15 60)
30)))
;; Although using cl-some like this is weird, cl-loop is weirder IMHO
(cl-some (lambda (_x)
(accept-process-output (racket--get-repl-buffer-process) 1)
(sit-for 0.1)
(looking-back rx (point-min)))
(make-list one-second-attempts nil))))
(defun racket-tests/see (str)
(racket-tests/see-rx (regexp-quote str)))
(defun racket-tests/explain-see (str)
`(actual . ,(buffer-substring-no-properties
(point-min)
(point))))
(put 'racket-tests/see-rx 'ert-explainer #'racket-tests/explain-see)
(put 'racket-tests/see 'ert-explainer #'racket-tests/explain-see)
;;; REPL
(ert-deftest racket-tests/repl ()
"Start REPL. Confirm we get Welcome message and prompt. Exit REPL."
(racket-repl)
(with-racket-repl-buffer
(let ((tab-always-indent 'complete)
(racket--repl-command-connect-timeout (* 15 60))
(racket-command-port 55556)
(racket-command-timeout (* 15 60)))
;; Welcome
(should (racket-tests/see-rx (concat "Welcome to Racket v[0-9.]+\n"
(regexp-quote "\uFEFF> "))))
;; Completion
(racket-tests/type&press "with-inp" "TAB")
(should (racket-tests/see "with-input-from-file"))
(racket-tests/press "RET")
(should (racket-tests/see "#<procedure:with-input-from-file>\n\uFEFF> "))
;; Multiline expression indent
(racket-tests/type&press "(if 1" "RET")
(should (racket-tests/see "(if 1\n "))
(racket-tests/type&press "2" "RET")
(should (racket-tests/see "2\n "))
(racket-tests/type&press "3)" "RET")
(should (racket-tests/see "3)\n2\n\uFEFF> "))
;; Exit
(racket-tests/type&press "(exit)" "RET")
(should (racket-tests/see "Process Racket REPL finished\n")))))
;;; Run
(ert-deftest racket-tests/run ()
(let* ((racket--repl-command-connect-timeout (* 15 60))
(racket-command-port 55556)
(racket-command-timeout (* 15 60))
(pathname (make-temp-file "test" nil ".rkt"))
(name (file-name-nondirectory pathname))
(code "#lang racket/base\n(define x 42)\nx\n"))
(write-region code nil pathname nil 'no-wrote-file-message)
(find-file pathname)
(racket-run)
;; see expected prompt
(with-racket-repl-buffer
(should (racket-tests/see (concat "\n" name "\uFEFF> "))))
;; racket-check-syntax-mode
(when (version<= "6.2" (racket--version))
(let ((racket--check-syntax-start-timeout (if (getenv "TRAVIS_CI")
(* 15 60)
racket--check-syntax-start-timeout)))
(racket-check-syntax-mode 1))
(goto-char (point-min))
(racket-check-syntax-mode-goto-next-def)
(should (looking-at "racket/base"))
(racket-check-syntax-mode-goto-next-use)
(should (looking-at "define"))
(racket-check-syntax-mode 0))
;; Exit
;; (with-racket-repl-buffer
;; (racket-tests/type&press "(exit)" "RET"))
(delete-file pathname)))
;;; Indentation
(defun racket-tests/same-indent (file)
(with-current-buffer (find-file (concat racket-tests/here-dir file))
(indent-region (point-min) (point-max))
(let ((ok (not (buffer-modified-p))))
(revert-buffer t t t) ;revert in case running ERT interactively
ok)))
(ert-deftest racket-tests/indent-rkt ()
"Indentation of example/*.rkt shouldn't change."
(should (racket-tests/same-indent "example/example.rkt"))
(should (racket-tests/same-indent "example/indent.rkt")))
;;; Font-lock
(defun racket-tests/same-faceup (file)
"Test that FILE is fontified as the .faceup file describes.
FILE is interpreted as relative to this source directory."
(let ((font-lock-maximum-decoration t))
(faceup-test-font-lock-file 'racket-mode
(concat racket-tests/here-dir file))))
(faceup-defexplainer racket-tests/same-faceup)
(ert-deftest racket-tests/font-lock ()
"Font-lock of example/*.rkt shouldn't change."
(should (racket-tests/same-faceup "example/indent.rkt"))
(should (racket-tests/same-faceup "example/example.rkt")))
;;; Smart open bracket
(defun racket-tests/brackets (smartp input expected)
(with-temp-buffer
(racket-mode)
(let ((racket-smart-open-bracket-enable smartp)
(blink-matching-paren nil)) ;suppress "Matches " messages
(mapc (lambda (x)
(cond ((eq x ?\[) (racket-smart-open-bracket))
((eq x ?\]) (racket-insert-closing))
(t (racket--self-insert x))))
input)
(equal (buffer-substring-no-properties (point-min) (point-max))
expected))))
(ert-deftest racket-tests/smart-open-bracket ()
"Type a `cond` form with `racket-smart-open-bracket-enable' both t and nil.
Also try with `electric-pair-mode' both on and off.
Currently this is really just a regression test for bug #81. This
could be expanded into a series of exhaustive tests of all the
special forms it handles."
(let ((before "[cond [[f x] #t][else #f]]")
(after "(cond [(f x) #t][else #f])")
(orig-electricp electric-pair-mode))
(electric-pair-mode -1)
(should (racket-tests/brackets nil before before))
(should (racket-tests/brackets t before after))
(electric-pair-mode 1)
(should (racket-tests/brackets nil before before))
(should (racket-tests/brackets t before after))
;; Restore in case running interactively with ERT
(electric-pair-mode (if orig-electricp 1 -1))))
(provide 'racket-tests)
;;; racket-tests.el ends here