From: Lars Ingebrigtsen Date: Fri, 1 Oct 2021 13:24:01 +0000 (+0200) Subject: Add new command erts-run-test X-Git-Tag: emacs-29.0.90~3671^2~702 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=09ec95c53ba2142a182cbb08e79bb6a27c6634d8;p=emacs.git Add new command erts-run-test * lisp/progmodes/erts-mode.el (erts-run-test): New command and keystroke. --- diff --git a/lisp/progmodes/erts-mode.el b/lisp/progmodes/erts-mode.el index 6f3e5b3ab58..9d3d7698069 100644 --- a/lisp/progmodes/erts-mode.el +++ b/lisp/progmodes/erts-mode.el @@ -24,6 +24,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'ert) (defgroup erts-mode nil "Major mode for editing Emacs test files." @@ -67,6 +68,7 @@ (let ((map (make-keymap))) (set-keymap-parent map prog-mode-map) (define-key map "\C-c\C-r" 'erts-tag-region) + (define-key map "\C-c\C-c" 'erts-run-test) map)) (defvar erts-mode-font-lock-keywords @@ -126,7 +128,7 @@ Interactively, this is the region. NAME should be a string appropriate for output by ert if the test fails. If NAME is nil or the empty string, a name will be auto-generated." - (interactive "r\nsTest name: ") + (interactive "r\nsTest name: " erts-mode) ;; Automatically make a name. (when (zerop (length name)) (save-excursion @@ -151,6 +153,40 @@ If NAME is nil or the empty string, a name will be auto-generated." (insert "Name: " name "\n\n") (insert "=-=\n"))) +(defun erts-run-test (test-function) + "Run the current test. +If the current erts file doesn't define a test function, the user +will be prompted for one." + (interactive + (list (save-excursion + ;; Find the preceding Code spec. + (while (and (re-search-backward "^Code:" nil t) + (erts-mode--in-test-p (point)))) + (if (and (not (erts-mode--in-test-p (point))) + (re-search-forward "^=-=$" nil t)) + (progn + (goto-char (match-beginning 0)) + (cdr (assq 'code (ert--erts-specifications (point))))) + (read-string "Transformation function: ")))) + erts-mode) + (save-excursion + (erts-mode--goto-start-of-test) + (condition-case arg + (ert-test--erts-test + (list (cons 'dummy t) (cons 'code test-function)) + (buffer-file-name)) + (:success (message "Test successful")) + (ert-test-failed (message "Test failure; expected text: \n%s" + (substring-no-properties (cadr (cadr arg)))))))) + +(defun erts-mode--goto-start-of-test () + (if (not (erts-mode--in-test-p (point))) + (re-search-forward "^=-=\n" nil t) + (re-search-backward "^=-=\n" nil t) + (when (save-match-data (erts-mode--in-test-p (point))) + (re-search-backward "^=-=\n" nil t)) + (goto-char (match-end 0)))) + (provide 'erts-mode) ;;; erts-mode.el ends here