[elpa] master 3e3141f 09/47: Refactor elisp tests to use visual assertions.

[Jackson Ray Hamilton]

branch: master
commit 3e3141fd99a4a8662a1ed5777d0e8262a279974c
Author: Jackson Ray Hamilton <address@hidden>
Commit: Jackson Ray Hamilton <address@hidden>

    Refactor elisp tests to use visual assertions.
---
 test/context-coloring-test.el |  163 +++++++++++++++++++++++++++--------------
 test/fixtures/lambda.el       |    4 +-
 2 files changed, 110 insertions(+), 57 deletions(-)

diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 8e5b699..93e0517 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -186,6 +186,87 @@ environment."
 
 ;;; Assertion functions
 
+(defun context-coloring-test-assert-position-level (position level)
+  "Assert that POSITION has LEVEL."
+  (let ((face (get-text-property position 'face))
+        actual-level)
+    (when (not (and face
+                    (let* ((face-string (symbol-name face))
+                           (matches (string-match
+                                     context-coloring-level-face-regexp
+                                     face-string)))
+                      (when matches
+                        (setq actual-level (string-to-number
+                                            (substring face-string
+                                                       (match-beginning 1)
+                                                       (match-end 1))))
+                        (= level actual-level)))))
+      (ert-fail (format (concat "Expected level at position %s, "
+                                "which is \"%s\", to be %s; "
+                                "but it was %s")
+                        position
+                        (buffer-substring-no-properties position (1+ 
position)) level
+                        actual-level)))))
+
+(defun context-coloring-test-assert-position-face (position face-regexp)
+  "Assert that the face at POSITION satisfies FACE-REGEXP."
+  (let ((face (get-text-property position 'face)))
+    (when (or
+           ;; Pass a non-string to do an `eq' check (against a symbol or nil).
+           (unless (stringp face-regexp)
+             (not (eq face-regexp face)))
+           ;; Otherwise do the matching.
+           (when (stringp face-regexp)
+             (not (string-match-p face-regexp (symbol-name face)))))
+      (ert-fail (format (concat "Expected face at position %s, "
+                                "which is \"%s\", to be %s; "
+                                "but it was %s")
+                        position
+                        (buffer-substring-no-properties position (1+ 
position)) face-regexp
+                        face)))))
+
+(defun context-coloring-test-assert-position-comment (position)
+  (context-coloring-test-assert-position-face
+   position "\\`font-lock-comment\\(-delimiter\\)?-face\\'"))
+
+(defun context-coloring-test-assert-position-string (position)
+  (context-coloring-test-assert-position-face position 'font-lock-string-face))
+
+(defun context-coloring-test-assert-coloring (map)
+  "Assert that the current buffer's coloring matches MAP."
+  ;; Omit the superfluous, formatting-related leading newline.
+  (save-excursion
+    (goto-char (point-min))
+    (let* ((map (substring map 1))
+           (index 0)
+           char-string
+           char)
+      (while (< index (length map))
+        (setq char-string (substring map index (1+ index)))
+        (setq char (string-to-char char-string))
+        (cond
+         ;; Newline
+         ((= char 10)
+          (next-logical-line)
+          (beginning-of-line))
+         ;; Number
+         ((and (>= char 48)
+               (<= char 57))
+          (context-coloring-test-assert-position-level
+           (point) (string-to-number char-string))
+          (forward-char))
+         ;; ';' = Comment
+         ((= char 59)
+          (context-coloring-test-assert-position-comment (point))
+          (forward-char))
+         ;; 's' = String
+         ((= char 115)
+          (context-coloring-test-assert-position-string (point))
+          (forward-char))
+         (t
+          (forward-char)))
+        (setq index (1+ index))))))
+
 (defmacro context-coloring-test-assert-region (&rest body)
   "Assert something about the face of points in a region.
 Provides the free variables `i', `length', `point', `face' and
@@ -1006,81 +1087,53 @@ see that function."
 
 (context-coloring-test-deftest-emacs-lisp-mode defun
   (lambda ()
-    (context-coloring-test-assert-region-level 1 8 1)    ; (defun
-    (context-coloring-test-assert-region-level 8 11 0)   ; abc
-    (context-coloring-test-assert-region-level 11 39 1)  ; (def ghi &optional 
jkl) (
-    (context-coloring-test-assert-region-level 39 40 0)  ; +
-    (context-coloring-test-assert-region-level 40 53 1)  ; def ghi jkl
-    (context-coloring-test-assert-region-level 53 57 0)  ; free
-    (context-coloring-test-assert-region-level 57 59 1)  ; ))
-    (context-coloring-test-assert-region-level 61 72 0)  ; (abc 1 2 3)
-    (context-coloring-test-assert-region-level 74 81 1)  ; (defun
-    (context-coloring-test-assert-region-level 81 82 0)  ; a
-    (context-coloring-test-assert-region-level 82 83 1)  ; )
-    (context-coloring-test-assert-region-level 84 94 1)  ; (defun ())
-    ))
+    (context-coloring-test-assert-coloring "
+111111 000 1111 111 111111111 1111
+  10 111 111 111 000011
+
+0000 0 0 00
+
+111111 01
+111111 111")))
 
 (context-coloring-test-deftest-emacs-lisp-mode lambda
   (lambda ()
-    (context-coloring-test-assert-region-level 1 10 0)     ; (funcall
-    (context-coloring-test-assert-region-level 10 35 1)    ; (lambda (fn) (
-    (context-coloring-test-assert-region-level 35 42 0)    ; funcall
-    (context-coloring-test-assert-region-level 42 46 1)    ; fn
-    (context-coloring-test-assert-region-level 46 85 2)    ; (lambda (fn) (
-    (context-coloring-test-assert-region-level 85 87 0)    ; fn
-    (context-coloring-test-assert-region-level 87 98 2)    ; fn fn) fn)
-    (context-coloring-test-assert-region-level 98 103 1)   ; ) fn)
-    (context-coloring-test-assert-region-level 103 106 0)  ; 0)
-    ))
+    (context-coloring-test-assert-coloring "
+00000000 1111111 1111
+           10000000 11 2222222 2222
+                         200 22 12 2221 111 0 00")))
 
 (context-coloring-test-deftest-emacs-lisp-mode quote
   (lambda ()
-    (context-coloring-test-assert-region-level 26 28 1)    ; 'b
-    (context-coloring-test-assert-region-level 45 51 1)    ; '(a b)
-    (context-coloring-test-assert-region-level 68 72 1)    ; `(,
-    (context-coloring-test-assert-region-level 72 78 0)    ; append
-    (context-coloring-test-assert-region-level 78 90 1)    ; () `(a b ,(
-    (context-coloring-test-assert-region-level 90 91 0)    ; +
-    (context-coloring-test-assert-region-level 91 94 1)    ; 1
-    (context-coloring-test-assert-region-level 94 98 0)    ; free
-    (context-coloring-test-assert-region-level 98 101 1)   ; ) ,
-    (context-coloring-test-assert-region-level 101 105 0)  ; free
-    (context-coloring-test-assert-region-level 105 109 1)  ; ) b)
-    (context-coloring-test-assert-region-level 109 113 0)  ; free
-    (context-coloring-test-assert-region-level 113 118 1)  ; ) b ,
-    (context-coloring-test-assert-region-level 118 122 0)  ; ) free
-    (context-coloring-test-assert-region-level 122 126 1)  ; ))))
-    ))
+    (context-coloring-test-assert-coloring "
+(xxxxx x (x)
+  (xx (xx x 111
+      100000 1 111 111
+      100000 1 1111000000 11 111 1 110 1 00001 10000 11 00001 1 100001111")))
 
 (context-coloring-test-deftest-emacs-lisp-mode comment
   (lambda ()
     ;; Just check that the comment isn't parsed syntactically.
-    (context-coloring-test-assert-region-comment-delimiter 39 41)  ; ;
-    (context-coloring-test-assert-region-comment 41 49)            ; 96 = '`'
-    (context-coloring-test-assert-region-level 57 58 0)            ; =
-    )
+    (context-coloring-test-assert-coloring "
+(xxxxx x ()
+  (xx (x xxxxx-xxxx xx)   ;;;;;;;;;;
+      (0 xxxxx-xxxx xx))) ;;;;;;;;;;"))
   :setup (lambda ()
            (setq context-coloring-syntactic-comments t)))
 
 (context-coloring-test-deftest-emacs-lisp-mode string
   (lambda ()
-    ;; Ensure the string is evaded.
-    (context-coloring-test-assert-region-string 28 31)   ; "("
-    (context-coloring-test-assert-region-level 32 33 1)  ; a
-    (context-coloring-test-assert-region-level 34 35 0)  ; b
-    (context-coloring-test-assert-region-string 36 41)   ; "(\""
-    (context-coloring-test-assert-region-level 42 43 0)  ; b
-    (context-coloring-test-assert-region-level 44 45 1)  ; a
-    (context-coloring-test-assert-region-string 46 53)   ; "(\"\""
-    (context-coloring-test-assert-region-level 53 55 1)  ; ))
-    )
+    (context-coloring-test-assert-coloring "
+(xxxxx x (x)
+  (xxxxxx x x sss 1 0 sssss 0 1 sssssss11"))
   :setup (lambda ()
            (setq context-coloring-syntactic-strings t)))
 
 (context-coloring-test-deftest-emacs-lisp-mode unbindable
   (lambda ()
-    (context-coloring-test-assert-region-level 20 40 1)  ; 1 +1 -1 1.0 :a t nil
-    ))
+    (context-coloring-test-assert-coloring "
+(xxxxx x ()
+  (0 0 1 11 11 111 11 1 111))")))
 
 (provide 'context-coloring-test)
 
diff --git a/test/fixtures/lambda.el b/test/fixtures/lambda.el
index f844ff0..9ab7be2 100644
--- a/test/fixtures/lambda.el
+++ b/test/fixtures/lambda.el
@@ -1,3 +1,3 @@
-(funcall (lambda (fn)
+(funcall (lambda (fn a)
            (funcall fn (lambda (fn)
-                         (fn fn fn) fn)) fn) 0)
+                         (fn fn a) fn)) fn) 0 1)