[elpa] master 1f474d9 11/79: Reorganize functions.

[Jackson Ray Hamilton]

branch: master
commit 1f474d9e189b64d996baedd3f24e6930982d1939
Author: Jackson Ray Hamilton <address@hidden>
Commit: Jackson Ray Hamilton <address@hidden>

    Reorganize functions.
---
 test/context-coloring-test.el |  270 +++++++++++++++++++++--------------------
 1 files changed, 138 insertions(+), 132 deletions(-)

diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index d43a716..0c7cc20 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -185,103 +185,6 @@ initial colorization if colorization should occur."
 
 ;;; 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 `equal' check (against a symbol or 
nil).
-           (unless (stringp face-regexp)
-             (not (equal 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-constant-comment (position)
-  (context-coloring-test-assert-position-face position 
'(font-lock-constant-face
-                                                         
font-lock-comment-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-position-nil (position)
-  (context-coloring-test-assert-position-face position nil))
-
-(defun context-coloring-test-assert-coloring (map)
-  "Assert that the current buffer's coloring matches MAP."
-  ;; Omit the superfluous, formatting-related leading newline.  Can't use
-  ;; `save-excursion' here because if an assertion fails it will cause future
-  ;; tests to get messed up.
-  (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)
-        (forward-line)
-        (beginning-of-line))
-       ;; Number
-       ((and (>= char 48)
-             (<= char 57))
-        (context-coloring-test-assert-position-level
-         (point) (string-to-number char-string))
-        (forward-char))
-       ;; 'C' = Constant comment
-       ((= char 67)
-        (context-coloring-test-assert-position-constant-comment (point))
-        (forward-char))
-       ;; 'c' = Comment
-       ((= char 99)
-        (context-coloring-test-assert-position-comment (point))
-        (forward-char))
-       ;; 'n' = nil
-       ((= char 110)
-        (context-coloring-test-assert-position-nil (point))
-        (forward-char))
-       ;; 's' = String
-       ((= char 115)
-        (context-coloring-test-assert-position-string (point))
-        (forward-char))
-       (t
-        (forward-char)))
-      (setq index (1+ index)))))
-
 (defun context-coloring-test-get-last-message ()
   (let ((messages (split-string
                    (buffer-substring-no-properties
@@ -332,38 +235,6 @@ initial colorization if colorization should occur."
                       (with-current-buffer buffer
                         (buffer-string))))))
 
-(defun context-coloring-test-kill-buffer (buffer)
-  "Kill BUFFER if it exists."
-  (when (get-buffer buffer) (kill-buffer buffer)))
-
-(defun context-coloring-test-assert-face (level foreground &optional negate)
-  "Assert that a face for LEVEL exists and that its `:foreground'
-is FOREGROUND, or the inverse if NEGATE is non-nil."
-  (let* ((face (context-coloring-level-face level))
-         actual-foreground)
-    (when (not (or negate
-                   face))
-      (ert-fail (format (concat "Expected face for level `%s' to exist; "
-                                "but it didn't")
-                        level)))
-    (setq actual-foreground (face-attribute face :foreground))
-    (when (funcall (if negate 'identity 'not)
-                   (string-equal foreground actual-foreground))
-      (ert-fail (format (concat "Expected face for level `%s' "
-                                "%sto have foreground `%s'; "
-                                "but it %s.")
-                        level
-                        (if negate "not " "") foreground
-                        (if negate
-                            "did" (format "was `%s'" actual-foreground)))))))
-
-(defun context-coloring-test-assert-not-face (&rest arguments)
-  "Assert that LEVEL does not have a face with `:foreground'
-FOREGROUND.  Apply ARGUMENTS to
-`context-coloring-test-assert-face', see that function."
-  (apply 'context-coloring-test-assert-face
-         (append arguments '(t))))
-
 (defun context-coloring-test-assert-error (body error-message)
   "Assert that BODY signals ERROR-MESSAGE."
   (let ((error-signaled-p nil))
@@ -380,13 +251,13 @@ FOREGROUND.  Apply ARGUMENTS to
     (when (not error-signaled-p)
       (ert-fail "Expected an error to be thrown, but there wasn't."))))
 
+
+;;; Miscellaneous tests
+
 (defun context-coloring-test-assert-trimmed (result expected)
   (when (not (string-equal result expected))
     (ert-fail "Expected string to be trimmed, but it wasn't.")))
 
-
-;;; The tests
-
 (ert-deftest context-coloring-test-trim ()
   (context-coloring-test-assert-trimmed (context-coloring-trim "") "")
   (context-coloring-test-assert-trimmed (context-coloring-trim " ") "")
@@ -554,6 +425,9 @@ FOREGROUND.  Apply ARGUMENTS to
          (funcall teardown))
        (funcall done)))))
 
+
+;;; Theme tests
+
 (defvar context-coloring-test-theme-index 0
   "Unique index for unique theme names.")
 
@@ -565,6 +439,34 @@ FOREGROUND.  Apply ARGUMENTS to
     (setq context-coloring-test-theme-index
           (+ context-coloring-test-theme-index 1))))
 
+(defun context-coloring-test-assert-face (level foreground &optional negate)
+  "Assert that a face for LEVEL exists and that its `:foreground'
+is FOREGROUND, or the inverse if NEGATE is non-nil."
+  (let* ((face (context-coloring-level-face level))
+         actual-foreground)
+    (when (not (or negate
+                   face))
+      (ert-fail (format (concat "Expected face for level `%s' to exist; "
+                                "but it didn't")
+                        level)))
+    (setq actual-foreground (face-attribute face :foreground))
+    (when (funcall (if negate 'identity 'not)
+                   (string-equal foreground actual-foreground))
+      (ert-fail (format (concat "Expected face for level `%s' "
+                                "%sto have foreground `%s'; "
+                                "but it %s.")
+                        level
+                        (if negate "not " "") foreground
+                        (if negate
+                            "did" (format "was `%s'" actual-foreground)))))))
+
+(defun context-coloring-test-assert-not-face (&rest arguments)
+  "Assert that LEVEL does not have a face with `:foreground'
+FOREGROUND.  Apply ARGUMENTS to
+`context-coloring-test-assert-face', see that function."
+  (apply 'context-coloring-test-assert-face
+         (append arguments '(t))))
+
 (defun context-coloring-test-assert-theme-originally-set-p
     (settings &optional negate)
   "Assert that `context-coloring-theme-originally-set-p' returns
@@ -649,6 +551,10 @@ function."
      (theme-face context-coloring-level-1-face))
    1))
 
