master 1a65320 1/2: Add new functionality to write buffer-based tests

[Lars Ingebrigtsen]

branch: master
commit 1a653209030279aa03898f647376f768f5d1e9f2
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add new functionality to write buffer-based tests
    
    * doc/misc/ert.texi (erts files): New node.
    
    * lisp/files.el (auto-mode-alist): Map .erts to erts-mode.
    
    * lisp/emacs-lisp/ert.el (ert-test-erts-file): New function.
    
    * lisp/emacs-lisp/ert.el (ert--erts-specifications)
    (ert--erts-unquote): Helper functions.
    
    * lisp/progmodes/erts-mode.el: New mode and file.
---
 doc/misc/ert.texi           | 110 ++++++++++++++++++++++++++++++++++++++++
 etc/NEWS                    |   6 +++
 lisp/emacs-lisp/ert.el      | 104 ++++++++++++++++++++++++++++++++++++++
 lisp/files.el               |   1 +
 lisp/progmodes/erts-mode.el | 119 ++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 340 insertions(+)

diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index 19f2d7d..6604829 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -486,6 +486,7 @@ to find where a test was defined if the test was loaded 
from a file.
 * Expected Failures::           Tests for known bugs.
 * Tests and Their Environment:: Don't depend on customizations; no side 
effects.
 * Useful Techniques::           Some examples.
+* erts files::                  Files containing many buffer tests.
 @end menu
 
 @node The @code{should} Macro
@@ -767,6 +768,115 @@ code is to restructure the code slightly to provide 
better interfaces
 for testing.  Usually, this makes the interfaces easier to use as
 well.
 
+@node erts files
+@section erts files
+
+@findex ert-test-erts-file
+Many relevant Emacs tests depend on comparing the contents of a buffer
+before and after executing a particular function.  These tests can be
+written the normal way---making a temporary buffer, inserting the
+``before'' text, running the function, and then comparing with the
+expected ``after'' text.  However, this often leads to test code
+that's pretty difficult to read and write, especially when the text in
+question is multi-line.
+
+So ert provides a function called @code{ert-test-erts-file} that takes
+two parameters: The name of a specially-formatted @dfn{erts} file, and
+(optionally) a function that performs the transform.
+
+@findex erts-mode
+These erts files can be edited with the @code{erts-mode} major mode.
+
+An erts file is divided into sections by the (@samp{=-=}) separator.
+
+Here's an example file containing two tests:
+
+@example
+Name: flet
+
+=-=
+(cl-flet ((bla (x)
+(* x x)))
+(bla 42))
+=-=
+(cl-flet ((bla (x)
+           (* x x)))
+  (bla 42))
+=-=-=
+
+Name: defun
+
+=-=
+(defun x ()
+  (print (quote ( thingy great
+                 stuff))))
+=-=-=
+@end example
+
+A test starts with a line containing just @samp{=-=} and ends with a
+line containing just just @samp{=-=-=}.  The test may be preceded by
+freeform text (for instance, comments), and also name/value pairs (see
+below for a list of them).
+
+If there is a line with @samp{=-=} inside the test, that designates
+the start of the ``after'' text.  Otherwise, the ``before'' and
+``after'' texts are assumed to be identical, which you typically see
+when writing indentation tests.
+
+@code{ert-test-erts-file} puts the ``before'' section into a temporary
+buffer, calls the transform function, and then compares with the
+``after'' section.
+
+Here's an example usage:
+
+@lisp
+(ert-test-erts-file "elisp.erts"
+                    (lambda ()
+                      (emacs-lisp-mode)
+                      (indent-region (point-min) (point-max))))
+@end lisp
+
+A list of the name/value specifications that can appear before a test
+follows.  The general syntax is @samp{Name: Value}, but continuation
+lines can be used (along the same lines as in mail -- subsequent lines
+that start with a space are part of the value).
+
+@example
+Name: foo
+Code: (indent-region
+        (point-min) (point-max))
+@end example
+
+@table @samp
+@item Name
+All tests should have a name.  This name will appear in the output
+from ert if the test fails, and helps identifying the failing test.
+
+@item Code
+This is the code that will be run to do the transform.  This can also
+be passed in via the @code{ert-test-erts-file} call, but @samp{Code}
+overrides that.  It's used not only in the following test, but in all
+subsequent tests in the file (until overridden by another @samp{Code}
+specification).
+
+@item No-Before-Newline
+@itemx No-After-Newline
+These specifications say whether the ``before'' or ``after'' portions
+have a newline at the end.  (This would otherwise be impossible to
+specify.)
+
+@item Point-Char
+Sometimes it's useful to be able to put point at a specific place
+before executing the transform character.  @samp{Point-Char: |} will
+make @code{ert-test-erts-file} place point where @samp{|} is in the
+``before'' form (and remove that character), and will check that it's
+where the @samp{|} character is in the ``after'' form (and issue a
+test failure if that isn't the case).  (This is used in all subsequent
+tests, unless overridden by a new @samp{Point-Char} spec.)
+@end table
+
+If you need to use the literal line single line @samp{=-=} in a test
+section, you can quote it with a @samp{\} character.
 
 @node How to Debug Tests
 @chapter How to Debug Tests
