X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/6f3ad757155b9b3089aba55ee6102ecc9bed647d..c830ae52b50bfd2c0c170a54b67ebc4139b2a7eb:/test/context-coloring-test.el

diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index fdb0d83cf..64667a485 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -1,4 +1,4 @@
-;;; test/context-coloring-test.el --- Tests for context coloring. -*- lexical-binding: t; -*-
+;;; context-coloring-test.el --- Tests for context coloring  -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2014-2015  Free Software Foundation, Inc.
 
@@ -17,9 +17,17 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
+;;; Commentary:
+
+;; Tests for context coloring.
+
+;; Use with `make test'.
+
 ;;; Code:
 
+(require 'context-coloring)
 (require 'ert-async)
+(require 'js2-mode)
 
 
 ;;; Test running utilities
@@ -29,25 +37,29 @@
   "This file's directory.")
 
 (defun context-coloring-test-read-file (path)
-  "Read a file's contents into a string."
+  "Read a file's contents from PATH into a string."
   (with-temp-buffer
     (insert-file-contents (expand-file-name path context-coloring-test-path))
     (buffer-string)))
 
 (defun context-coloring-test-setup ()
-  "Preparation code to run before all tests."
-  (setq context-coloring-comments-and-strings nil))
+  "Prepare before all tests."
+  (setq context-coloring-syntactic-comments nil)
+  (setq context-coloring-syntactic-strings nil))
 
 (defun context-coloring-test-cleanup ()
-  "Cleanup code to run after all tests."
-  (setq context-coloring-comments-and-strings t)
-  (setq context-coloring-after-colorize-hook nil)
+  "Cleanup after all tests."
+  (setq context-coloring-comments-and-strings nil)
   (setq context-coloring-js-block-scopes nil)
-  (context-coloring-set-colors-default))
+  (setq context-coloring-colorize-hook nil)
+  (setq context-coloring-check-scopifier-version-hook nil)
+  (setq context-coloring-maximum-face 7)
+  (setq context-coloring-original-maximum-face
+        context-coloring-maximum-face))
 
 (defmacro context-coloring-test-with-fixture (fixture &rest body)
-  "Evaluate BODY in a temporary buffer with the relative
-FIXTURE."
+  "With the relative FIXTURE, evaluate BODY in a temporary
+buffer."
   `(with-temp-buffer
      (unwind-protect
          (progn
@@ -60,27 +72,26 @@ FIXTURE."
   "Create a temporary buffer, and evaluate CALLBACK there.  A
 teardown callback is passed to CALLBACK for it to invoke when it
 is done."
-  (let ((temp-buffer (make-symbol "temp-buffer")))
-    (let ((previous-buffer (current-buffer))
-          (temp-buffer (generate-new-buffer " *temp*")))
-      (set-buffer temp-buffer)
-      (funcall
-       callback
-       (lambda ()
-         (and (buffer-name temp-buffer)
-              (kill-buffer temp-buffer))
-         (set-buffer previous-buffer))))))
+  (let ((previous-buffer (current-buffer))
+        (temp-buffer (generate-new-buffer " *temp*")))
+    (set-buffer temp-buffer)
+    (funcall
+     callback
+     (lambda ()
+       (and (buffer-name temp-buffer)
+            (kill-buffer temp-buffer))
+       (set-buffer previous-buffer)))))
 
 (defun context-coloring-test-with-fixture-async
     (fixture callback &optional setup)
-  "Evaluate CALLBACK in a temporary buffer with the relative
-FIXTURE.  A teardown callback is passed to CALLBACK for it to
-invoke when it is done.  An optional SETUP callback can be passed
-to run arbitrary code before the mode is invoked."
+  "With the relative FIXTURE, evaluate CALLBACK in a temporary
+buffer.  A teardown callback is passed to CALLBACK for it to
+invoke when it is done.  An optional SETUP callback can run
+arbitrary code before the mode is invoked."
   (context-coloring-test-with-temp-buffer-async
    (lambda (done-with-temp-buffer)
      (context-coloring-test-setup)
-     (if setup (funcall setup))
+     (when setup (funcall setup))
      (insert (context-coloring-test-read-file fixture))
      (funcall
       callback
@@ -105,7 +116,7 @@ instantiated in SETUP."
         (funcall callback done-with-test))))
    setup))
 
