emacs-elpa-diffs
[Top][All Lists]
Advanced

[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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]