code.delx.au - gnu-emacs-elpa/blob - test/context-coloring-test.el

   1 ;;; context-coloring-test.el --- Tests for context coloring  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2014-2015  Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 ;; Tests for context coloring.
  23
  24 ;; Use with `make test'.
  25
  26 ;;; Code:
  27
  28 (require 'context-coloring)
  29 (require 'ert-async)
  30 (require 'js2-mode)
  31
  32
  33 ;;; Test running utilities
  34
  35 (defconst context-coloring-test-path
  36   (file-name-directory (or load-file-name buffer-file-name))
  37   "This file's directory.")
  38
  39 (defun context-coloring-test-read-file (path)
  40   "Return the file's contents from PATH as a string."
  41   (with-temp-buffer
  42     (insert-file-contents (expand-file-name path context-coloring-test-path))
  43     (buffer-string)))
  44
  45 (defun context-coloring-test-before-all ()
  46   "Prepare before all tests."
  47   (setq context-coloring-syntactic-comments nil)
  48   (setq context-coloring-syntactic-strings nil))
  49
  50 (defun context-coloring-test-after-all ()
  51   "Cleanup after all tests."
  52   (setq context-coloring-colorize-hook nil)
  53   (setq context-coloring-check-scopifier-version-hook nil)
  54   (setq context-coloring-maximum-face 7)
  55   (setq context-coloring-original-maximum-face
  56         context-coloring-maximum-face))
  57
  58 (defmacro context-coloring-test-with-fixture (fixture &rest body)
  59   "With the relative FIXTURE, evaluate BODY in a temporary
  60 buffer."
  61   `(with-temp-buffer
  62      (unwind-protect
  63          (progn
  64            (context-coloring-test-before-all)
  65            (insert (context-coloring-test-read-file ,fixture))
  66            ,@body)
  67        (context-coloring-test-after-all))))
  68
  69 (defun context-coloring-test-with-temp-buffer-async (callback)
  70   "Create a temporary buffer, and evaluate CALLBACK there.  A
  71 teardown callback is passed to CALLBACK for it to invoke when it
  72 is done."
  73   (let ((previous-buffer (current-buffer))
  74         (temp-buffer (generate-new-buffer " *temp*")))
  75     (set-buffer temp-buffer)
  76     (funcall
  77      callback
  78      (lambda ()
  79        (and (buffer-name temp-buffer)
  80             (kill-buffer temp-buffer))
  81        (set-buffer previous-buffer)))))
  82
  83 (defun context-coloring-test-with-fixture-async (fixture callback)
  84   "With the relative FIXTURE, evaluate CALLBACK in a temporary
  85 buffer.  A teardown callback is passed to CALLBACK for it to
  86 invoke when it is done."
  87   (context-coloring-test-with-temp-buffer-async
  88    (lambda (done-with-temp-buffer)
  89      (context-coloring-test-before-all)
  90      (insert (context-coloring-test-read-file fixture))
  91      (funcall
  92       callback
  93       (lambda ()
  94         (context-coloring-test-after-all)
  95         (funcall done-with-temp-buffer))))))
  96
  97
  98 ;;; Test defining utilities
  99
 100 (cl-defmacro context-coloring-test-define-deftest (name
 101                                                    &key mode
 102                                                    &key extension
 103                                                    &key async)
 104   "Define a deftest defmacro for tests prefixed with NAME. MODE
 105 is called to set up the test's environment.  EXTENSION denotes
 106 the suffix for tests' fixture files."
 107   (declare (indent defun))
 108   (let ((macro-name (intern (format "context-coloring-test-deftest-%s" name))))
 109     `(cl-defmacro ,macro-name (name
 110                                body
 111                                &key fixture
 112                                &key before
 113                                &key after)
 114        ,(format "Define a test for `%s' suffixed with NAME.
 115 Function BODY makes assertions.  The default fixture has a
 116 filename matching NAME (plus the filetype extension, \"%s\"),
 117 unless FIXTURE is specified to override it.  Functions BEFORE
 118 and AFTER run before and after the test, even if an error is
 119 signaled.
 120
 121 BODY is run after `context-coloring-mode' is activated, or after
 122 initial colorization if colorization should occur."
 123                 (cadr mode) extension)
 124        (declare (indent defun))
 125        ;; Commas in nested backquotes are not evaluated.  Binding the mode here
 126        ;; is probably the cleanest workaround.
 127        (let ((mode ,mode)
 128              (test-name (intern (format ,(format "%s-%%s" name) name)))
 129              (fixture (cond
 130                        (fixture (format "./fixtures/%s" fixture))
 131                        (t (format ,(format "./fixtures/%%s.%s" extension) name)))))
 132          ,@(cond
 133             (async
 134              `(`(ert-deftest-async ,test-name (done)
 135                   (context-coloring-test-with-fixture-async
 136                    ,fixture
 137                    (lambda (done-with-fixture)
 138                      (,mode)
 139                      (when ,before (funcall ,before))
 140                      (context-coloring-mode)
 141                      ;; TODO: Rigid expectations, should be looser.
 142                      (context-coloring-colorize
 143                       (lambda ()
 144                         (unwind-protect
 145                             (progn
 146                               (funcall ,body))
 147                           (when ,after (funcall ,after))
 148                           (funcall done-with-fixture))
 149                         (funcall done))))))))
 150             (t
 151              `(`(ert-deftest ,test-name ()
 152                   (context-coloring-test-with-fixture
 153                    ,fixture
 154                    (,mode)
 155                    (when ,before (funcall ,before))
 156                    (context-coloring-mode)
 157                    (unwind-protect
 158                        (progn
 159                          (funcall ,body))
 160                      (when ,after (funcall ,after))))))))))))
 161
 162 (context-coloring-test-define-deftest js
 163   :mode 'js-mode
 164   :extension "js"
 165   :async t)
 166
 167 ;; TODO: Do we need some way to do
 168 ;;   (setq js2-mode-show-parse-errors nil)
 169 ;;   (setq js2-mode-show-strict-warnings nil)
 170 ;; ?
 171 (context-coloring-test-define-deftest js2
 172   :mode 'js2-mode
 173   :extension "js")
 174
 175 (context-coloring-test-define-deftest emacs-lisp
 176   :mode 'emacs-lisp-mode
 177   :extension "el")
 178
 179
 180 ;;; Assertion functions
 181
 182 (defun context-coloring-test-assert-position-level (position level)
 183   "Assert that POSITION has LEVEL."
 184   (let ((face (get-text-property position 'face))
 185         actual-level)
 186     (when (not (and face
 187                     (let* ((face-string (symbol-name face))
 188                            (matches (string-match
 189                                      context-coloring-level-face-regexp
 190                                      face-string)))
 191                       (when matches
 192                         (setq actual-level (string-to-number
 193                                             (substring face-string
 194                                                        (match-beginning 1)
 195                                                        (match-end 1))))
 196                         (= level actual-level)))))
 197       (ert-fail (format (concat "Expected level at position %s, "
 198                                 "which is \"%s\", to be %s; "
 199                                 "but it was %s")
 200                         position
 201                         (buffer-substring-no-properties position (1+ position)) level
 202                         actual-level)))))
 203
 204 (defun context-coloring-test-assert-position-face (position face-regexp)
 205   "Assert that the face at POSITION satisfies FACE-REGEXP."
 206   (let ((face (get-text-property position 'face)))
 207     (when (or
 208            ;; Pass a non-string to do an `equal' check (against a symbol or nil).
 209            (unless (stringp face-regexp)
 210              (not (equal face-regexp face)))
 211            ;; Otherwise do the matching.
 212            (when (stringp face-regexp)
 213              (not (string-match-p face-regexp (symbol-name face)))))
 214       (ert-fail (format (concat "Expected face at position %s, "
 215                                 "which is \"%s\", to be %s; "
 216                                 "but it was %s")
 217                         position
 218                         (buffer-substring-no-properties position (1+ position)) face-regexp
 219                         face)))))
 220
 221 (defun context-coloring-test-assert-position-comment (position)
 222   (context-coloring-test-assert-position-face
 223    position "\\`font-lock-comment\\(-delimiter\\)?-face\\'"))
 224
 225 (defun context-coloring-test-assert-position-constant-comment (position)
 226   (context-coloring-test-assert-position-face position '(font-lock-constant-face
 227                                                          font-lock-comment-face)))
 228
 229 (defun context-coloring-test-assert-position-string (position)
 230   (context-coloring-test-assert-position-face position 'font-lock-string-face))
 231
 232 (defun context-coloring-test-assert-position-nil (position)
 233   (context-coloring-test-assert-position-face position nil))
 234
 235 (defun context-coloring-test-assert-coloring (map)
 236   "Assert that the current buffer's coloring matches MAP."
 237   ;; Omit the superfluous, formatting-related leading newline.  Can't use
 238   ;; `save-excursion' here because if an assertion fails it will cause future
 239   ;; tests to get messed up.
 240   (goto-char (point-min))
 241   (let* ((map (substring map 1))
 242          (index 0)
 243          char-string
 244          char)
 245     (while (< index (length map))
 246       (setq char-string (substring map index (1+ index)))
 247       (setq char (string-to-char char-string))
 248       (cond
 249        ;; Newline
 250        ((= char 10)
 251         (next-logical-line)
 252         (beginning-of-line))
 253        ;; Number
 254        ((and (>= char 48)
 255              (<= char 57))
 256         (context-coloring-test-assert-position-level
 257          (point) (string-to-number char-string))
 258         (forward-char))
 259        ;; ';' = Comment
 260        ((= char 59)
 261         (context-coloring-test-assert-position-comment (point))
 262         (forward-char))
 263        ;; 'c' = Constant comment
 264        ((= char 99)
 265         (context-coloring-test-assert-position-constant-comment (point))
 266         (forward-char))
 267        ;; 'n' = nil
 268        ((= char 110)
 269         (context-coloring-test-assert-position-nil (point))
 270         (forward-char))
 271        ;; 's' = String
 272        ((= char 115)
 273         (context-coloring-test-assert-position-string (point))
 274         (forward-char))
 275        (t
 276         (forward-char)))
 277       (setq index (1+ index)))))
 278
 279 (defmacro context-coloring-test-assert-region (&rest body)
 280   "Assert something about the face of points in a region.
 281 Provides the free variables `i', `length', `point', `face' and
 282 `actual-level' to the code in BODY."
 283   `(let ((i 0)
 284          (length (- end start)))
 285      (while (< i length)
 286        (let* ((point (+ i start))
 287               (face (get-text-property point 'face)))
 288          ,@body)
 289        (setq i (+ i 1)))))
 290
 291 (defun context-coloring-test-assert-region-level (start end level)
 292   "Assert that all points in the range [START, END) are of level
 293 LEVEL."
 294   (context-coloring-test-assert-region
 295    (let (actual-level)
 296      (when (not (when face
 297                   (let* ((face-string (symbol-name face))
 298                          (matches (string-match
 299                                    context-coloring-level-face-regexp
 300                                    face-string)))
 301                     (when matches
 302                       (setq actual-level (string-to-number
 303                                           (substring face-string
 304                                                      (match-beginning 1)
 305                                                      (match-end 1))))
 306                       (= level actual-level)))))
 307        (ert-fail (format (concat "Expected level in region [%s, %s), "
 308                                  "which is \"%s\", to be %s; "
 309                                  "but at point %s, it was %s")
 310                          start end
 311                          (buffer-substring-no-properties start end) level
 312                          point actual-level))))))
 313
 314 (defun context-coloring-test-assert-region-face (start end expected-face)
 315   "Assert that all points in the range [START, END) have the face
 316 EXPECTED-FACE."
 317   (context-coloring-test-assert-region
 318    (when (not (eq face expected-face))
 319      (ert-fail (format (concat "Expected face in region [%s, %s), "
 320                                "which is \"%s\", to be %s; "
 321                                "but at point %s, it was %s")
 322                        start end
 323                        (buffer-substring-no-properties start end) expected-face
 324                        point face)))))
 325
 326 (defun context-coloring-test-assert-region-comment-delimiter (start end)
 327   "Assert that all points in the range [START, END) have
 328 `font-lock-comment-delimiter-face'."
 329   (context-coloring-test-assert-region-face
 330    start end 'font-lock-comment-delimiter-face))
 331
 332 (defun context-coloring-test-assert-region-comment (start end)
 333   "Assert that all points in the range [START, END) have
 334 `font-lock-comment-face'."
 335   (context-coloring-test-assert-region-face
 336    start end 'font-lock-comment-face))
 337
 338 (defun context-coloring-test-assert-region-string (start end)
 339   "Assert that all points in the range [START, END) have
 340 `font-lock-string-face'."
 341   (context-coloring-test-assert-region-face
 342    start end 'font-lock-string-face))
 343
 344 (defun context-coloring-test-get-last-message ()
 345   (let ((messages (split-string
 346                    (buffer-substring-no-properties
 347                     (point-min)
 348                     (point-max))
 349                    "\n")))
 350     (car (nthcdr (- (length messages) 2) messages))))
 351
 352 (defun context-coloring-test-assert-message (expected buffer)
 353   "Assert that message EXPECTED is at the end of BUFFER."
 354   (when (null (get-buffer buffer))
 355     (ert-fail
 356      (format
 357       (concat
 358        "Expected buffer `%s' to have message \"%s\", "
 359        "but the buffer did not have any messages.")
 360       buffer expected)))
 361   (with-current-buffer buffer
 362     (let ((message (context-coloring-test-get-last-message)))
 363       (when (not (equal message expected))
 364         (ert-fail
 365          (format
 366           (concat
 367            "Expected buffer `%s' to have message \"%s\", "
 368            "but instead it was \"%s\"")
 369           buffer expected
 370           message))))))
 371
 372 (defun context-coloring-test-assert-not-message (expected buffer)
 373   "Assert that message EXPECTED is not at the end of BUFFER."
 374   (when (get-buffer buffer)
 375     (with-current-buffer buffer
 376       (let ((message (context-coloring-test-get-last-message)))
 377         (when (equal message expected)
 378           (ert-fail
 379            (format
 380             (concat
 381              "Expected buffer `%s' not to have message \"%s\", "
 382              "but it did")
 383             buffer expected)))))))
 384
 385 (defun context-coloring-test-assert-no-message (buffer)
 386   "Assert that BUFFER has no message."
 387   (when (get-buffer buffer)
 388     (ert-fail (format (concat "Expected buffer `%s' to have no messages, "
 389                               "but it did: `%s'")
 390                       buffer
 391                       (with-current-buffer buffer
 392                         (buffer-string))))))
 393
 394 (defun context-coloring-test-kill-buffer (buffer)
 395   "Kill BUFFER if it exists."
 396   (when (get-buffer buffer) (kill-buffer buffer)))
 397
 398 (defun context-coloring-test-assert-face (level foreground &optional negate)
 399   "Assert that a face for LEVEL exists and that its `:foreground'
 400 is FOREGROUND, or the inverse if NEGATE is non-nil."
 401   (let* ((face (context-coloring-level-face level))
 402          actual-foreground)
 403     (when (not (or negate
 404                    face))
 405       (ert-fail (format (concat "Expected face for level `%s' to exist; "
 406                                 "but it didn't")
 407                         level)))
 408     (setq actual-foreground (face-attribute face :foreground))
 409     (when (funcall (if negate 'identity 'not)
 410                    (string-equal foreground actual-foreground))
 411       (ert-fail (format (concat "Expected face for level `%s' "
 412                                 "%sto have foreground `%s'; "
 413                                 "but it %s.")
 414                         level
 415                         (if negate "not " "") foreground
 416                         (if negate
 417                             "did" (format "was `%s'" actual-foreground)))))))
 418
 419 (defun context-coloring-test-assert-not-face (&rest arguments)
 420   "Assert that LEVEL does not have a face with `:foreground'
 421 FOREGROUND.  Apply ARGUMENTS to
 422 `context-coloring-test-assert-face', see that function."
 423   (apply 'context-coloring-test-assert-face
 424          (append arguments '(t))))
 425
 426 (defun context-coloring-test-assert-error (body error-message)
 427   "Assert that BODY signals ERROR-MESSAGE."
 428   (let ((error-signaled-p nil))
 429     (condition-case err
 430         (progn
 431           (funcall body))
 432       (error
 433        (setq error-signaled-p t)
 434        (when (not (string-equal (cadr err) error-message))
 435          (ert-fail (format (concat "Expected the error \"%s\" to be thrown, "
 436                                    "but instead it was \"%s\".")
 437                            error-message
 438                            (cadr err))))))
 439     (when (not error-signaled-p)
 440       (ert-fail "Expected an error to be thrown, but there wasn't."))))
 441
 442 (defun context-coloring-test-assert-trimmed (result expected)
 443   (when (not (string-equal result expected))
 444     (ert-fail "Expected string to be trimmed, but it wasn't.")))
 445
 446
 447 ;;; The tests
 448
 449 (ert-deftest context-coloring-test-trim ()
 450   (context-coloring-test-assert-trimmed (context-coloring-trim "") "")
 451   (context-coloring-test-assert-trimmed (context-coloring-trim " ") "")
 452   (context-coloring-test-assert-trimmed (context-coloring-trim "a") "a")
 453   (context-coloring-test-assert-trimmed (context-coloring-trim " a") "a")
 454   (context-coloring-test-assert-trimmed (context-coloring-trim "a ") "a")
 455   (context-coloring-test-assert-trimmed (context-coloring-trim " a ") "a"))
 456
 457 (ert-deftest-async context-coloring-test-async-mode-startup (done)
 458   (context-coloring-test-with-fixture-async
 459    "./fixtures/empty"
 460    (lambda (teardown)
 461      (js-mode)
 462      (add-hook
 463       'context-coloring-colorize-hook
 464       (lambda ()
 465         ;; If this runs we are implicitly successful; this test only confirms
 466         ;; that colorization occurs on mode startup.
 467         (funcall teardown)
 468         (funcall done)))
 469      (context-coloring-mode))))
 470
 471 (define-derived-mode
 472   context-coloring-change-detection-mode
 473   fundamental-mode
 474   "Testing"
 475   "Prevent `context-coloring-test-change-detection' from
 476   having any unintentional side-effects on mode support.")
 477
 478 ;; Simply cannot figure out how to trigger an idle timer; would much rather test
 479 ;; that.  But (current-idle-time) always returns nil in these tests.
 480 (ert-deftest-async context-coloring-test-change-detection (done)
 481   (context-coloring-define-dispatch
 482      'idle-change
 483      :modes '(context-coloring-change-detection-mode)
 484      :executable "node"
 485      :command "node test/binaries/noop")
 486   (context-coloring-test-with-fixture-async
 487    "./fixtures/empty"
 488    (lambda (teardown)
 489      (context-coloring-change-detection-mode)
 490      (add-hook
 491       'context-coloring-colorize-hook
 492       (lambda ()
 493         (setq context-coloring-colorize-hook nil)
 494         (add-hook
 495          'context-coloring-colorize-hook
 496          (lambda ()
 497            (funcall teardown)
 498            (funcall done)))
 499         (insert " ")
 500         (set-window-buffer (selected-window) (current-buffer))
 501         (context-coloring-maybe-colorize (current-buffer))))
 502      (context-coloring-mode))))
 503
 504 (ert-deftest context-coloring-test-check-version ()
 505   (when (not (context-coloring-check-version "2.1.3" "3.0.1"))
 506     (ert-fail "Expected version 3.0.1 to satisfy 2.1.3, but it didn't."))
 507   (when (context-coloring-check-version "3.0.1" "2.1.3")
 508     (ert-fail "Expected version 2.1.3 not to satisfy 3.0.1, but it did.")))
 509
 510 (ert-deftest context-coloring-test-unsupported-mode ()
 511   (context-coloring-test-with-fixture
 512    "./fixtures/empty"
 513    (context-coloring-mode)
 514    (context-coloring-test-assert-message
 515     "Context coloring is not available for this major mode"
 516     "*Messages*")))
 517
 518 (ert-deftest context-coloring-test-derived-mode ()
 519   (context-coloring-test-with-fixture
 520    "./fixtures/empty"
 521    (lisp-interaction-mode)
 522    (context-coloring-mode)
 523    (context-coloring-test-assert-not-message
 524     "Context coloring is not available for this major mode"
 525     "*Messages*")))
 526
 527 (define-derived-mode
 528   context-coloring-test-define-dispatch-error-mode
 529   fundamental-mode
 530   "Testing"
 531   "Prevent `context-coloring-test-define-dispatch-error' from
 532   having any unintentional side-effects on mode support.")
 533
 534 (ert-deftest context-coloring-test-define-dispatch-error ()
 535   (context-coloring-test-assert-error
 536    (lambda ()
 537      (context-coloring-define-dispatch
 538       'define-dispatch-no-modes))
 539    "No mode defined for dispatch")
 540   (context-coloring-test-assert-error
 541    (lambda ()
 542      (context-coloring-define-dispatch
 543       'define-dispatch-no-strategy
 544       :modes '(context-coloring-test-define-dispatch-error-mode)))
 545    "No colorizer, scopifier or command defined for dispatch"))
 546
 547 (define-derived-mode
 548   context-coloring-test-define-dispatch-scopifier-mode
 549   fundamental-mode
 550   "Testing"
 551   "Prevent `context-coloring-test-define-dispatch-scopifier' from
 552   having any unintentional side-effects on mode support.")
 553
 554 (ert-deftest context-coloring-test-define-dispatch-scopifier ()
 555   (context-coloring-define-dispatch
 556    'define-dispatch-scopifier
 557    :modes '(context-coloring-test-define-dispatch-scopifier-mode)
 558    :scopifier (lambda () (vector)))
 559   (with-temp-buffer
 560     (context-coloring-test-define-dispatch-scopifier-mode)
 561     (context-coloring-mode)
 562     (context-coloring-colorize)))
 563
 564 (define-derived-mode
 565   context-coloring-test-missing-executable-mode
 566   fundamental-mode
 567   "Testing"
 568   "Prevent `context-coloring-test-define-dispatch-scopifier' from
 569   having any unintentional side-effects on mode support.")
 570
 571 (ert-deftest context-coloring-test-missing-executable ()
 572   (context-coloring-define-dispatch
 573    'scopifier
 574    :modes '(context-coloring-test-missing-executable-mode)
 575    :command ""
 576    :executable "__should_not_exist__")
 577   (with-temp-buffer
 578     (context-coloring-test-missing-executable-mode)
 579     (context-coloring-mode)))
 580
 581 (define-derived-mode
 582   context-coloring-test-unsupported-version-mode
 583   fundamental-mode
 584   "Testing"
 585   "Prevent `context-coloring-test-unsupported-version' from
 586   having any unintentional side-effects on mode support.")
 587
 588 (ert-deftest-async context-coloring-test-unsupported-version (done)
 589   (context-coloring-define-dispatch
 590    'outta-date
 591    :modes '(context-coloring-test-unsupported-version-mode)
 592    :executable "node"
 593    :command "node test/binaries/outta-date"
 594    :version "v2.1.3")
 595   (context-coloring-test-with-fixture-async
 596    "./fixtures/empty"
 597    (lambda (teardown)
 598      (context-coloring-test-unsupported-version-mode)
 599      (add-hook
 600       'context-coloring-check-scopifier-version-hook
 601       (lambda ()
 602         (unwind-protect
 603             (progn
 604               ;; Normally the executable would be something like "outta-date"
 605               ;; rather than "node".
 606               (context-coloring-test-assert-message
 607                "Update to the minimum version of \"node\" (v2.1.3)"
 608                "*Messages*"))
 609           (funcall teardown))
 610         (funcall done)))
 611      (context-coloring-mode))))
 612
 613 (define-derived-mode
 614   context-coloring-test-disable-mode-mode
 615   fundamental-mode
 616   "Testing"
 617   "Prevent `context-coloring-test-disable-mode' from having any
 618   unintentional side-effects on mode support.")
 619
 620 (ert-deftest-async context-coloring-test-disable-mode (done)
 621   (let (torn-down)
 622     (context-coloring-define-dispatch
 623      'disable-mode
 624      :modes '(context-coloring-test-disable-mode-mode)
 625      :executable "node"
 626      :command "node test/binaries/noop"
 627      :teardown (lambda ()
 628                  (setq torn-down t)))
 629     (context-coloring-test-with-fixture-async
 630      "./fixtures/empty"
 631      (lambda (teardown)
 632        (unwind-protect
 633            (progn
 634              (context-coloring-test-disable-mode-mode)
 635              (context-coloring-mode)
 636              (context-coloring-mode -1)
 637              (when (not torn-down)
 638                (ert-fail "Expected teardown function to have been called, but it wasn't.")))
 639          (funcall teardown))
 640        (funcall done)))))
 641
 642 (defvar context-coloring-test-theme-index 0
 643   "Unique index for unique theme names.")
 644
 645 (defun context-coloring-test-get-next-theme ()
 646   "Return a unique symbol for a throwaway theme."
 647   (prog1
 648       (intern (format "context-coloring-test-theme-%s"
 649                       context-coloring-test-theme-index))
 650     (setq context-coloring-test-theme-index
 651           (+ context-coloring-test-theme-index 1))))
 652
 653 (defun context-coloring-test-assert-theme-originally-set-p
 654     (settings &optional negate)
 655   "Assert that `context-coloring-theme-originally-set-p' returns
 656 t for a theme with SETTINGS, or the inverse if NEGATE is
 657 non-nil."
 658   (let ((theme (context-coloring-test-get-next-theme)))
 659     (put theme 'theme-settings settings)
 660     (when (funcall (if negate 'identity 'not)
 661                    (context-coloring-theme-originally-set-p theme))
 662       (ert-fail (format (concat "Expected theme `%s' with settings `%s' "
 663                                 "%sto be considered to have defined a level, "
 664                                 "but it %s.")
 665                         theme settings
 666                         (if negate "not " "")
 667                         (if negate "was" "wasn't"))))))
 668
 669 (defun context-coloring-test-assert-not-theme-originally-set-p (&rest arguments)
 670   "Assert that `context-coloring-theme-originally-set-p' does not
 671 return t for a theme with SETTINGS.  Apply ARGUMENTS to
 672 `context-coloring-test-assert-theme-originally-set-p', see that
 673 function."
 674   (apply 'context-coloring-test-assert-theme-originally-set-p
 675          (append arguments '(t))))
 676
 677 (ert-deftest context-coloring-test-theme-originally-set-p ()
 678   (context-coloring-test-assert-theme-originally-set-p
 679    '((theme-face context-coloring-level-0-face)))
 680   (context-coloring-test-assert-theme-originally-set-p
 681    '((theme-face face)
 682      (theme-face context-coloring-level-0-face)))
 683   (context-coloring-test-assert-theme-originally-set-p
 684    '((theme-face context-coloring-level-0-face)
 685      (theme-face face)))
 686   (context-coloring-test-assert-not-theme-originally-set-p
 687    '((theme-face face)))
 688   )
 689
 690 (defun context-coloring-test-assert-theme-settings-highest-level
 691     (settings expected-level)
 692   "Assert that a theme with SETTINGS has the highest level
 693 EXPECTED-LEVEL."
 694   (let ((theme (context-coloring-test-get-next-theme)))
 695     (put theme 'theme-settings settings)
 696     (context-coloring-test-assert-theme-highest-level theme expected-level)))
 697
 698 (defun context-coloring-test-assert-theme-highest-level
 699     (theme expected-level &optional negate)
 700   "Assert that THEME has the highest level EXPECTED-LEVEL, or the
 701 inverse if NEGATE is non-nil."
 702   (let ((highest-level (context-coloring-theme-highest-level theme)))
 703     (when (funcall (if negate 'identity 'not) (eq highest-level expected-level))
 704       (ert-fail (format (concat "Expected theme with settings `%s' "
 705                                 "%sto have a highest level of `%s', "
 706                                 "but it %s.")
 707                         (get theme 'theme-settings)
 708                         (if negate "not " "") expected-level
 709                         (if negate "did" (format "was %s" highest-level)))))))
 710
 711 (defun context-coloring-test-assert-theme-not-highest-level (&rest arguments)
 712   "Assert that THEME's highest level is not EXPECTED-LEVEL.
 713 Apply ARGUMENTS to
 714 `context-coloring-test-assert-theme-highest-level', see that
 715 function."
 716   (apply 'context-coloring-test-assert-theme-highest-level
 717          (append arguments '(t))))
 718
 719 (ert-deftest context-coloring-test-theme-highest-level ()
 720   (context-coloring-test-assert-theme-settings-highest-level
 721    '((theme-face foo))
 722    -1)
 723   (context-coloring-test-assert-theme-settings-highest-level
 724    '((theme-face context-coloring-level-0-face))
 725    0)
 726   (context-coloring-test-assert-theme-settings-highest-level
 727    '((theme-face context-coloring-level-1-face))
 728    1)
 729   (context-coloring-test-assert-theme-settings-highest-level
 730    '((theme-face context-coloring-level-1-face)
 731      (theme-face context-coloring-level-0-face))
 732    1)
 733   (context-coloring-test-assert-theme-settings-highest-level
 734    '((theme-face context-coloring-level-0-face)
 735      (theme-face context-coloring-level-1-face))
 736    1)
 737   )
 738
 739 (defmacro context-coloring-test-deftest-define-theme (name &rest body)
 740   "Define a test with name NAME and an automatically-generated
 741 theme symbol available as a free variable `theme'.  Side-effects
 742 from enabling themes are reversed after BODY is executed and the
 743 test completes."
 744   (declare (indent defun))
 745   (let ((deftest-name (intern
 746                        (format "context-coloring-test-define-theme-%s" name))))
 747     `(ert-deftest ,deftest-name ()
 748        (context-coloring-test-kill-buffer "*Warnings*")
 749        (context-coloring-test-before-all)
 750        (let ((theme (context-coloring-test-get-next-theme)))
 751          (unwind-protect
 752              (progn
 753                ,@body)
 754            ;; Always cleanup.
 755            (disable-theme theme)
 756            (context-coloring-test-after-all))))))
 757
 758 (defun context-coloring-test-deftheme (theme)
 759   "Dynamically define theme THEME."
 760   (eval (macroexpand `(deftheme ,theme))))
 761
 762 (context-coloring-test-deftest-define-theme additive
 763   (context-coloring-test-deftheme theme)
 764   (context-coloring-define-theme
 765    theme
 766    :colors '("#aaaaaa"
 767              "#bbbbbb"))
 768   (context-coloring-test-assert-no-message "*Warnings*")
 769   (enable-theme theme)
 770   (context-coloring-test-assert-no-message "*Warnings*")
 771   (context-coloring-test-assert-face 0 "#aaaaaa")
 772   (context-coloring-test-assert-face 1 "#bbbbbb"))
 773
 774 (defun context-coloring-test-assert-defined-warning (theme)
 775   "Assert that a warning about colors already being defined for
 776 theme THEME is signaled."
 777   (context-coloring-test-assert-message
 778    (format (concat "Warning (emacs): Context coloring colors for theme "
 779                    "`%s' are already defined")
 780            theme)
 781    "*Warnings*"))
 782
 783 (context-coloring-test-deftest-define-theme unintentional-override
 784   (context-coloring-test-deftheme theme)
 785   (custom-theme-set-faces
 786    theme
 787    '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
 788    '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
 789   (context-coloring-define-theme
 790    theme
 791    :colors '("#cccccc"
 792              "#dddddd"))
 793   (context-coloring-test-assert-defined-warning theme)
 794   (context-coloring-test-kill-buffer "*Warnings*")
 795   (enable-theme theme)
 796   (context-coloring-test-assert-defined-warning theme)
 797   (context-coloring-test-assert-face 0 "#cccccc")
 798   (context-coloring-test-assert-face 1 "#dddddd"))
 799
 800 (context-coloring-test-deftest-define-theme intentional-override
 801   (context-coloring-test-deftheme theme)
 802   (custom-theme-set-faces
 803    theme
 804    '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
 805    '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
 806   (context-coloring-define-theme
 807    theme
 808    :override t
 809    :colors '("#cccccc"
 810              "#dddddd"))
 811   (context-coloring-test-assert-no-message "*Warnings*")
 812   (enable-theme theme)
 813   (context-coloring-test-assert-no-message "*Warnings*")
 814   (context-coloring-test-assert-face 0 "#cccccc")
 815   (context-coloring-test-assert-face 1 "#dddddd"))
 816
 817 (context-coloring-test-deftest-define-theme pre-recede
 818   (context-coloring-define-theme
 819    theme
 820    :recede t
 821    :colors '("#aaaaaa"
 822              "#bbbbbb"))
 823   (context-coloring-test-deftheme theme)
 824   (custom-theme-set-faces
 825    theme
 826    '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
 827    '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
 828   (enable-theme theme)
 829   (context-coloring-test-assert-no-message "*Warnings*")
 830   (context-coloring-test-assert-face 0 "#cccccc")
 831   (context-coloring-test-assert-face 1 "#dddddd"))
 832
 833 (context-coloring-test-deftest-define-theme pre-recede-delayed-application
 834   (context-coloring-define-theme
 835    theme
 836    :recede t
 837    :colors '("#aaaaaa"
 838              "#bbbbbb"))
 839   (context-coloring-test-deftheme theme)
 840   (enable-theme theme)
 841   (context-coloring-test-assert-no-message "*Warnings*")
 842   (context-coloring-test-assert-face 0 "#aaaaaa")
 843   (context-coloring-test-assert-face 1 "#bbbbbb"))
 844
 845 (context-coloring-test-deftest-define-theme post-recede
 846   (context-coloring-test-deftheme theme)
 847   (custom-theme-set-faces
 848    theme
 849    '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
 850    '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
 851   (context-coloring-define-theme
 852    theme
 853    :recede t
 854    :colors '("#cccccc"
 855              "#dddddd"))
 856   (context-coloring-test-assert-no-message "*Warnings*")
 857   (context-coloring-test-assert-face 0 "#aaaaaa")
 858   (context-coloring-test-assert-face 1 "#bbbbbb")
 859   (enable-theme theme)
 860   (context-coloring-test-assert-no-message "*Warnings*")
 861   (context-coloring-test-assert-face 0 "#aaaaaa")
 862   (context-coloring-test-assert-face 1 "#bbbbbb"))
 863
 864 (context-coloring-test-deftest-define-theme recede-not-defined
 865   (context-coloring-test-deftheme theme)
 866   (custom-theme-set-faces
 867    theme
 868    '(foo-face ((t (:foreground "#ffffff")))))
 869   (context-coloring-define-theme
 870    theme
 871    :recede t
 872    :colors '("#aaaaaa"
 873              "#bbbbbb"))
 874   (context-coloring-test-assert-no-message "*Warnings*")
 875   (context-coloring-test-assert-face 0 "#aaaaaa")
 876   (context-coloring-test-assert-face 1 "#bbbbbb")
 877   (enable-theme theme)
 878   (context-coloring-test-assert-no-message "*Warnings*")
 879   (context-coloring-test-assert-face 0 "#aaaaaa")
 880   (context-coloring-test-assert-face 1 "#bbbbbb"))
 881
 882 (context-coloring-test-deftest-define-theme unintentional-obstinance
 883   (context-coloring-define-theme
 884    theme
 885    :colors '("#aaaaaa"
 886              "#bbbbbb"))
 887   (context-coloring-test-deftheme theme)
 888   (custom-theme-set-faces
 889    theme
 890    '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
 891    '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
 892   (enable-theme theme)
 893   (context-coloring-test-assert-defined-warning theme)
 894   (context-coloring-test-assert-face 0 "#aaaaaa")
 895   (context-coloring-test-assert-face 1 "#bbbbbb"))
 896
 897 (context-coloring-test-deftest-define-theme intentional-obstinance
 898   (context-coloring-define-theme
 899    theme
 900    :override t
 901    :colors '("#aaaaaa"
 902              "#bbbbbb"))
 903   (context-coloring-test-deftheme theme)
 904   (custom-theme-set-faces
 905    theme
 906    '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
 907    '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
 908   (enable-theme theme)
 909   (context-coloring-test-assert-no-message "*Warnings*")
 910   (context-coloring-test-assert-face 0 "#aaaaaa")
 911   (context-coloring-test-assert-face 1 "#bbbbbb"))
 912
 913 (defun context-coloring-test-assert-maximum-face (maximum &optional negate)
 914   "Assert that `context-coloring-maximum-face' is MAXIMUM, or the
 915 inverse if NEGATE is non-nil."
 916   (when (funcall (if negate 'identity 'not)
 917                  (eq context-coloring-maximum-face maximum))
 918     (ert-fail (format (concat "Expected `context-coloring-maximum-face' "
 919                               "%sto be `%s', "
 920                               "but it %s.")
 921                       (if negate "not " "") maximum
 922                       (if negate
 923                           "was"
 924                         (format "was `%s'" context-coloring-maximum-face))))))
 925
 926 (defun context-coloring-test-assert-not-maximum-face (&rest arguments)
 927   "Assert that `context-coloring-maximum-face' is not MAXIMUM.
 928 Apply ARGUMENTS to `context-coloring-test-assert-maximum-face',
 929 see that function."
 930   (apply 'context-coloring-test-assert-maximum-face
 931          (append arguments '(t))))
 932
 933 (context-coloring-test-deftest-define-theme disable-cascade
 934   (let ((maximum-face-value 9999))
 935     (setq context-coloring-maximum-face maximum-face-value)
 936     (context-coloring-test-deftheme theme)
 937     (context-coloring-define-theme
 938      theme
 939      :colors '("#aaaaaa"
 940                "#bbbbbb"))
 941     (let ((second-theme (context-coloring-test-get-next-theme)))
 942       (context-coloring-test-deftheme second-theme)
 943       (context-coloring-define-theme
 944        second-theme
 945        :colors '("#cccccc"
 946                  "#dddddd"
 947                  "#eeeeee"))
 948       (let ((third-theme (context-coloring-test-get-next-theme)))
 949         (context-coloring-test-deftheme third-theme)
 950         (context-coloring-define-theme
 951          third-theme
 952          :colors '("#111111"
 953                    "#222222"
 954                    "#333333"
 955                    "#444444"))
 956         (enable-theme theme)
 957         (enable-theme second-theme)
 958         (enable-theme third-theme)
 959         (disable-theme third-theme)
 960         (context-coloring-test-assert-face 0 "#cccccc")
 961         (context-coloring-test-assert-face 1 "#dddddd")
 962         (context-coloring-test-assert-face 2 "#eeeeee")
 963         (context-coloring-test-assert-maximum-face 2))
 964       (disable-theme second-theme)
 965       (context-coloring-test-assert-face 0 "#aaaaaa")
 966       (context-coloring-test-assert-face 1 "#bbbbbb")
 967       (context-coloring-test-assert-maximum-face 1))
 968     (disable-theme theme)
 969     (context-coloring-test-assert-not-face 0 "#aaaaaa")
 970     (context-coloring-test-assert-not-face 1 "#bbbbbb")
 971     (context-coloring-test-assert-maximum-face
 972      maximum-face-value)))
 973
 974 (defun context-coloring-test-js-function-scopes ()
 975   (context-coloring-test-assert-region-level 1 9 0)
 976   (context-coloring-test-assert-region-level 9 23 1)
 977   (context-coloring-test-assert-region-level 23 25 0)
 978   (context-coloring-test-assert-region-level 25 34 1)
 979   (context-coloring-test-assert-region-level 34 35 0)
 980   (context-coloring-test-assert-region-level 35 52 1)
 981   (context-coloring-test-assert-region-level 52 66 2)
 982   (context-coloring-test-assert-region-level 66 72 1)
 983   (context-coloring-test-assert-region-level 72 81 2)
 984   (context-coloring-test-assert-region-level 81 82 1)
 985   (context-coloring-test-assert-region-level 82 87 2)
 986   (context-coloring-test-assert-region-level 87 89 1))
 987
 988 (context-coloring-test-deftest-js function-scopes
 989   'context-coloring-test-js-function-scopes)
 990 (context-coloring-test-deftest-js2 function-scopes
 991   'context-coloring-test-js-function-scopes)
 992
 993 (defun context-coloring-test-js-global ()
 994   (context-coloring-test-assert-region-level 20 28 1)
 995   (context-coloring-test-assert-region-level 28 35 0)
 996   (context-coloring-test-assert-region-level 35 41 1))
 997
 998 (context-coloring-test-deftest-js global
 999   'context-coloring-test-js-global)
1000 (context-coloring-test-deftest-js2 global
1001   'context-coloring-test-js-global)
1002
1003 (defun context-coloring-test-js-block-scopes ()
1004   (context-coloring-colorize)
1005   (context-coloring-test-assert-region-level 20 27 1)
1006   (context-coloring-test-assert-region-level 27 41 2)
1007   (context-coloring-test-assert-region-level 41 42 1)
1008   (context-coloring-test-assert-region-level 42 64 2))
1009
1010 (context-coloring-test-deftest-js2 block-scopes
1011   'context-coloring-test-js-block-scopes
1012   :before (lambda ()
1013             (setq context-coloring-js-block-scopes t))
1014   :after (lambda ()
1015            (setq context-coloring-js-block-scopes nil)))
1016
1017 (defun context-coloring-test-js-catch ()
1018   (context-coloring-test-assert-region-level 20 27 1)
1019   (context-coloring-test-assert-region-level 27 51 2)
1020   (context-coloring-test-assert-region-level 51 52 1)
1021   (context-coloring-test-assert-region-level 52 73 2)
1022   (context-coloring-test-assert-region-level 73 101 3)
1023   (context-coloring-test-assert-region-level 101 102 1)
1024   (context-coloring-test-assert-region-level 102 117 3)
1025   (context-coloring-test-assert-region-level 117 123 2))
1026
1027 (context-coloring-test-deftest-js catch
1028   'context-coloring-test-js-catch)
1029 (context-coloring-test-deftest-js2 catch
1030   'context-coloring-test-js-catch)
1031
1032 (defun context-coloring-test-js-key-names ()
1033   (context-coloring-test-assert-region-level 20 63 1))
1034
1035 (context-coloring-test-deftest-js key-names
1036   'context-coloring-test-js-key-names)
1037 (context-coloring-test-deftest-js2 key-names
1038   'context-coloring-test-js-key-names)
1039
1040 (defun context-coloring-test-js-property-lookup ()
1041   (context-coloring-test-assert-region-level 20 26 0)
1042   (context-coloring-test-assert-region-level 26 38 1)
1043   (context-coloring-test-assert-region-level 38 44 0)
1044   (context-coloring-test-assert-region-level 44 52 1)
1045   (context-coloring-test-assert-region-level 57 63 0)
1046   (context-coloring-test-assert-region-level 63 74 1))
1047
1048 (context-coloring-test-deftest-js property-lookup
1049   'context-coloring-test-js-property-lookup)
1050 (context-coloring-test-deftest-js2 property-lookup
1051   'context-coloring-test-js-property-lookup)
1052
1053 (defun context-coloring-test-js-key-values ()
1054   (context-coloring-test-assert-region-level 78 79 1))
1055
1056 (context-coloring-test-deftest-js key-values
1057   'context-coloring-test-js-key-values)
1058 (context-coloring-test-deftest-js2 key-values
1059   'context-coloring-test-js-key-values)
1060
1061 (defun context-coloring-test-js-syntactic-comments-and-strings ()
1062   (context-coloring-test-assert-region-level 1 8 0)
1063   (context-coloring-test-assert-region-comment-delimiter 9 12)
1064   (context-coloring-test-assert-region-comment 12 16)
1065   (context-coloring-test-assert-region-comment-delimiter 17 20)
1066   (context-coloring-test-assert-region-comment 20 27)
1067   (context-coloring-test-assert-region-string 28 40)
1068   (context-coloring-test-assert-region-level 40 41 0))
1069
1070 (defun context-coloring-test-js-syntactic-comments-and-strings-setup ()
1071   (setq context-coloring-syntactic-comments t)
1072   (setq context-coloring-syntactic-strings t))
1073
1074 (context-coloring-test-deftest-js syntactic-comments-and-strings
1075   'context-coloring-test-js-syntactic-comments-and-strings
1076   :fixture "comments-and-strings.js"
1077   :before 'context-coloring-test-js-syntactic-comments-and-strings-setup)
1078 (context-coloring-test-deftest-js2 syntactic-comments-and-strings
1079   'context-coloring-test-js-syntactic-comments-and-strings
1080   :fixture "comments-and-strings.js"
1081   :before 'context-coloring-test-js-syntactic-comments-and-strings-setup)
1082
1083 (defun context-coloring-test-js-syntactic-comments ()
1084   (context-coloring-test-assert-region-level 1 8 0)
1085   (context-coloring-test-assert-region-comment-delimiter 9 12)
1086   (context-coloring-test-assert-region-comment 12 16)
1087   (context-coloring-test-assert-region-comment-delimiter 17 20)
1088   (context-coloring-test-assert-region-comment 20 27)
1089   (context-coloring-test-assert-region-level 28 41 0))
1090
1091 (defun context-coloring-test-js-syntactic-comments-setup ()
1092   (setq context-coloring-syntactic-comments t))
1093
1094 (context-coloring-test-deftest-js syntactic-comments
1095   'context-coloring-test-js-syntactic-comments
1096   :fixture "comments-and-strings.js"
1097   :before 'context-coloring-test-js-syntactic-comments-setup)
1098 (context-coloring-test-deftest-js2 syntactic-comments
1099   'context-coloring-test-js-syntactic-comments
1100   :fixture "comments-and-strings.js"
1101   :before 'context-coloring-test-js-syntactic-comments-setup)
1102
1103 (defun context-coloring-test-js-syntactic-strings ()
1104   (context-coloring-test-assert-region-level 1 28 0)
1105   (context-coloring-test-assert-region-string 28 40)
1106   (context-coloring-test-assert-region-level 40 41 0))
1107
1108 (defun context-coloring-test-js-syntactic-strings-setup ()
1109   (setq context-coloring-syntactic-strings t))
1110
1111 (context-coloring-test-deftest-js syntactic-strings
1112   'context-coloring-test-js-syntactic-strings
1113   :fixture "comments-and-strings.js"
1114   :before 'context-coloring-test-js-syntactic-strings-setup)
1115 (context-coloring-test-deftest-js2 syntactic-strings
1116   'context-coloring-test-js-syntactic-strings
1117   :fixture "comments-and-strings.js"
1118   :before 'context-coloring-test-js-syntactic-strings-setup)
1119
1120 (context-coloring-test-deftest-js2 unterminated-comment
1121   ;; As long as `add-text-properties' doesn't signal an error, this test passes.
1122   (lambda ()))
1123
1124 (context-coloring-test-deftest-emacs-lisp defun
1125   (lambda ()
1126     (context-coloring-test-assert-coloring "
1127 111111 000 1111 111 111111111 1111
1128   11 111 111 111 000011
1129
1130 0000 0 0 00
1131
1132 111111 01
1133 111111 111")))
1134
1135 (context-coloring-test-deftest-emacs-lisp lambda
1136   (lambda ()
1137     (context-coloring-test-assert-coloring "
1138 00000000 1111111 1111
1139            11111111 11 2222222 2222
1140                          222 22 12 2221 111 0 00")))
1141
1142 (context-coloring-test-deftest-emacs-lisp quote
1143   (lambda ()
1144     (context-coloring-test-assert-coloring "
1145 (xxxxx x (x)
1146   (xx (xx x 111
1147       111111 1 111 111
1148       111111 1 1111111111 11 111 1 111 1 00001 10000 11 00001 1 100001111")))
1149
1150 (context-coloring-test-deftest-emacs-lisp comment
1151   (lambda ()
1152     ;; Just check that the comment isn't parsed syntactically.
1153     (context-coloring-test-assert-coloring "
1154 (xxxxx x ()
1155   (xx (x xxxxx-xxxx xx)   ;;;;;;;;;;
1156       11 00000-0000 11))) ;;;;;;;;;;"))
1157   :before (lambda ()
1158             (setq context-coloring-syntactic-comments t)))
1159
1160 (context-coloring-test-deftest-emacs-lisp string
1161   (lambda ()
1162     (context-coloring-test-assert-coloring "
1163 (xxxxx x (x)
1164   (xxxxxx x x sss 1 0 sssss 0 1 sssssss11"))
1165   :before (lambda ()
1166             (setq context-coloring-syntactic-strings t)))
1167
1168 (context-coloring-test-deftest-emacs-lisp ignored
1169   (lambda ()
1170     (context-coloring-test-assert-coloring "
1171 (xxxxx x ()
1172   (x x 1 11 11 111 11 1 111 (1 1 1)))")))
1173
1174 (context-coloring-test-deftest-emacs-lisp let
1175   (lambda ()
1176     (context-coloring-test-assert-coloring "
1177 1111 11
1178       11 01
1179       11 00001
1180       11 2222 22
1181                22 02
1182                22 000022
1183            2222 2 2 2 00002211
1184   1111 1 1 1 000011")))
1185
1186 (context-coloring-test-deftest-emacs-lisp let*
1187   (lambda ()
1188     (context-coloring-test-assert-coloring "
1189 11111 11
1190        11 11
1191        11 000011
1192   1111 1 1 1 0 0 00001
1193   22222 22
1194          22 12
1195          22 00002
1196          22 02
1197          22 222
1198     2222 1 1 2 2 2 000022
1199   1111 1 1 1 0 0 000011")))
1200
1201 (defun context-coloring-test-insert-unread-space ()
1202   (setq unread-command-events (cons '(t . 32)
1203                                     unread-command-events)))
1204
1205 (defun context-coloring-test-remove-faces ()
1206   (remove-text-properties (point-min) (point-max) '(face nil)))
1207
1208 (context-coloring-test-deftest-emacs-lisp iteration
1209   (lambda ()
1210     (let ((context-coloring-emacs-lisp-iterations-per-pause 1))
1211       (context-coloring-colorize)
1212       (context-coloring-test-assert-coloring "
1213 ;; `cc' `cc'
1214 (xxxxx x ())")
1215       (context-coloring-test-remove-faces)
1216       (context-coloring-test-insert-unread-space)
1217       (context-coloring-colorize)
1218       ;; The first iteration will color the first part of the comment, but
1219       ;; that's it.  Then it will be interrupted.
1220       (context-coloring-test-assert-coloring "
1221 ;; nnnn nnnn
1222 nnnnnn n nnn")))
1223   :before (lambda ()
1224             (setq context-coloring-syntactic-comments t)
1225             (setq context-coloring-syntactic-strings t)))
1226
1227 (provide 'context-coloring-test)
1228
1229 ;;; context-coloring-test.el ends here