[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/assess 1b01542ccd 20/95: Fontification testing.
From: |
ELPA Syncer |
Subject: |
[elpa] externals/assess 1b01542ccd 20/95: Fontification testing. |
Date: |
Tue, 19 Jul 2022 15:57:29 -0400 (EDT) |
branch: externals/assess
commit 1b01542ccda130109b134e9668857e45acbafc09
Author: Phillip Lord <phillip.lord@russet.org.uk>
Commit: Phillip Lord <phillip.lord@russet.org.uk>
Fontification testing.
---
sisyphus.el | 589 +++++++++++++++++++++++++++++++++++++++++++++-----
test/sisyphus-test.el | 221 +++++++++++++++++--
2 files changed, 746 insertions(+), 64 deletions(-)
diff --git a/sisyphus.el b/sisyphus.el
index ec61515286..3c290dbf53 100644
--- a/sisyphus.el
+++ b/sisyphus.el
@@ -28,21 +28,33 @@
;;; Commentary:
-;; This file will provide functions to support ert, including a set of
-;; predicates, some nicer reporter functions and so forth.
+;; This file provides functions to support ert, the Emacs Regression Test
+;; framework. It includes:
-;;; Thoughts:
-
-;; Really, all the functions in here should be tested. But some of the tests
are
-;; really, realy hard to test because they depend on the output of ert test,
+;; - a set of predicates for comparing strings, buffers and file contents.
+;; - explainer functions for all predicates giving useful output
+;; - macros for creating many temporary buffers at once, and for restoring the
+;; buffer list.
+;; - methods for testing indentation, by comparision or "roundtripping".
+;; - methods for testing fontification.
+;; Sisyphus aims to be a stateless as possible, leaving Emacs unchanged whether
+;; the tests succeed or fail, with respect to buffers, open files and so on;
this
+;; helps to keep tests independent from each other. Violations of this will be
+;; considered a bug.
+;; Sisyphus aims also to be as noiseless as possible, reducing and suppressing
+;; extraneous messages where possible, to leave a clean ert output in batch
mode.
+;; Sisyphus is currently a work in progress; the API is not currently stable.
+;; Even the name is somewhat is doubt. Sisyphus seemed like a good idea when I
+;; started, but I keep spelling it wrong. I may also considering winding this
+;; into ert-x, because then it can be used to test core.
;;; Code:
-;; ** Require
+;; ** Preliminaries
;; #+begin_src emacs-lisp
(require 'pp)
@@ -52,15 +64,23 @@
(require 'dash)
;; #+end_src
+;; We need an error symbol to throw occasionally during testing. Throwing
`error'
+;; itself is a bit dangerous because we might get that for other reasons; so we
+;; create a new symbol here.
+
;; #+begin_src emacs-lisp
-(define-error 'deliberate-error
+(define-error 'sisyphus-deliberate-error
"An error deliberately caused during testing."
'error)
;; #+end_src
-
;; ** Advice
+;; Emacs-24 insists on printing out results on a single line with escaped
+;; newlines. This does not work so well with the explainer functions in
sisyphus
+;; and, probably, does not make sense anywhere. So, we advice here.
+
+;; Emacs-25 has this fixed.
;; #+begin_src emacs-lisp
(when (= emacs-major-version 24)
@@ -75,38 +95,38 @@
#'sisyphus--ert-pp-with-indentation-and-newline))
;; #+end_src
+;; ** Types
-;; ** Explainers
-
-;; Explainer functions add "explainations" for things that fail. We can use
this
-;; to make `string=' work properly. Can we do this without diff?
-
-;; This is critical because most of our comparitors depend on this.
-
-;; So this works but the output is printed out as a string with slash-n's
-;; rather than as a multi-line string. Bollocks
-
-;; Think it is ert--pp-with-indentation-and-newline which is the evil function
-;; causing the problem. Which in turn backs onto pp.
-
-;; pp has a variable pp-escape-newlines which set to nil solves the problem.
-
-;; How do do this cleanly? Apply patch to ert.el?
+;; Many tests on files, buffers actually end up being string comparision. We
+;; introduce a set of "types" where so that we can distinguish between
+;; strings, buffer names and file names, passing them at a single parameter.
+;; This reduces the complexity of later parts of the API.
+;; "Types" are either a Emacs core type (as with buffers and strings), or an 2
+;; element list (I haven't used cons cells in case I want to add more
elements),
+;; with a keyword at the head. This allows sisyphus to distinguish between a
+;; simple string and a file or buffer name.
;; #+begin_src emacs-lisp
(defun sisyphus-to-string (x)
- "Turn X into a string in a type appropriate way."
+ "Turn X into a string in a type appropriate way.
+
+If X is identified as a file, returns the file contents.
+If X is identified as a buffer, returns the buffer contents.
+If X is a string, returns that.
+
+See also `sisyphus-buffer' and `sisyphus-file' which turn a
+string into something that will identified appropriately."
(pcase x
- ((pred stringp) x)
- ((pred bufferp) (m-buffer-at-string x))
- (`(:buffer ,b) (sisyphus-to-string (get-buffer-create b)))
- (`(:file ,f)
- (with-temp-buffer
- (insert-file-contents f)
- (buffer-string)))
- ;; error condition
- (_ (error "Type not recognised"))))
+ ((pred stringp) x)
+ ((pred bufferp) (m-buffer-at-string x))
+ (`(:buffer ,b) (sisyphus-to-string (get-buffer-create b)))
+ (`(:file ,f)
+ (with-temp-buffer
+ (insert-file-contents f)
+ (buffer-string)))
+ ;; error condition
+ (_ (error "Type not recognised"))))
(defun sisyphus-buffer (b)
"Add type data to the string B marking it as a buffer."
@@ -115,9 +135,37 @@
(defun sisyphus-file (f)
"Add type data to the string F marking it as a file."
`(:file ,f))
+
+(defun sisyphus-to-file-name (file)
+ "Return file name for FILE.
+
+FILE can be either a string, or a plist returned by
+`sisyphus-file' or `sisyphus-make-related-file'."
+ (pcase file
+ ((pred stringp) file)
+ (`(:file ,f) f)
+ (_ (error "Type not recognised"))))
;; #+end_src
-;; *** String Comparision
+;; *** Entity Comparision
+
+;; In this section, we provide support for comparing strings, buffer or file
+;; contents. The main entry point is `sisyphus=', which works like `string='
but
+;; on any of the three data types, in any order.
+
+;; In addition, `sisyphus=' has an "explainer" function attached which
produces a
+;; richer output when `sisyphus=' returns false, showing diffs of the string
+;; comparison. As `sisyphus=' has a compatible interface with `string=' it is
+;; also possible to add this explainer function to `string=' for use with
+;; tests which do not otherwise use sisyphus.
+
+;; Currently, `sisyphus' uses the ~diff~ program to do the comparison if it is
+;; available, or falls back to just reporting a difference -- this could do
with
+;; improving, but it is at least no worse than the existing behaviour for
+;; string comparison.
+
+;; We start by writing a file silently -- this is important because the
+;; ~*Messages*~ buffer should not be affected by the machinary of a failing
test.
;; #+begin_src emacs-lisp
(defun sisyphus--write-file-silently (filename)
@@ -128,9 +176,20 @@ print any messages!"
(point-min) (point-max)
filename nil
'dont-display-wrote-file-message))
+;; #+end_src
+;; Diff does a nicer comparison than anything in Emacs, although a lisp should
+;; would have been more portable. Currently, we leave the files in place; the
+;; original idea of this was to enable further comparison, but it does create a
+;; lot of temporary files for the average test run, so it might need to be
+;; reconsidered.
+
+;; #+begin_src emacs-lisp
(defun sisyphus--explainer-diff-string= (a b)
- "Compare strings using diff output."
+ "Compare strings A and B using diff output.
+
+We assume that diff exists. Temporary files are left
+afterwards for cleanup by the operating system."
(sisyphus-with-preserved-buffer-list
(let* ((diff
(executable-find "diff"))
@@ -152,7 +211,7 @@ print any messages!"
b-buffer
(insert b)
(sisyphus--write-file-silently b-file))
- (prog1
+ (progn
(format "Strings:\n%s\nand\n%s\nDiffer at:%s\n"
a b
(with-temp-buffer
@@ -172,7 +231,11 @@ print any messages!"
"Compare strings for first difference."
;; We could do a bit more here.
(format "String :%s:%s: are not equal."))
+;; #+end_src
+
+;; And the actual predicate function and explainer.
+;; #+begin_src emacs-lisp
(defun sisyphus= (a b)
"Compare A and B to see if they are the same.
@@ -186,7 +249,9 @@ contents and so on."
(defun sisyphus-explain= (a b)
"Compare A and B and return an explanation.
-See `sisyphus=' for more information."
+
+This function is called by ERT as an explainer function
+automatically. See `sisyphus=' for more information."
(let ((a (sisyphus-to-string a))
(b (sisyphus-to-string b)))
(cond
@@ -201,7 +266,22 @@ See `sisyphus=' for more information."
;; #+end_src
-;; ** create buffers
+;; ** Buffer creation
+
+;; For tests, it is often better to use temporary buffers for two reasons, as
it
+;; is much less affected by the existing state of Emacs; this is particularly
the
+;; case where tests are being developed as the developer may be trying to
change
+;; or write test files.
+
+;; Emacs really only provides a single primitive `with-temp-buffer' for this
+;; situation, and that only creates a single temporary buffer at a time.
Nesting
+;; of these forms sometimes works, but fails if we need to operate on two
buffers
+;; at once.
+
+;; So, we provide an environment for restoring the buffer list, and another for
+;; creating multiple temporary buffers and binding them to variables.
+
+;; #+begin_src emacs-lisp
(defmacro sisyphus-with-preserved-buffer-list (&rest body)
"Evaluate BODY, but delete any buffers that have been created."
(declare (debug t))
@@ -224,15 +304,23 @@ See `sisyphus=' for more information."
(generate-new-buffer "sisyphus-with-temp-buffers")
,@(cdr item)
(current-buffer)))))
+;; #+end_src
+;; The implementation of `sisyphus-with-temp-buffers' currently uses
+;; `sisyphus-with-preserved-buffer-list' to remove buffers which means that it
+;; will also delete any buffers created by the user; this may be a mistake, and
+;; it might be better to delete the relevant buffers explicitly.
+
+;; #+begin_src emacs-lisp
(defmacro sisyphus-with-temp-buffers (varlist &rest body)
"Bind variables in varlist to temp buffers, then eval BODY.
VARLIST is of the same form as a `let' binding. Each element is a
symbol or a list (symbol valueforms). Each symbol is bound to a
buffer generated with `generate-new-buffer'. VALUEFORMS are
-evaluated with the buffer current. Buffers are unconditionally
-killed at the end of the form."
+evaluated with the buffer current. Any buffers created inside
+this form (and not just by this form!) are unconditionally killed
+at the end of the form."
(declare (indent 1)
(debug let))
(let ((let-form
@@ -243,15 +331,117 @@ killed at the end of the form."
(let ,let-form
,@body))))
-;; ** Open files
+(defmacro sisyphus-as-temp-buffer (x &rest body)
+ "Insert X in a type-appropriate way into a temp buffer and eval
+BODY there.
+
+See `sisyphus-to-string' for the meaning of type-appropriate."
+ (declare (indent 1) (debug t))
+ `(with-temp-buffer
+ (insert (sisyphus-to-string ,x))
+ ,@body))
+;; #+end_src
+
+;; ** Opening files
+
+;; Opening files presents a particular problem for testing, particularly if we
+;; open a file that is already open in the same or a different Emacs. For batch
+;; use of Emacs with parallelisation, the situation becomes intractable.
+
+;; A solution is to copy files before we open them, which means that they can
be
+;; changed freely. Largely the copied file will behave the same as the main
file;
+;; the only notable exception to this is those features which depend on the
+;; current working directory (dir-local variables, for example).
+
+;; We also add support here for the types introduced earlier, which is mostly
so
+;; that they do not get in the way.
+
+;; #+begin_src emacs-lisp
+(defun sisyphus--make-related-file-1 (file &optional directory)
+ (make-temp-file
+ (concat
+ (or directory
+ temporary-file-directory)
+ (file-name-nondirectory file))
+ nil
+ (concat "."
+ (file-name-extension file))))
+
+(defun sisyphus-make-related-file (file &optional directory)
+ "Open a copy of FILE in DIRECTORY.
+
+FILE is copied to a temporary file in DIRECTORY or
+`temporary-file-directory'. The copy has a unique name but shares
+the same file extension.
+
+This is useful for making test changes to FILE without actually
+altering it."
+ (let* ((file (sisyphus-to-file-name file))
+ (related-file
+ (sisyphus--make-related-file-1 file directory)))
+ (copy-file file related-file t)
+ (sisyphus-file
+ related-file)))
+;; #+end_src
+
+;; We also need the ability to open a file in the same way as it would in a
more
+;; interactive environment. We make some efforts to maintain the open-or-closed
+;; status of the file and restore this at the end, but this may still result in
+;; some strangeness if, for example, a file is already open in a buffer and has
+;; been changed. This can be avoided through the use of
+;; `sisyphus-make-related-file'.
+
+;; #+begin_src emacs-lisp
+
+(defmacro sisyphus-with-find-file (file &rest body)
+ "Open FILE and evaluate BODY in resultant buffer.
+
+FILE is opened with `find-file-noselect' so all the normal hooks
+for file opening should occur. The buffer is killed after the
+macro exits, unless it was already open. This happens
+unconditionally, even if the buffer has changed.
+
+See also `sisyphus-make-related-file'."
+ (declare (debug t) (indent 1))
+ (let ((temp-buffer (make-symbol "temp-buffer"))
+ (file-has-buffer-p (make-symbol "file-has-buffer-p"))
+ (file-s (make-symbol "file")))
+ `(let* ((,file-s ,file)
+ (,file-s (sisyphus-to-file-name ,file-s))
+ (,file-has-buffer-p
+ (find-buffer-visiting ,file-s))
+ (,temp-buffer))
+ (unwind-protect
+ (with-current-buffer
+ (setq ,temp-buffer
+ (find-file-noselect ,file-s))
+ ,@body)
+ (when
+ ;; kill the buffer unless it was already open.
+ (and (not ,file-has-buffer-p)
+ (buffer-live-p ,temp-buffer))
+ ;; kill unconditionally
+ (with-current-buffer ,temp-buffer
+ (set-buffer-modified-p nil))
+ (kill-buffer ,temp-buffer))))))
+;; #+end_src
-;; Again, same issues -- what if the file is already open. Especially if are
-;; going to save it.
;; ** Indentation functions
-;; This is largely a re--implementation of `indent-region' but without the
-;; noise.
+;; There are two main ways to test indentation -- we can either take unindented
+;; text, indent it, and then compare it to something else; or, we can roundtrip
+;; -- take indented code, unindent it, re-indent it again and see whether we
end
+;; up with what we started. Sisyphus supports both of these.
+
+;; Additionally, there are two different ways to specific a mode -- we can
either
+;; define it explicitly or, if we are opening from a file, we can use the
normal
+;; `auto-mode-alist' functionality to determine the mode. Sisyphus supports
both
+;; of these also.
+
+;; We start with some functionality for making Emacs quiet while indenting.
+
+;; #+begin_src emacs-lisp
(defun sisyphus--indent-buffer ()
(cond
;; if indent-region-function is set, use it, and hope that it is not
@@ -293,12 +483,311 @@ Both UNINDENTED and INDENTED can be any value usable by
(put 'sisyphus-indentation= 'ert-explainer 'sisyphus-explain-indentation=)
-;; Set mode, indent normally, then compare
+;; TODO -- this bit is noisy and we need to stop it being so
+(defun sisyphus--buffer-unindent (buffer)
+ (with-current-buffer
+ buffer
+ (indent-region (point-min) (point-max) nil)))
+
+(defun sisyphus--roundtrip-1 (comp mode indented)
+ (with-temp-buffer
+ (funcall comp
+ mode
+ (progn
+ (insert
+ (sisyphus-to-string indented))
+ (sisyphus--buffer-unindent (current-buffer))
+ (buffer-string))
+ indented)))
+
+(defun sisyphus-roundtrip-indentation= (mode indented)
+ (sisyphus--roundtrip-1
+ #'sisyphus-indentation=
+ mode indented))
+
+(defun sisyphus-explain-roundtrip-indentation= (mode indented)
+ (sisyphus--roundtrip-1
+ #'sisyphus-explain-indentation=
+ mode indented))
+
+(put 'sisyphus-roundtrip-indentation=
+ 'ert-explainer
+ 'sisyphus-explain-roundtrip-indentation=)
+
+(defun sisyphus--file-roundtrip-1 (comp file)
+ (funcall
+ comp
+ (sisyphus-with-find-file
+ (sisyphus-make-related-file file)
+ (sisyphus--buffer-unindent (current-buffer))
+ (sisyphus--indent-buffer)
+ (buffer-string))
+ file))
+
+(defun sisyphus-file-roundtrip-indentation= (file)
+ (sisyphus--file-roundtrip-1
+ #'sisyphus= file))
+
+(defun sisyphus-explain-file-roundtrip-indentation= (file)
+ (sisyphus--file-roundtrip-1
+ #'sisyphus-explain= file))
+;; #+end_src
+
+;; #+begin_src emacs-lisp
+(put 'sisyphus-file-roundtrip-indentation=
+ 'ert-explainer
+ 'sisyphus-explain-file-roundtrip-indentation=)
+;; #+end_src
+
+
;; ** Font-lock support functions
;; Set up a buffer from string or file, font-lock it, test it.
+;; We need to define some functionality for testing font-lock.
+
+;; API below -- so we can define functionality that works generally over a
list,
+;; and automatically coerce an item to a list.
+
+
+;; #+begin_src elisp
+;; ;; location or marker
+;; (sisyphus-font-at=
+;; 'file-buffer-or-string
+;; 200
+;; 'font-lock-comment-face)
+
+;; ;; string
+;; (sisyphus-font-at=
+;; 'file-buffer-or-string
+;; "Class"
+;; 'font-lock-type-face)
+
+;; ;; regexp match
+;; (sisyphus-font-at=
+;; 'file-buffer-or-string
+;; (sisyphus-match regexp subexp)
+;; 'font-lock-comment-face)
+
+;; ;; all location checks
+;; (sisyphus-font-at=
+;; 'file-buffer-or-string
+;; '(100 200 300)
+;; 'font-lock-comment-face)
+
+;; ;; The last argument should be listifiable also
+;; (sisyphus-font-at=
+;; 'file-buffer-or-string
+;; '(100 200 300)
+;; '(font-lock-comment-face font-lock-type-face font-lock-comment-face))
+;; #+end_src
+
+;; m-buffer-match should work perfectly well as in the second position, except
+;; that it requires a buffer be passed, and we don't have it -- it will be a
+;; temporary buffer. If we add support for nil as the buffer to
sisyphus-font-at=
+;; we can get away with this. Don't need to nil markers because we kill the
+;; buffer anyway.
+
+;; This looks okay, but there is a lot of boilerplate here that I do not like.
+;; Second option rather cuts that down.
+
+;; #+begin_src elisp
+;; (sisyphus-with-temp-buffer
+;; (a (insert-string
+;; (sisyphus-to-string 'file-buffer-or-string)))
+;; (sisyphus-font-at=
+;; nil
+;; (m-buffer-match a "bob")
+;; '(font-lock-comment-face)))
+
+;; ;; We could add a new macro like so...
+;; (sisyphus-as-current-buffer
+;; 'file-buffer-or-string
+;; (sisyphus-font-at=
+;; nil
+;; (m-buffer-match (current-buffer) "bob")
+;; '(font-lock-comment-face)))
+;; #+end
+
+;; but the implementation of this is a total pain in the ass because I have to
+;; use with-temp-buffer. And it doesn't work for the find file. The only thing
+;; that I can sanely do is to pass in a function which take
+
+;; (sisyphus-file-face-at=
+;; "bob.el"
+;; (lambda (buffer)
+;; (m-buffer-match :buffer buffer "defun")))
+
+
+(defun sisyphus--face-at-location=
+ (location face property throw-on-nil)
+ ;; it's match data
+ (if (listp location)
+ ;; We need to test every point but not the last because the match is
+ ;; passed the end.
+ (let ((all nil))
+ (cl-loop for i from
+ (marker-position (car location))
+ below
+ (marker-position (cadr location))
+ do
+ (setq all
+ (cons (sisyphus--face-at-location=
+ i face
+ property throw-on-nil)
+ all)))
+ (-every? #'identity all))
+ (let* ((local-faces
+ (get-text-property location property))
+ (rtn
+ ;; for face this can be one of -- a face name (a symbol or string)
+ ;; a list of faces, or a plist of face attributes
+ (pcase local-faces
+ ;; compare directly
+ ((pred symbolp)
+ (eq face local-faces))
+ ;; give up -- we should probably be able to compare the plists
here.
+ ((and `(,s . ,_)
+ (guard (keywordp s)))
+ nil)
+ ;; compare that we have at least this.
+ ((and `(,s . ,_)
+ (guard (symbolp s)))
+ (member face s)))))
+ (if (and throw-on-nil
+ (not rtn))
+ (throw
+ 'face-non-match
+ (format "Face does not match expected value
+\tExpected: %s
+\tActual: %s
+\tLocation: %s
+\tLine Context: %s
+\tbol Position: %s
+"
+ face local-faces location
+ (thing-at-point 'line)
+ (m-buffer-at-line-beginning-position
+ (current-buffer) location)))
+ rtn))))
+
+
+(defun sisyphus--face-at=
+ (buffer locations faces property throw-on-nil)
+ (let* (
+ ;; default property
+ (property (or property 'face))
+ ;; make sure we have a list of locations
+ (locations
+ (pcase locations
+ ((pred functionp)
+ (funcall locations buffer))
+ ((pred listp)
+ locations)
+ (_ (list locations))))
+ (first-location
+ (car locations))
+ ;; make sure we have a list of markers
+ (locations
+ (cond
+ ((integerp first-location)
+ (m-buffer-pos-to-marker buffer locations))
+ ((stringp first-location)
+ ;; this function does not exist yet -- should find the first
+ ;; occurance of exactly the first string, then the first
+ ;; occurrence of the next and so on
+ (m-buffer-find-string buffer locations))
+ ;; markers
+ ((markerp first-location)
+ locations)
+ ;; match data
+ ((and (listp first-location)
+ (markerp (car first-location)))
+ locations)))
+ ;; make sure we have a list of faces
+ (faces
+ (if (listp faces)
+ faces
+ (list faces)))
+ ;; make sure faces is as long as locations
+ (faces
+ (if (> (length locations)
+ (length faces))
+ (-cycle faces)
+ faces)))
+ (--every?
+ (sisyphus--face-at-location=
+ (car it) (cdr it) property throw-on-nil)
+ (-zip-pair locations faces))))
+
+(defun sisyphus--face-at=-1 (x mode locations faces property throw-on-nil)
+ (with-temp-buffer
+ (insert (sisyphus-to-string x))
+ (funcall mode)
+ (font-lock-fontify-buffer)
+ ;; do not forget to remove this!
+ (switch-to-buffer (current-buffer))
+ (sisyphus--face-at= (current-buffer) locations faces property
throw-on-nil)))
+
+(defun sisyphus-face-at=
+ (x mode locations faces &optional property)
+ "Return non-nil if in X with MODE at MARKERS, FACES are present on PROPERTY.
+
+This function tests if one or more faces are present at specific
+locations in some text. It operates over single or multiple
+values for both locations and faces; if there are more locations
+than faces, then faces will be cycled over. If locations are
+match data, then each the beginning and end of each match are
+tested against each face.
+
+X can be a buffer, file name or string -- see
+`sisyphus-to-string' for details.
+
+MODE is the major mode with which to fontify X -- actually, it
+will just be a function called to initialize the buffer.
+
+LOCATIONS can be either one or a list of the following things:
+integer positions in X; markers in X (or nil!); match data in X;
+or strings which match X. If this is a list, all items in list
+should be of the same type.
+
+FACES can be one or more faces.
+
+PROPERTY is the text property on which to check the faces.
+
+See also `sisyphus-to-string' for treatment of the parameter X.
+
+See `sisyphus-file-face-at=' for a similar function which
+operates over files and takes the mode from that file."
+ (sisyphus--face-at=-1 x mode locations faces property nil))
+
+(defun sisyphus-explain-face-at=
+ (x mode locations faces &optional property)
+ (catch 'face-non-match
+ (sisyphus--face-at=-1 x mode locations faces property t)))
+
+(put 'sisyphus-face-at=
+ 'ert-explainer
+ 'sisyphus-explain-face-at=)
+
+(defun sisyphus--file-face-at=-1 (file locations faces property throw-on-nil)
+ (sisyphus-with-find-file
+ (sisyphus-make-related-file file)
+ (font-lock-fontify-buffer)
+ (sisyphus--face-at= (current-buffer) locations faces property
throw-on-nil)))
+
+(defun sisyphus-file-face-at= (file locations faces &optional property)
+ (sisyphus--file-face-at=-1 file locations faces property nil))
+
+(defun sisyphus-explain-file-face-at= (file locations faces &optional property)
+ (catch 'face-non-match
+ (sisyphus--file-face-at=-1 file locations faces property t)))
+
+(put 'sisyphus-file-face-at=
+ 'ert-explainer
+ 'sisyphus-explain-file-face-at=)
+
;; ** Pre/post command support functions
;; Not sure how I can test these better -- but worth thinking about -- I guess
do
@@ -306,9 +795,7 @@ Both UNINDENTED and INDENTED can be any value usable by
;; #+begin_src emacs-lisp
(provide 'sisyphus)
+;;; sisyphus.el ends here
;; #+end_src
-;; #+begin_src emacs-lisp
-;;; sisyphus.el ends here
-;; #+end_src
diff --git a/test/sisyphus-test.el b/test/sisyphus-test.el
index e65b9fa99e..ce1de3cc7b 100644
--- a/test/sisyphus-test.el
+++ b/test/sisyphus-test.el
@@ -1,24 +1,41 @@
+;;; sisyphus-test.el --- Tests for sisyphus.el -*- lexical-binding: t -*-
+
+;;; Header:
+
;; The contents of this file are subject to the GPL License, Version 3.0.
-;;
+
;; Copyright (C) 2015, Phillip Lord, Newcastle University
-;;
+
;; This program 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.
-;;
+
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+;; ** Requires
+
+;; #+begin_src emacs-lisp
(require 'load-relative)
(require 'sisyphus)
(require 'cl-lib)
+;; #+end_src
+;; ** Test Extraction
+
+;; Sisyphus supports tests functions which means that we need the ability to
test
+;; tests. This code simple extracts knowledge from the results of tests.
+
+;; #+begin_src emacs-lisp
(defun sisyphus-test--plist-from-result (result)
(cl-cdadr
(ert-test-result-with-condition-condition result)))
@@ -52,13 +69,6 @@ This also tests the advice on string=."
(should
(sisyphus= "1" "2"))))))))
-(ert-deftest sisyphus-test--string= ()
- "Test that string= works after explanation added."
- (should
- (string= "1" "1"))
- (should-not
- (string= "1" "2")))
-
(defun sisyphus-test--explanation (f)
(sisyphus-test--explanation-from-result
(ert-run-test
@@ -73,7 +83,12 @@ This also tests the advice on string=."
(lambda ()
(should
(sisyphus= "1" "2"))))))
+;; #+end_src
+
+;; ** To-String testing
+
+;; #+begin_src emacs-lisp
(defvar sisyphus-test-hello.txt
(sisyphus-file
(relative-expand-file-name "../dev-resources/hello.txt")))
@@ -105,6 +120,12 @@ This also tests the advice on string=."
(should-error
(sisyphus-to-string :hello)))
+;; #+end_src
+
+;; ** Compare Buffer to String
+
+;; #+begin_src emacs-lisp
+
(ert-deftest buffer-string= ()
(with-temp-buffer
(insert "hello")
@@ -128,6 +149,12 @@ This also tests the advice on string=."
(current-buffer)
"hello")))))))
+;; #+end_src
+
+;; ** Buffer to Buffer
+
+;; #+begin_src emacs-lisp
+
(ert-deftest buffer= ()
(sisyphus-with-temp-buffers
((a
@@ -154,6 +181,11 @@ This also tests the advice on string=."
(sisyphus=
a b)))))))
+;; #+end_src
+
+;; ** Buffer to file
+
+;; #+begin_src emacs-lisp
(ert-deftest file-string= ()
(should
(sisyphus=
@@ -172,6 +204,12 @@ This also tests the advice on string=."
"goodbye"))))))
+;; #+end_src
+
+;; ** Preserved Buffer List and With Temp Buffers
+
+;; #+begin_src emacs-lisp
+
(ert-deftest preserved-buffer-list ()
(should
(=
@@ -187,8 +225,8 @@ This also tests the advice on string=."
(condition-case e
(sisyphus-with-preserved-buffer-list
(generate-new-buffer "preserved-buffer-list")
- (signal 'deliberate-error nil))
- (deliberate-error
+ (signal 'sisyphus-deliberate-error nil))
+ (sisyphus-deliberate-error
(length (buffer-list)))))))
(ert-deftest with-temp-buffers ()
@@ -220,6 +258,40 @@ This also tests the advice on string=."
(sisyphus-with-temp-buffers (a b))
(length (buffer-list))))))
+;; #+end_src
+
+;; ** Open Close files
+
+;; #+begin_src emacs-lisp
+
+(ert-deftest sisyphus-test-related-file ()
+ (should
+ (file-exists-p
+ (sisyphus-to-file-name
+ (sisyphus-make-related-file sisyphus-test-hello.txt))))
+ (should
+ (sisyphus=
+ sisyphus-test-hello.txt
+ (sisyphus-make-related-file sisyphus-test-hello.txt))))
+
+(ert-deftest sisyphus-test-with-find-file ()
+ (should
+ (sisyphus-with-find-file
+ (sisyphus-make-related-file sisyphus-test-hello.txt)))
+ (should-not
+ (sisyphus=
+ sisyphus-test-hello.txt
+ (sisyphus-with-find-file
+ (sisyphus-make-related-file sisyphus-test-hello.txt)
+ (insert "hello")
+ (buffer-string)))))
+
+;; #+end_src
+
+;; ** Indentation Tests
+
+;; #+begin_src emacs-lisp
+
(ert-deftest sisyphus--test-indent-in-mode ()
(should
(sisyphus=
@@ -255,3 +327,126 @@ This also tests the advice on string=."
'emacs-lisp-mode
"hello"
"goodbye"))))))
+
+
+(defvar sisyphus-dev-resources
+ (relative-expand-file-name "../dev-resources/"))
+
+(defvar sisyphus-dev-elisp-indented
+ (sisyphus-file
+ (concat sisyphus-dev-resources
+ "elisp-indented.el")))
+
+(defvar sisyphus-dev-elisp-unindented
+ (sisyphus-file
+ (concat sisyphus-dev-resources
+ "elisp-unindented.el")))
+
+(ert-deftest sisyphus-test-roundtrip-indentation= ()
+ (should
+ (sisyphus-roundtrip-indentation=
+ 'emacs-lisp-mode
+ sisyphus-dev-elisp-indented))
+ (should-not
+ (sisyphus-roundtrip-indentation=
+ 'emacs-lisp-mode
+ sisyphus-dev-elisp-unindented)))
+
+(ert-deftest sisyphus-test-roundtrip-indentation-explain= ()
+ (should
+ (sisyphus-test--explanation
+ (lambda ()
+ (should
+ (sisyphus-roundtrip-indentation=
+ 'emacs-lisp-mode
+ sisyphus-dev-elisp-unindented))))))
+
+(ert-deftest sisyphus-test-file-roundtrip-indentation= ()
+ (should
+ (sisyphus-file-roundtrip-indentation=
+ sisyphus-dev-elisp-indented))
+ (should-not
+ (sisyphus-file-roundtrip-indentation=
+ sisyphus-dev-elisp-unindented)))
+
+
+(ert-deftest sisyphus-test-file-roundtrip-indentation-explain= ()
+ (should
+ (sisyphus-test--explanation
+ (lambda ()
+ (should
+ (sisyphus-file-roundtrip-indentation=
+ sisyphus-dev-elisp-unindented))))))
+
+;; ** Face Tests
+(defvar sisyphus-dev-elisp-fontified
+ (sisyphus-file
+ (concat sisyphus-dev-resources
+ "elisp-fontified.el")))
+
+(ert-deftest sisyphus-test-face-at-simple ()
+ (should
+ (sisyphus-face-at=
+ "(defun x ())"
+ 'emacs-lisp-mode
+ 2
+ 'font-lock-keyword-face))
+ (should-not
+ (sisyphus-face-at=
+ "(not-defun x ())"
+ 'emacs-lisp-mode
+ 2
+ 'font-lock-keyword-face)))
+
+
+(ert-deftest sisyphus-test-face-at-multiple-positions ()
+ (should
+ (sisyphus-face-at=
+ "(defun x ())
+(defun y ())
+(defun z ())"
+ 'emacs-lisp-mode
+ '(2 15 28)
+ 'font-lock-keyword-face))
+ (should-not
+ (sisyphus-face-at=
+ "(defun x ())
+(defun y ())
+(not-defun z ())"
+ 'emacs-lisp-mode
+ '(2 15 28)
+ 'font-lock-keyword-face)))
+
+(ert-deftest sisyphus-test-face-at-multiple-faces ()
+ (should
+ (sisyphus-face-at=
+ "(defun x ())"
+ 'emacs-lisp-mode
+ '(2 8)
+ '(font-lock-keyword-face font-lock-function-name-face)))
+ (should-not
+ (sisyphus-face-at=
+ "(defun x ())"
+ 'emacs-lisp-mode
+ '(2 10)
+ '(font-lock-keyword-face font-lock-function-name-face))))
+
+(ert-deftest sisyphus-test-face-at-with-m-buffer ()
+ (should
+ (sisyphus-face-at=
+ "(defun x ())\n(defun y ())\n(defun z ())"
+ 'emacs-lisp-mode
+ (lambda(buf)
+ (m-buffer-match buf "defun"))
+ 'font-lock-keyword-face)))
+
+(ert-deftest sisyphus-test-file-face-at ()
+ (should
+ (sisyphus-file-face-at=
+ sisyphus-dev-elisp-fontified
+ (lambda (buffer)
+ (m-buffer-match buffer "defun"))
+ 'font-lock-keyword-face)))
+
+
+;; #+end_src
- [elpa] externals/assess 2db9834e4e 44/95: Rework Makefile for update to cask, (continued)
- [elpa] externals/assess 2db9834e4e 44/95: Rework Makefile for update to cask, ELPA Syncer, 2022/07/19
- [elpa] externals/assess e820ccf163 05/95: Emacs 24.4 or later., ELPA Syncer, 2022/07/19
- [elpa] externals/assess 3f89d8601f 15/95: Port tests to sisyphus with-temp-buffers., ELPA Syncer, 2022/07/19
- [elpa] externals/assess acb460e26c 16/95: All git-snapshot., ELPA Syncer, 2022/07/19
- [elpa] externals/assess 2e42c93191 06/95: Remove debug statement., ELPA Syncer, 2022/07/19
- [elpa] externals/assess eb56d9627d 07/95: String diff file save is now silent., ELPA Syncer, 2022/07/19
- [elpa] externals/assess a459abe966 11/95: New macro `sisyphus-with-preserved-buffer-list'., ELPA Syncer, 2022/07/19
- [elpa] externals/assess 33b6c3c390 12/95: New macro `sisyphus-with-temp-buffers'., ELPA Syncer, 2022/07/19
- [elpa] externals/assess 890906bfcb 17/95: Interface written as single overloaded function., ELPA Syncer, 2022/07/19
- [elpa] externals/assess f3416dadb1 18/95: Indentation test functions., ELPA Syncer, 2022/07/19
- [elpa] externals/assess 1b01542ccd 20/95: Fontification testing.,
ELPA Syncer <=
- [elpa] externals/assess 2e556a62ae 22/95: Add new test file., ELPA Syncer, 2022/07/19
- [elpa] externals/assess 32a00524a8 24/95: Fix unused variable issues, ELPA Syncer, 2022/07/19
- [elpa] externals/assess 3cf57afcaf 26/95: Merge pull request #1 from syohex/fix, ELPA Syncer, 2022/07/19
- [elpa] externals/assess 00c794a516 29/95: Add package support., ELPA Syncer, 2022/07/19
- [elpa] externals/assess f490f18a18 32/95: Merge branch 'master' of github.com:phillord/sisyphus, ELPA Syncer, 2022/07/19
- [elpa] externals/assess 0d079db1a7 34/95: Completed documentation., ELPA Syncer, 2022/07/19
- [elpa] externals/assess cab9fea7b8 28/95: Documentation for everything, ELPA Syncer, 2022/07/19
- [elpa] externals/assess f521db4101 36/95: Add sisyphus-discover, ELPA Syncer, 2022/07/19
- [elpa] externals/assess 46290f163d 37/95: Add tests for discover., ELPA Syncer, 2022/07/19
- [elpa] externals/assess 38fc7829bc 42/95: Interpret nil to mean no faces., ELPA Syncer, 2022/07/19