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