+(defun context-coloring-test-kill-buffer (buffer)
+  "Kill BUFFER if it exists."
+  (when (get-buffer buffer) (kill-buffer buffer)))
+
 (defmacro context-coloring-test-deftest-define-theme (name &rest body)
   "Define a test with name NAME and an automatically-generated
 theme symbol available as a free variable `theme'.  Side-effects
@@ -884,6 +790,106 @@ see that function."
     (context-coloring-test-assert-maximum-face
      maximum-face-value)))
 
+
+;;; Coloring tests
+
+(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 `equal' check (against a symbol or 
nil).
+           (unless (stringp face-regexp)
+             (not (equal 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-constant-comment (position)
+  (context-coloring-test-assert-position-face position 
'(font-lock-constant-face
+                                                         
font-lock-comment-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-position-nil (position)
+  (context-coloring-test-assert-position-face position nil))
+
+(defun context-coloring-test-assert-coloring (map)
+  "Assert that the current buffer's coloring matches MAP."
+  ;; Omit the superfluous, formatting-related leading newline.  Can't use
+  ;; `save-excursion' here because if an assertion fails it will cause future
+  ;; tests to get messed up.
+  (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)
+        (forward-line)
+        (beginning-of-line))
+       ;; Number
+       ((and (>= char 48)
+             (<= char 57))
+        (context-coloring-test-assert-position-level
+         (point) (string-to-number char-string))
+        (forward-char))
+       ;; 'C' = Constant comment
+       ((= char 67)
+        (context-coloring-test-assert-position-constant-comment (point))
+        (forward-char))
+       ;; 'c' = Comment
+       ((= char 99)
+        (context-coloring-test-assert-position-comment (point))
+        (forward-char))
+       ;; 'n' = nil
+       ((= char 110)
+        (context-coloring-test-assert-position-nil (point))
+        (forward-char))
+       ;; 's' = String
+       ((= char 115)
+        (context-coloring-test-assert-position-string (point))
+        (forward-char))
+       (t
+        (forward-char)))
+      (setq index (1+ index)))))
+
 (context-coloring-test-deftest-js-js2 function-scopes
   (lambda ()
     (context-coloring-test-assert-coloring "