From 1a653209030279aa03898f647376f768f5d1e9f2 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 1 Oct 2021 12:17:47 +0200 Subject: [PATCH] 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(+) create mode 100644 lisp/progmodes/erts-mode.el diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index 19f2d7d609c..6604829b2b3 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 04b690806d9..cf3c8b6eb0b 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 72fe19461f7..204ccf5858a 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 05875b48e39..50ca49409f1 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 00000000000..cf7eca50c5d --- /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 . + +;;; 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 -- 2.39.5