-(defmacro context-coloring-test-js2-mode (fixture &rest body)
+(defmacro context-coloring-test-js2-mode (fixture setup &rest body)
   "Use FIXTURE as the subject matter for test logic in BODY."
   `(context-coloring-test-with-fixture
     ,fixture
@@ -113,16 +124,21 @@ instantiated in SETUP."
     (setq js2-mode-show-parse-errors nil)
     (setq js2-mode-show-strict-warnings nil)
     (js2-mode)
+    (when ,setup (funcall ,setup))
     (context-coloring-mode)
     ,@body))
 
-(defmacro context-coloring-test-deftest-js-mode (name)
-  "Define an asynchronous test for `js-mode' in the typical
-format."
+(cl-defmacro context-coloring-test-deftest-js-mode (name &key fixture-name)
+  "Define an asynchronous test for `js-mode' with the name NAME
+in the typical format."
+  (declare (indent defun))
   (let ((test-name (intern (format "context-coloring-test-js-mode-%s" name)))
-        (fixture (format "./fixtures/%s.js" name))
+        (fixture (format "./fixtures/%s.js" (or fixture-name name)))
         (function-name (intern-soft
-                        (format "context-coloring-test-js-%s" name))))
+                        (format "context-coloring-test-js-%s" name)))
+        (setup-function-name (intern-soft
+                              (format
+                               "context-coloring-test-js-%s-setup" name))))
     `(ert-deftest-async ,test-name (done)
                         (context-coloring-test-js-mode
                          ,fixture
@@ -130,32 +146,137 @@ format."
                            (unwind-protect
                                (,function-name)
                              (funcall teardown))
-                           (funcall done))))))
+                           (funcall done))
+                         ',setup-function-name))))
 
-(defmacro context-coloring-test-deftest-js2-mode (name)
-    "Define a test for `js2-mode' in the typical format."
+(cl-defmacro context-coloring-test-deftest-js2-mode (name &key fixture-name)
+  "Define a test for `js2-mode' with the name NAME in the typical
+format."
+  (declare (indent defun))
   (let ((test-name (intern (format "context-coloring-test-js2-mode-%s" name)))
-        (fixture (format "./fixtures/%s.js" name))
+        (fixture (format "./fixtures/%s.js" (or fixture-name name)))
         (function-name (intern-soft
-                        (format "context-coloring-test-js-%s" name))))
+                        (format "context-coloring-test-js-%s" name)))
+        (setup-function-name (intern-soft
+                              (format
+                               "context-coloring-test-js-%s-setup" name))))
     `(ert-deftest ,test-name ()
        (context-coloring-test-js2-mode
         ,fixture
+        ',setup-function-name
         (,function-name)))))
 
+(cl-defmacro context-coloring-test-deftest-emacs-lisp-mode (name
+                                                            body
+                                                            &key setup)
+  "Define a test for `emacs-lisp-mode' with name and fixture as
+NAME, with BODY containing the assertions, and SETUP defining the
+environment."
+  (declare (indent defun))
+  (let ((test-name (intern (format "context-coloring-emacs-lisp-mode-%s" name)))
+        (fixture (format "./fixtures/%s.el" name)))
+    `(ert-deftest ,test-name ()
+       (context-coloring-test-with-fixture
+        ,fixture
+        (emacs-lisp-mode)
+        (when ,setup (funcall ,setup))
+        (context-coloring-mode)
+        (funcall ,body)))))
+
 
 ;;; 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.  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)
+        (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)
-  "Skeleton for asserting something about the face of points in a
-region.  Provides the free variables `i', `length', `point',
-`face' and `actual-level'."
+  "Assert something about the face of points in a region.
+Provides the free variables `i', `length', `point', `face' and
+`actual-level' to the code in BODY."
   `(let ((i 0)
          (length (- end start)))
      (while (< i length)
        (let* ((point (+ i start))
-              (face (get-text-property point 'face))
-              actual-level)
+              (face (get-text-property point 'face)))
          ,@body)
        (setq i (+ i 1)))))
 
@@ -163,23 +284,24 @@ region.  Provides the free variables `i', `length', `point',
   "Assert that all points in the range [START, END) are of level
 LEVEL."
   (context-coloring-test-assert-region
-   (when (not (when 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 in region [%s, %s), "
-                               "which is \"%s\", to be %s; "
-                               "but at point %s, it was %s")
-                       start end
-                       (buffer-substring-no-properties start end) level
-                       point actual-level)))))
+   (let (actual-level)
+     (when (not (when 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 in region [%s, %s), "
+                                 "which is \"%s\", to be %s; "
+                                 "but at point %s, it was %s")
+                         start end
+                         (buffer-substring-no-properties start end) level
+                         point actual-level))))))
 
 (defun context-coloring-test-assert-region-face (start end expected-face)
   "Assert that all points in the range [START, END) have the face
@@ -200,19 +322,19 @@ EXPECTED-FACE."
    start end 'font-lock-comment-delimiter-face))
 
 (defun context-coloring-test-assert-region-comment (start end)
-    "Assert that all points in the range [START, END) have
+  "Assert that all points in the range [START, END) have
 `font-lock-comment-face'."
   (context-coloring-test-assert-region-face
    start end 'font-lock-comment-face))
 
 (defun context-coloring-test-assert-region-string (start end)
-    "Assert that all points in the range [START, END) have
+  "Assert that all points in the range [START, END) have
 `font-lock-string-face'."
   (context-coloring-test-assert-region-face
    start end 'font-lock-string-face))
 
 (defun context-coloring-test-assert-message (expected buffer)
-  "Assert that BUFFER has message EXPECTED."
+  "Assert that message EXPECTED exists in BUFFER."
   (when (null (get-buffer buffer))
     (ert-fail
      (format
@@ -247,12 +369,12 @@ EXPECTED-FACE."
 
 (defun context-coloring-test-kill-buffer (buffer)
   "Kill BUFFER if it exists."
-  (if (get-buffer buffer) (kill-buffer buffer)))
+  (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."
-  (let* ((face (context-coloring-face-symbol level))
+is FOREGROUND, or the inverse if NEGATE is non-nil."
+  (let* ((face (context-coloring-level-face level))
          actual-foreground)
     (when (not (or negate
                    face))
@@ -267,50 +389,222 @@ is FOREGROUND."
                                 "but it %s.")
                         level
                         (if negate "not " "") foreground
-                        (if negate "did" (format "was `%s'" actual-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."
+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))
+    (condition-case err
+        (progn
+          (funcall body))
+      (error
+       (setq error-signaled-p t)
+       (when (not (string-equal (cadr err) error-message))
+         (ert-fail (format (concat "Expected the error \"%s\" to be thrown, "
+                                   "but instead it was \"%s\".")
+                           error-message
+                           (cadr err))))))
+    (when (not error-signaled-p)
+      (ert-fail "Expected an error to be thrown, but there wasn't."))))
+
+(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 " ") "")
+  (context-coloring-test-assert-trimmed (context-coloring-trim "a") "a")
+  (context-coloring-test-assert-trimmed (context-coloring-trim " a") "a")
+  (context-coloring-test-assert-trimmed (context-coloring-trim "a ") "a")
+  (context-coloring-test-assert-trimmed (context-coloring-trim " a ") "a"))
+
+(ert-deftest-async context-coloring-test-async-mode-startup (done)
+  (context-coloring-test-with-fixture-async
+   "./fixtures/empty"
+   (lambda (teardown)
+     (js-mode)
+     (add-hook
+      'context-coloring-colorize-hook
+      (lambda ()
+        ;; If this runs we are implicitly successful; this test only confirms
+        ;; that colorization occurs on mode startup.
+        (funcall teardown)
+        (funcall done)))
+     (context-coloring-mode))))
+
+(define-derived-mode
+  context-coloring-change-detection-mode
+  fundamental-mode
+  "Testing"
+  "Prevent `context-coloring-test-change-detection' from
+  having any unintentional side-effects on mode support.")
+
+;; Simply cannot figure out how to trigger an idle timer; would much rather test
+;; that.  But (current-idle-time) always returns nil in these tests.
+(ert-deftest-async context-coloring-test-change-detection (done)
+  (context-coloring-define-dispatch
+     'idle-change
+     :modes '(context-coloring-change-detection-mode)
+     :executable "node"
+     :command "node test/binaries/noop")
+  (context-coloring-test-with-fixture-async
+   "./fixtures/empty"
+   (lambda (teardown)
+     (context-coloring-change-detection-mode)
+     (add-hook
+      'context-coloring-colorize-hook
+      (lambda ()
+        (setq context-coloring-colorize-hook nil)
+        (add-hook
+         'context-coloring-colorize-hook
+         (lambda ()
+           (funcall teardown)
+           (funcall done)))
+        (insert " ")
+        (set-window-buffer (selected-window) (current-buffer))
+        (context-coloring-maybe-colorize)))
+     (context-coloring-mode))))
+
+(ert-deftest context-coloring-test-check-version ()
+  (when (not (context-coloring-check-version "2.1.3" "3.0.1"))
+    (ert-fail "Expected version 3.0.1 to satisfy 2.1.3, but it didn't."))
+  (when (context-coloring-check-version "3.0.1" "2.1.3")
+    (ert-fail "Expected version 2.1.3 not to satisfy 3.0.1, but it did.")))
+
 (ert-deftest context-coloring-test-unsupported-mode ()
   (context-coloring-test-with-fixture
-   "./fixtures/function-scopes.js"
+   "./fixtures/empty"
    (context-coloring-mode)
    (context-coloring-test-assert-message
     "Context coloring is not available for this major mode"
     "*Messages*")))
 
-(ert-deftest context-coloring-test-set-colors ()
-  ;; This test has an irreversible side-effect in that it defines faces beyond
-  ;; 7.  Faces 0 through 7 are reset to their default states, so it might not
-  ;; matter, but be aware anyway.
-  (context-coloring-set-colors
-   "#000000"
-   "#111111"
-   "#222222"
-   "#333333"
-   "#444444"
-   "#555555"
-   "#666666"
-   "#777777"
-   "#888888"
-   "#999999")
-  (context-coloring-test-assert-face 0 "#000000")
-  (context-coloring-test-assert-face 1 "#111111")
-  (context-coloring-test-assert-face 2 "#222222")
-  (context-coloring-test-assert-face 3 "#333333")
-  (context-coloring-test-assert-face 4 "#444444")
-  (context-coloring-test-assert-face 5 "#555555")
-  (context-coloring-test-assert-face 6 "#666666")
-  (context-coloring-test-assert-face 7 "#777777")
-  (context-coloring-test-assert-face 8 "#888888")
-  (context-coloring-test-assert-face 9 "#999999"))
+(define-derived-mode
+  context-coloring-test-define-dispatch-error-mode
+  fundamental-mode
+  "Testing"
+  "Prevent `context-coloring-test-define-dispatch-error' from
+  having any unintentional side-effects on mode support.")
+
+(ert-deftest context-coloring-test-define-dispatch-error ()
+  (context-coloring-test-assert-error
+   (lambda ()
+     (context-coloring-define-dispatch
+      'define-dispatch-no-modes))
+   "No mode defined for dispatch")
+  (context-coloring-test-assert-error
+   (lambda ()
+     (context-coloring-define-dispatch
+      'define-dispatch-no-strategy
+      :modes '(context-coloring-test-define-dispatch-error-mode)))
+   "No colorizer, scopifier or command defined for dispatch"))
+
+(define-derived-mode
+  context-coloring-test-define-dispatch-scopifier-mode
+  fundamental-mode
+  "Testing"
+  "Prevent `context-coloring-test-define-dispatch-scopifier' from
+  having any unintentional side-effects on mode support.")
+
+(ert-deftest context-coloring-test-define-dispatch-scopifier ()
+  (context-coloring-define-dispatch
+   'define-dispatch-scopifier
+   :modes '(context-coloring-test-define-dispatch-scopifier-mode)
+   :scopifier (lambda () (vector)))
+  (with-temp-buffer
+    (context-coloring-test-define-dispatch-scopifier-mode)
+    (context-coloring-mode)
+    (context-coloring-colorize)))
+
+(define-derived-mode
+  context-coloring-test-missing-executable-mode
+  fundamental-mode
+  "Testing"
+  "Prevent `context-coloring-test-define-dispatch-scopifier' from
+  having any unintentional side-effects on mode support.")
+
+(ert-deftest context-coloring-test-missing-executable ()
+  (context-coloring-define-dispatch
+   'scopifier
+   :modes '(context-coloring-test-missing-executable-mode)
+   :command ""
+   :executable "__should_not_exist__")
+  (with-temp-buffer
+    (context-coloring-test-missing-executable-mode)
+    (context-coloring-mode)))
+
+(define-derived-mode
+  context-coloring-test-unsupported-version-mode
+  fundamental-mode
+  "Testing"
+  "Prevent `context-coloring-test-unsupported-version' from
+  having any unintentional side-effects on mode support.")
+
+(ert-deftest-async context-coloring-test-unsupported-version (done)
+  (context-coloring-define-dispatch
+   'outta-date
+   :modes '(context-coloring-test-unsupported-version-mode)
+   :executable "node"
+   :command "node test/binaries/outta-date"
+   :version "v2.1.3")
+  (context-coloring-test-with-fixture-async
+   "./fixtures/empty"
+   (lambda (teardown)
+     (context-coloring-test-unsupported-version-mode)
+     (add-hook
+      'context-coloring-check-scopifier-version-hook
+      (lambda ()
+        (unwind-protect
+            (progn
+              ;; Normally the executable would be something like "outta-date"
+              ;; rather than "node".
+              (context-coloring-test-assert-message
+               "Update to the minimum version of \"node\" (v2.1.3)"
+               "*Messages*"))
+          (funcall teardown))
+        (funcall done)))
+     (context-coloring-mode))))
+
+(define-derived-mode
+  context-coloring-test-disable-mode-mode
+  fundamental-mode
+  "Testing"
+  "Prevent `context-coloring-test-disable-mode' from having any
+  unintentional side-effects on mode support.")
+
+(ert-deftest-async context-coloring-test-disable-mode (done)
+  (let (torn-down)
+    (context-coloring-define-dispatch
+     'disable-mode
+     :modes '(context-coloring-test-disable-mode-mode)
+     :executable "node"
+     :command "node test/binaries/noop"
+     :teardown (lambda ()
+                 (setq torn-down t)))
+    (context-coloring-test-with-fixture-async
+     "./fixtures/empty"
+     (lambda (teardown)
+       (unwind-protect
+           (progn
+             (context-coloring-test-disable-mode-mode)
+             (context-coloring-mode)
+             (context-coloring-mode -1)
+             (when (not torn-down)
+               (ert-fail "Expected teardown function to have been called, but it wasn't.")))
+         (funcall teardown))
+       (funcall done)))))
 
 (defvar context-coloring-test-theme-index 0
   "Unique index for unique theme names.")
@@ -326,8 +620,8 @@ FOREGROUND."
 (defun context-coloring-test-assert-theme-originally-set-p
     (settings &optional negate)
   "Assert that `context-coloring-theme-originally-set-p' returns
-t for a theme with SETTINGS (or the inverse if NEGATE is
-non-nil)."
+t for a theme with SETTINGS, or the inverse if NEGATE is
+non-nil."
   (let ((theme (context-coloring-test-get-next-theme)))
     (put theme 'theme-settings settings)
     (when (funcall (if negate 'identity 'not)
@@ -341,7 +635,9 @@ non-nil)."
 
 (defun context-coloring-test-assert-not-theme-originally-set-p (&rest arguments)
   "Assert that `context-coloring-theme-originally-set-p' does not
-return t for a theme with SETTINGS."
+return t for a theme with SETTINGS.  Apply ARGUMENTS to
+`context-coloring-test-assert-theme-originally-set-p', see that
+function."
   (apply 'context-coloring-test-assert-theme-originally-set-p
          (append arguments '(t))))
 
@@ -368,7 +664,8 @@ EXPECTED-LEVEL."
 
 (defun context-coloring-test-assert-theme-highest-level
     (theme expected-level &optional negate)
-  "Assert that THEME has the highest level EXPECTED-LEVEL."
+  "Assert that THEME has the highest level EXPECTED-LEVEL, or the
+inverse if NEGATE is non-nil."
   (let ((highest-level (context-coloring-theme-highest-level theme)))
     (when (funcall (if negate 'identity 'not) (eq highest-level expected-level))
       (ert-fail (format (concat "Expected theme with settings `%s' "
@@ -379,7 +676,10 @@ EXPECTED-LEVEL."
                         (if negate "did" (format "was %s" highest-level)))))))
 
 (defun context-coloring-test-assert-theme-not-highest-level (&rest arguments)
-  "Assert that THEME's highest level is not EXPECTED-LEVEL."
+  "Assert that THEME's highest level is not EXPECTED-LEVEL.
+Apply ARGUMENTS to
+`context-coloring-test-assert-theme-highest-level', see that
+function."
   (apply 'context-coloring-test-assert-theme-highest-level
          (append arguments '(t))))
 
@@ -404,21 +704,23 @@ EXPECTED-LEVEL."
   )
 
 (defmacro context-coloring-test-deftest-define-theme (name &rest body)
-  "Define a test with an automatically-generated theme symbol
-available as a free variable `theme'.  Side-effects from enabling
-themes are reversed after the test completes."
+  "Define a test with name NAME and an automatically-generated
+theme symbol available as a free variable `theme'.  Side-effects
+from enabling themes are reversed after BODY is executed and the
+test completes."
   (declare (indent defun))
   (let ((deftest-name (intern
                        (format "context-coloring-test-define-theme-%s" name))))
     `(ert-deftest ,deftest-name ()
        (context-coloring-test-kill-buffer "*Warnings*")
+       (context-coloring-test-setup)
        (let ((theme (context-coloring-test-get-next-theme)))
          (unwind-protect
              (progn
                ,@body)
            ;; Always cleanup.
            (disable-theme theme)
-           (context-coloring-set-colors-default))))))
+           (context-coloring-test-cleanup))))))
 
 (defun context-coloring-test-deftheme (theme)
   "Dynamically define theme THEME."
@@ -495,6 +797,18 @@ theme THEME is signaled."
   (context-coloring-test-assert-face 0 "#cccccc")
   (context-coloring-test-assert-face 1 "#dddddd"))
 
+(context-coloring-test-deftest-define-theme pre-recede-delayed-application
+  (context-coloring-define-theme
+   theme
+   :recede t
+   :colors '("#aaaaaa"
+             "#bbbbbb"))
+  (context-coloring-test-deftheme theme)
+  (enable-theme theme)
+  (context-coloring-test-assert-no-message "*Warnings*")
+  (context-coloring-test-assert-face 0 "#aaaaaa")
+  (context-coloring-test-assert-face 1 "#bbbbbb"))
+
 (context-coloring-test-deftest-define-theme post-recede
   (context-coloring-test-deftheme theme)
   (custom-theme-set-faces
@@ -563,62 +877,69 @@ theme THEME is signaled."
   (context-coloring-test-assert-face 0 "#aaaaaa")
   (context-coloring-test-assert-face 1 "#bbbbbb"))
 
-(defun context-coloring-test-assert-face-count (count &optional negate)
-  "Assert that `context-coloring-face-count' is COUNT."
+(defun context-coloring-test-assert-maximum-face (maximum &optional negate)
+  "Assert that `context-coloring-maximum-face' is MAXIMUM, or the
+inverse if NEGATE is non-nil."
   (when (funcall (if negate 'identity 'not)
-                 (eq context-coloring-face-count count))
-    (ert-fail (format (concat "Expected `context-coloring-face-count' "
+                 (eq context-coloring-maximum-face maximum))
+    (ert-fail (format (concat "Expected `context-coloring-maximum-face' "
                               "%sto be `%s', "
                               "but it %s.")
-                      (if negate "not " "") count
+                      (if negate "not " "") maximum
                       (if negate
                           "was"
-                        (format "was `%s'" context-coloring-face-count))))))
+                        (format "was `%s'" context-coloring-maximum-face))))))
 
-(defun context-coloring-test-assert-not-face-count (&rest arguments)
-  "Assert that `context-coloring-face-count' is not COUNT."
-  (apply 'context-coloring-test-assert-face-count
+(defun context-coloring-test-assert-not-maximum-face (&rest arguments)
+  "Assert that `context-coloring-maximum-face' is not MAXIMUM.
+Apply ARGUMENTS to `context-coloring-test-assert-maximum-face',
+see that function."
+  (apply 'context-coloring-test-assert-maximum-face
          (append arguments '(t))))
 
 (context-coloring-test-deftest-define-theme disable-cascade
-  (context-coloring-test-deftheme theme)
-  (context-coloring-define-theme
-   theme
-   :colors '("#aaaaaa"
-             "#bbbbbb"))
-  (let ((second-theme (context-coloring-test-get-next-theme)))
-    (context-coloring-test-deftheme second-theme)
+  (let ((maximum-face-value 9999))
+    (setq context-coloring-maximum-face maximum-face-value)
+    (context-coloring-test-deftheme theme)
     (context-coloring-define-theme
-     second-theme
-     :colors '("#cccccc"
-               "#dddddd"
-               "#eeeeee"))
-    (let ((third-theme (context-coloring-test-get-next-theme)))
-      (context-coloring-test-deftheme third-theme)
+     theme
+     :colors '("#aaaaaa"
+               "#bbbbbb"))
+    (let ((second-theme (context-coloring-test-get-next-theme)))
+      (context-coloring-test-deftheme second-theme)
       (context-coloring-define-theme
-       third-theme
-       :colors '("#111111"
-                 "#222222"
-                 "#333333"
-                 "#444444"))
-      (enable-theme theme)
-      (enable-theme second-theme)
-      (enable-theme third-theme)
-      (disable-theme third-theme)
-      (context-coloring-test-assert-face 0 "#cccccc")
-      (context-coloring-test-assert-face 1 "#dddddd")
-      (context-coloring-test-assert-face 2 "#eeeeee")
-      (context-coloring-test-assert-face-count 3))
-    (disable-theme second-theme)
-    (context-coloring-test-assert-face 0 "#aaaaaa")
-    (context-coloring-test-assert-face 1 "#bbbbbb")
-    (context-coloring-test-assert-face-count 2))
-  (disable-theme theme)
-  (context-coloring-test-assert-not-face 0 "#aaaaaa")
-  (context-coloring-test-assert-not-face 1 "#bbbbbb")
-  (context-coloring-test-assert-not-face-count 2))
+       second-theme
+       :colors '("#cccccc"
+                 "#dddddd"
+                 "#eeeeee"))
+      (let ((third-theme (context-coloring-test-get-next-theme)))
+        (context-coloring-test-deftheme third-theme)
+        (context-coloring-define-theme
+         third-theme
+         :colors '("#111111"
+                   "#222222"
+                   "#333333"
+                   "#444444"))
+        (enable-theme theme)
+        (enable-theme second-theme)
+        (enable-theme third-theme)
+        (disable-theme third-theme)
+        (context-coloring-test-assert-face 0 "#cccccc")
+        (context-coloring-test-assert-face 1 "#dddddd")
+        (context-coloring-test-assert-face 2 "#eeeeee")
+        (context-coloring-test-assert-maximum-face 2))
+      (disable-theme second-theme)
+      (context-coloring-test-assert-face 0 "#aaaaaa")
+      (context-coloring-test-assert-face 1 "#bbbbbb")
+      (context-coloring-test-assert-maximum-face 1))
+    (disable-theme theme)
+    (context-coloring-test-assert-not-face 0 "#aaaaaa")
+    (context-coloring-test-assert-not-face 1 "#bbbbbb")
+    (context-coloring-test-assert-maximum-face
+     maximum-face-value)))
 
 (defun context-coloring-test-js-function-scopes ()
+  "Test fixtures/functions-scopes.js."
   (context-coloring-test-assert-region-level 1 9 0)
   (context-coloring-test-assert-region-level 9 23 1)
   (context-coloring-test-assert-region-level 23 25 0)
@@ -636,6 +957,7 @@ theme THEME is signaled."
 (context-coloring-test-deftest-js2-mode function-scopes)
 
 (defun context-coloring-test-js-global ()
+  "Test fixtures/global.js."
   (context-coloring-test-assert-region-level 20 28 1)
   (context-coloring-test-assert-region-level 28 35 0)
   (context-coloring-test-assert-region-level 35 41 1))
@@ -644,6 +966,7 @@ theme THEME is signaled."
 (context-coloring-test-deftest-js2-mode global)
 
 (defun context-coloring-test-js-block-scopes ()
+  "Test fixtures/block-scopes.js."
   (context-coloring-test-assert-region-level 20 64 1)
    (setq context-coloring-js-block-scopes t)
    (context-coloring-colorize)
@@ -655,6 +978,7 @@ theme THEME is signaled."
 (context-coloring-test-deftest-js2-mode block-scopes)
 
 (defun context-coloring-test-js-catch ()
+  "Test fixtures/js-catch.js."
   (context-coloring-test-assert-region-level 20 27 1)
   (context-coloring-test-assert-region-level 27 51 2)
   (context-coloring-test-assert-region-level 51 52 1)
@@ -668,12 +992,14 @@ theme THEME is signaled."
 (context-coloring-test-deftest-js2-mode catch)
 
 (defun context-coloring-test-js-key-names ()
+  "Test fixtures/key-names.js."
   (context-coloring-test-assert-region-level 20 63 1))
 
 (context-coloring-test-deftest-js-mode key-names)
 (context-coloring-test-deftest-js2-mode key-names)
 
 (defun context-coloring-test-js-property-lookup ()
+  "Test fixtures/property-lookup.js."
   (context-coloring-test-assert-region-level 20 26 0)
   (context-coloring-test-assert-region-level 26 38 1)
   (context-coloring-test-assert-region-level 38 44 0)
@@ -685,36 +1011,143 @@ theme THEME is signaled."
 (context-coloring-test-deftest-js2-mode property-lookup)
 
 (defun context-coloring-test-js-key-values ()
+  "Test fixtures/key-values.js."
   (context-coloring-test-assert-region-level 78 79 1))
 
 (context-coloring-test-deftest-js-mode key-values)
 (context-coloring-test-deftest-js2-mode key-values)
 
-(defun context-coloring-test-js-comments-and-strings ()
-  (context-coloring-test-assert-region-comment-delimiter 1 4)
-  (context-coloring-test-assert-region-comment 4 8)
+(defun context-coloring-test-js-syntactic-comments-and-strings ()
+  "Test comments and strings."
+  (context-coloring-test-assert-region-level 1 8 0)
   (context-coloring-test-assert-region-comment-delimiter 9 12)
-  (context-coloring-test-assert-region-comment 12 19)
-  (context-coloring-test-assert-region-string 20 32)
-  (context-coloring-test-assert-region-level 32 33 0))
-
-(ert-deftest-async context-coloring-test-js-mode-comments-and-strings (done)
-  (context-coloring-test-js-mode
-   "./fixtures/comments-and-strings.js"
-   (lambda (teardown)
-     (unwind-protect
-         (context-coloring-test-js-comments-and-strings)
-       (funcall teardown))
-     (funcall done))
-   (lambda ()
-     (setq context-coloring-comments-and-strings t))))
-
-(ert-deftest context-coloring-test-js2-mode-comments-and-strings ()
-  (context-coloring-test-js2-mode
-   "./fixtures/comments-and-strings.js"
-   (setq context-coloring-comments-and-strings t)
-   (context-coloring-colorize)
-   (context-coloring-test-js-comments-and-strings)))
+  (context-coloring-test-assert-region-comment 12 16)
+  (context-coloring-test-assert-region-comment-delimiter 17 20)
+  (context-coloring-test-assert-region-comment 20 27)
+  (context-coloring-test-assert-region-string 28 40)
+  (context-coloring-test-assert-region-level 40 41 0))
+
+(defun context-coloring-test-js-syntactic-comments-and-strings-setup ()
+  (setq context-coloring-syntactic-comments t)
+  (setq context-coloring-syntactic-strings t))
+
+(context-coloring-test-deftest-js-mode syntactic-comments-and-strings
+  :fixture-name comments-and-strings)
+(context-coloring-test-deftest-js2-mode syntactic-comments-and-strings
+  :fixture-name comments-and-strings)
+
+(defalias 'context-coloring-test-js-comments-and-strings
+  'context-coloring-test-js-syntactic-comments-and-strings
+  "Test comments and strings.  Deprecated.")
+
+(defun context-coloring-test-js-comments-and-strings-setup ()
+  "Setup comments and strings.  Deprecated."
+  (setq context-coloring-comments-and-strings t))
+
+(context-coloring-test-deftest-js-mode comments-and-strings)
+(context-coloring-test-deftest-js2-mode comments-and-strings)
+
+(defun context-coloring-test-js-syntactic-comments ()
+  "Test syntactic comments."
+  (context-coloring-test-assert-region-level 1 8 0)
+  (context-coloring-test-assert-region-comment-delimiter 9 12)
+  (context-coloring-test-assert-region-comment 12 16)
+  (context-coloring-test-assert-region-comment-delimiter 17 20)
+  (context-coloring-test-assert-region-comment 20 27)
+  (context-coloring-test-assert-region-level 28 41 0))
+
+(defun context-coloring-test-js-syntactic-comments-setup ()
+  "Setup syntactic comments."
+  (setq context-coloring-syntactic-comments t))
+
+(context-coloring-test-deftest-js-mode syntactic-comments
+  :fixture-name comments-and-strings)
+(context-coloring-test-deftest-js2-mode syntactic-comments
+  :fixture-name comments-and-strings)
+
+(defun context-coloring-test-js-syntactic-strings ()
+  "Test syntactic strings."
+  (context-coloring-test-assert-region-level 1 28 0)
+  (context-coloring-test-assert-region-string 28 40)
+  (context-coloring-test-assert-region-level 40 41 0))
+
+(defun context-coloring-test-js-syntactic-strings-setup ()
+  "Setup syntactic strings."
+  (setq context-coloring-syntactic-strings t))
+
+(context-coloring-test-deftest-js-mode syntactic-strings
+  :fixture-name comments-and-strings)
+(context-coloring-test-deftest-js2-mode syntactic-strings
+  :fixture-name comments-and-strings)
+
+;; As long as `add-text-properties' doesn't signal an error, this test passes.
+(defun context-coloring-test-js-unterminated-comment ()
+  "Test unterminated multiline comments.")
+
+(context-coloring-test-deftest-js2-mode unterminated-comment)
+
+(context-coloring-test-deftest-emacs-lisp-mode defun
+  (lambda ()
+    (context-coloring-test-assert-coloring "
+111111 000 1111 111 111111111 1111
+  11 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-coloring "
+00000000 1111111 1111
+           11111111 11 2222222 2222
+                         222 22 12 2221 111 0 00")))
+
+(context-coloring-test-deftest-emacs-lisp-mode quote
+  (lambda ()
+    (context-coloring-test-assert-coloring "
+(xxxxx x (x)
+  (xx (xx x 111
+      111111 1 111 111
+      111111 1 1111111111 11 111 1 111 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-coloring "
+(xxxxx x ()
+  (xx (x xxxxx-xxxx xx)   ;;;;;;;;;;
+      11 00000-0000 11))) ;;;;;;;;;;"))
+  :setup (lambda ()
+           (setq context-coloring-syntactic-comments t)))
+
+(context-coloring-test-deftest-emacs-lisp-mode string
+  (lambda ()
+    (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-coloring "
+(xxxxx x ()
+  (x x 1 11 11 111 11 1 111))")))
+
+(context-coloring-test-deftest-emacs-lisp-mode let*
+  (lambda ()
+    (context-coloring-test-assert-coloring "
+11111 11
+       11 11
+       11 000011
+  1111 1 1 1 0 0 00001
+  22222 22
+         22 12
+         22 000022
+    2222 1 1 2 2 2 0000))
+  1111 1 1 1 0 0 000011")))
 
 (provide 'context-coloring-test)