From: Lars Ingebrigtsen <larsi@gnus.org>
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