diff --git a/etc/NEWS b/etc/NEWS
index 04b6908..cf3c8b6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -46,6 +46,12 @@ buffer is already open.  Now, the old point is pushed to 
mark ring.
 
 * New Modes and Packages in Emacs 29.1
 
++++
+** New mode 'erts-mode'
+This mode is used to edit files geared towards testing actions in
+Emacs buffers, like indentation and the like.  The new ert function
+'ert-test-erts-file' is used to parse these files.
+
 
 * Incompatible Lisp Changes in Emacs 29.1
 
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 72fe194..204ccf5 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -63,6 +63,7 @@
 (require 'ewoc)
 (require 'find-func)
 (require 'pp)
+(require 'map)
 
 ;;; UI customization options.
 
@@ -2661,6 +2662,109 @@ To be used in the ERT results buffer."
                          'ert--activate-font-lock-keywords)
   nil)
 
+(defun ert-test-erts-file (file &optional transform)
+  "Parse FILE as a file containing before/after parts.
+TRANSFORM will be called to get from before to after."
+  (with-temp-buffer
+    (insert-file-contents file)
+    (let ((gen-specs (list (cons 'dummy t)
+                           (cons 'code transform))))
+      ;; The start of the "before" part starts with a form feed and then
+      ;; the name of the test.
+      (while (re-search-forward "^=-=\n" nil t)
+        (let* ((file-buffer (current-buffer))
+               (specs (ert--erts-specifications (match-beginning 0)))
+               (name (cdr (assq 'name specs)))
+               (start-before (point))
+               (end-after (if (re-search-forward "^=-=-=\n" nil t)
+                              (match-beginning 0)
+                            (point-max)))
+               end-before start-after
+               after after-point)
+          (goto-char end-after)
+          ;; We have a separate after section.
+          (if (re-search-backward "^=-=\n" start-before t)
+              (setq end-before (match-beginning 0)
+                    start-after (match-end 0))
+            (setq end-before end-after
+                  start-after start-before))
+          ;; Update persistent specs.
+          (when-let ((point-char (assq 'point-char specs)))
+            (setq gen-specs
+                  (map-insert gen-specs 'point-char (cdr point-char))))
+          (when-let ((code (cdr (assq 'code specs))))
+            (setq gen-specs
+                  (map-insert gen-specs 'code (car (read-from-string code)))))
+          ;; Get the "after" strings.
+          (with-temp-buffer
+            (insert-buffer-substring file-buffer start-after end-after)
+            (ert--erts-unquote)
+            ;; Remove the newline at the end of the buffer.
+            (when-let ((no-newline (cdr (assq 'no-after-newline specs))))
+              (goto-char (point-min))
+              (when (re-search-forward "\n\\'" nil t)
+                (delete-region (match-beginning 0) (match-end 0))))
+            ;; Get the expected "after" point.
+            (when-let ((point-char (cdr (assq 'point-char gen-specs))))
+              (goto-char (point-min))
+              (when (search-forward point-char nil t)
+                (delete-region (match-beginning 0) (match-end 0))
+                (setq after-point (point))))
+            (setq after (buffer-string)))
+          ;; Do the test.
+          (with-temp-buffer
+            (insert-buffer-substring file-buffer start-before end-before)
+            (ert--erts-unquote)
+            ;; Remove the newline at the end of the buffer.
+            (when-let ((no-newline (cdr (assq 'no-before-newline specs))))
+              (goto-char (point-min))
+              (when (re-search-forward "\n\\'" nil t)
+                (delete-region (match-beginning 0) (match-end 0))))
+            (goto-char (point-min))
+            ;; Place point in the specified place.
+            (when-let ((point-char (cdr (assq 'point-char gen-specs))))
+              (when (search-forward point-char nil t)
+                (delete-region (match-beginning 0) (match-end 0))))
+            (funcall (cdr (assq 'code gen-specs)))
+            (unless (equal (buffer-string) after)
+              (ert-fail (list (format "Mismatch in test \"%s\", file %s"
+                                      name file)
+                              (buffer-string)
+                              after)))
+            (when (and after-point
+                       (not (= after-point (point))))
+              (ert-fail (list (format "Point wrong in test \"%s\", expected 
point %d, actual %d, file %s"
+                                      name
+                                      after-point (point)
+                                      file)
+                              (buffer-string))))))))))
+
+(defun ert--erts-unquote ()
+  (goto-char (point-min))
+  (while (re-search-forward "^\\=-=\\(-=\\)$" nil t)
+    (delete-region (match-beginning 0) (1+ (match-beginning 0)))))
+
+(defun ert--erts-specifications (end)
+  "Find specifications before point (back to the previous test)."
+  (save-excursion
+    (goto-char end)
+    (goto-char
+     (if (re-search-backward "^=-=-=\n" nil t)
+         (match-end 0)
+       (point-min)))
+    (let ((specs nil))
+      (while (< (point) end)
+        (if (looking-at "\\([^ \n\t:]+\\):\\([ \t]+\\)?\\(.*\\)")
+            (let ((name (intern (downcase (match-string 1))))
+                  (value (match-string 3)))
+              (forward-line 1)
+              (while (looking-at "[ \t]+\\(.*\\)")
+                (setq value (concat value (match-string 1)))
+                (forward-line 1))
+              (push (cons name value) specs))
+          (forward-line 1)))
+      (nreverse specs))))
+
 (defvar ert-unload-hook ())
 (add-hook 'ert-unload-hook #'ert--unload-function)
 
diff --git a/lisp/files.el b/lisp/files.el
index 05875b4..50ca494 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2883,6 +2883,7 @@ 
ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" .
      ("\\.[ds]?va?h?\\'" . verilog-mode)
      ("\\.by\\'" . bovine-grammar-mode)
      ("\\.wy\\'" . wisent-grammar-mode)
+     ("\\.erts\\'" . erts-mode)
      ;; .emacs or .gnus or .viper following a directory delimiter in
      ;; Unix or MS-DOS syntax.
      ("[:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
diff --git a/lisp/progmodes/erts-mode.el b/lisp/progmodes/erts-mode.el
new file mode 100644
index 0000000..cf7eca5
--- /dev/null
+++ b/lisp/progmodes/erts-mode.el
@@ -0,0 +1,119 @@
+;;; erts-mode.el --- major mode to edit erts files  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Keywords: tools
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(defgroup erts-mode nil
+  "Major mode for editing Emacs test files."
+  :group 'lisp)
+
+(defface erts-mode-specification-name
+  '((((class color)
+      (background dark))
+     :foreground "green")
+    (((class color)
+      (background light))
+     :foreground "cornflower blue")
+    (t
+     :bold t))
+  "Face used for displaying specification names."
+  :group 'erts-mode)
+
+(defface erts-mode-specification-value
+  '((((class color)
+      (background dark))
+     :foreground "DeepSkyBlue1")
+    (((class color)
+      (background light))
+     :foreground "blue")
+    (t
+     :bold t))
+  "Face used for displaying specificaton values."
+  :group 'erts-mode)
+
+(defface erts-mode-start-test
+  '((t :inherit font-lock-keyword-face))
+  "Face used for displaying specificaton test start markers."
+  :group 'erts-mode)
+
+(defface erts-mode-end-test
+  '((t :inherit font-lock-comment-face))
+  "Face used for displaying specificaton test start markers."
+  :group 'erts-mode)
+
+(defvar erts-mode-map
+  (let ((map (make-keymap)))
+    (set-keymap-parent map prog-mode-map)
+    map))
+
+(defvar erts-mode-font-lock-keywords
+  ;; Specifications.
+  `((erts-mode--match-not-in-test
+     ("^\\([^ \t\n:]+:\\)[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?"
+      (progn (goto-char (match-beginning 0)) (match-end 0)) nil
+      (1 'erts-mode-specification-name)
+      (2 'erts-mode-specification-value)))
+    ("^=-=$" 0 'erts-mode-start-test)
+    ("^=-=-=$" 0 'erts-mode-end-test)))
+
+(defun erts-mode--match-not-in-test (_limit)
+  (when (erts-mode--in-test-p (point))
+    (erts-mode--end-of-test))
+  (let ((start (point)))
+    (goto-char
+     (if (re-search-forward "^=-=$" nil t)
+         (match-beginning 0)
+       (point-max)))
+    (if (< (point) start)
+        nil
+      ;; Here we disregard LIMIT so that we may extend the area again.
+      (set-match-data (list start (point)))
+      (point))))
+
+(defun erts-mode--end-of-test ()
+  (search-forward "^=-=-=\n" nil t))
+
+(defun erts-mode--in-test-p (point)
+  "Say whether POINT is in a test."
+  (save-excursion
+    (goto-char point)
+    (beginning-of-line)
+    (if (looking-at "=-=\\(-=\\)?$")
+        t
+      (let ((test-start (re-search-backward "^=-=\n" nil t)))
+        ;; Before the first test.
+        (and test-start
+             (let ((test-end (re-search-backward "^=-=-=\n" nil t)))
+               (or (null test-end)
+                   ;; Between tests.
+                   (> test-start test-end))))))))
+
+;;;###autoload
+(define-derived-mode erts-mode prog-mode "erts"
+  "Major mode for editing erts (Emacs testing) files.
+This mode mainly provides some font locking."
+  (setq-local font-lock-defaults '(erts-mode-font-lock-keywords t)))
+
+(provide 'erts-mode)
+
+;;; erts-mode.el ends here