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   "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-assert-message (expected buffer)
 352   "Assert that message EXPECTED exists in BUFFER."
 353   (when (null (get-buffer buffer))
 354     (ert-fail
 355      (format
 356       (concat
 357        "Expected buffer `%s' to have message \"%s\", "
 358        "but the buffer did not have any messages.")
 359       buffer expected)))
 360   (with-current-buffer buffer
 361     (let ((messages (split-string
 362                      (buffer-substring-no-properties
 363                       (point-min)
 364                       (point-max))
 365                      "\n")))
 366       (let ((message (car (nthcdr (- (length messages) 2) messages))))
 367         (when (not (equal message expected))
 368           (ert-fail
 369            (format
 370             (concat
 371              "Expected buffer `%s' to have message \"%s\", "
 372              "but instead it was \"%s\"")
 373             buffer expected
 374             message)))))))
 375
 376 (defun context-coloring-test-assert-no-message (buffer)
 377   "Assert that BUFFER has no message."
 378   (when (get-buffer buffer)
 379     (ert-fail (format (concat "Expected buffer `%s' to have no messages, "
 380                               "but it did: `%s'")
 381                       buffer
 382                       (with-current-buffer buffer
 383                         (buffer-string))))))
 384
 385 (defun context-coloring-test-kill-buffer (buffer)
 386   "Kill BUFFER if it exists."
 387   (when (get-buffer buffer) (kill-buffer buffer)))
 388
 389 (defun context-coloring-test-assert-face (level foreground &optional negate)
 390   "Assert that a face for LEVEL exists and that its `:foreground'
 391 is FOREGROUND, or the inverse if NEGATE is non-nil."
 392   (let* ((face (context-coloring-level-face level))
 393          actual-foreground)
 394     (when (not (or negate
 395                    face))
 396       (ert-fail (format (concat "Expected face for level `%s' to exist; "
 397                                 "but it didn't")
 398                         level)))
 399     (setq actual-foreground (face-attribute face :foreground))
 400     (when (funcall (if negate 'identity 'not)
 401                    (string-equal foreground actual-foreground))
 402       (ert-fail (format (concat "Expected face for level `%s' "
 403                                 "%sto have foreground `%s'; "
 404                                 "but it %s.")
 405                         level
 406                         (if negate "not " "") foreground
 407                         (if negate
 408                             "did" (format "was `%s'" actual-foreground)))))))
 409
 410 (defun context-coloring-test-assert-not-face (&rest arguments)
 411   "Assert that LEVEL does not have a face with `:foreground'
 412 FOREGROUND.  Apply ARGUMENTS to
 413 `context-coloring-test-assert-face', see that function."
 414   (apply 'context-coloring-test-assert-face
 415          (append arguments '(t))))
 416
 417 (defun context-coloring-test-assert-error (body error-message)
 418   "Assert that BODY signals ERROR-MESSAGE."
 419   (let ((error-signaled-p nil))
 420     (condition-case err
 421         (progn
 422           (funcall body))
 423       (error
 424        (setq error-signaled-p t)
 425        (when (not (string-equal (cadr err) error-message))
 426          (ert-fail (format (concat "Expected the error \"%s\" to be thrown, "
 427                                    "but instead it was \"%s\".")
 428                            error-message
 429                            (cadr err))))))
 430     (when (not error-signaled-p)
 431       (ert-fail "Expected an error to be thrown, but there wasn't."))))
 432
 433 (defun context-coloring-test-assert-trimmed (result expected)
 434   (when (not (string-equal result expected))
 435     (ert-fail "Expected string to be trimmed, but it wasn't.")))
 436
 437
 438 ;;; The tests
 439
 440 (ert-deftest context-coloring-test-trim ()
 441   (context-coloring-test-assert-trimmed (context-coloring-trim "") "")
 442   (context-coloring-test-assert-trimmed (context-coloring-trim " ") "")
 443   (context-coloring-test-assert-trimmed (context-coloring-trim "a") "a")
 444   (context-coloring-test-assert-trimmed (context-coloring-trim " a") "a")
 445   (context-coloring-test-assert-trimmed (context-coloring-trim "a ") "a")
 446   (context-coloring-test-assert-trimmed (context-coloring-trim " a ") "a"))
 447
 448 (ert-deftest-async context-coloring-test-async-mode-startup (done)
 449   (context-coloring-test-with-fixture-async
 450    "./fixtures/empty"
 451    (lambda (teardown)
 452      (js-mode)
 453      (add-hook
 454       'context-coloring-colorize-hook
 455       (lambda ()
 456         ;; If this runs we are implicitly successful; this test only confirms
 457         ;; that colorization occurs on mode startup.
 458         (funcall teardown)
 459         (funcall done)))
 460      (context-coloring-mode))))
 461
 462 (define-derived-mode
 463   context-coloring-change-detection-mode
 464   fundamental-mode
 465   "Testing"
 466   "Prevent `context-coloring-test-change-detection' from
 467   having any unintentional side-effects on mode support.")
 468
 469 ;; Simply cannot figure out how to trigger an idle timer; would much rather test
 470 ;; that.  But (current-idle-time) always returns nil in these tests.
 471 (ert-deftest-async context-coloring-test-change-detection (done)
 472   (context-coloring-define-dispatch
 473      'idle-change
 474      :modes '(context-coloring-change-detection-mode)
 475      :executable "node"
 476      :command "node test/binaries/noop")
 477   (context-coloring-test-with-fixture-async
 478    "./fixtures/empty"
 479    (lambda (teardown)
 480      (context-coloring-change-detection-mode)
 481      (add-hook
 482       'context-coloring-colorize-hook
 483       (lambda ()
 484         (setq context-coloring-colorize-hook nil)
 485         (add-hook
 486          'context-coloring-colorize-hook
 487          (lambda ()
 488            (funcall teardown)
 489            (funcall done)))
 490         (insert " ")
 491         (set-window-buffer (selected-window) (current-buffer))
 492         (context-coloring-maybe-colorize (current-buffer))))
 493      (context-coloring-mode))))
 494
 495 (ert-deftest context-coloring-test-check-version ()
 496   (when (not (context-coloring-check-version "2.1.3" "3.0.1"))
 497     (ert-fail "Expected version 3.0.1 to satisfy 2.1.3, but it didn't."))
 498   (when (context-coloring-check-version "3.0.1" "2.1.3")
 499     (ert-fail "Expected version 2.1.3 not to satisfy 3.0.1, but it did.")))
 500
 501 (ert-deftest context-coloring-test-unsupported-mode ()
 502   (context-coloring-test-with-fixture
 503    "./fixtures/empty"
 504    (context-coloring-mode)
 505    (context-coloring-test-assert-message
 506     "Context coloring is not available for this major mode"
 507     "*Messages*")))
 508
 509 (define-derived-mode
 510   context-coloring-test-define-dispatch-error-mode
 511   fundamental-mode
 512   "Testing"
 513   "Prevent `context-coloring-test-define-dispatch-error' from
 514   having any unintentional side-effects on mode support.")
 515
 516 (ert-deftest context-coloring-test-define-dispatch-error ()
 517   (context-coloring-test-assert-error
 518    (lambda ()
 519      (context-coloring-define-dispatch
 520       'define-dispatch-no-modes))
 521    "No mode defined for dispatch")
 522   (context-coloring-test-assert-error
 523    (lambda ()
 524      (context-coloring-define-dispatch
 525       'define-dispatch-no-strategy
 526       :modes '(context-coloring-test-define-dispatch-error-mode)))
 527    "No colorizer, scopifier or command defined for dispatch"))
 528
 529 (define-derived-mode
 530   context-coloring-test-define-dispatch-scopifier-mode
 531   fundamental-mode
 532   "Testing"
 533   "Prevent `context-coloring-test-define-dispatch-scopifier' from
 534   having any unintentional side-effects on mode support.")
 535
 536 (ert-deftest context-coloring-test-define-dispatch-scopifier ()
 537   (context-coloring-define-dispatch
 538    'define-dispatch-scopifier
 539    :modes '(context-coloring-test-define-dispatch-scopifier-mode)
 540    :scopifier (lambda () (vector)))
 541   (with-temp-buffer
 542     (context-coloring-test-define-dispatch-scopifier-mode)
 543     (context-coloring-mode)
 544     (context-coloring-colorize)))
 545
 546 (define-derived-mode
 547   context-coloring-test-missing-executable-mode
 548   fundamental-mode
 549   "Testing"
 550   "Prevent `context-coloring-test-define-dispatch-scopifier' from
 551   having any unintentional side-effects on mode support.")
 552
 553 (ert-deftest context-coloring-test-missing-executable ()
 554   (context-coloring-define-dispatch
 555    'scopifier
 556    :modes '(context-coloring-test-missing-executable-mode)
 557    :command ""
 558    :executable "__should_not_exist__")
 559   (with-temp-buffer
 560     (context-coloring-test-missing-executable-mode)
 561     (context-coloring-mode)))
 562
 563 (define-derived-mode
 564   context-coloring-test-unsupported-version-mode
 565   fundamental-mode
 566   "Testing"
 567   "Prevent `context-coloring-test-unsupported-version' from
 568   having any unintentional side-effects on mode support.")
 569
 570 (ert-deftest-async context-coloring-test-unsupported-version (done)
 571   (context-coloring-define-dispatch
 572    'outta-date
 573    :modes '(context-coloring-test-unsupported-version-mode)
 574    :executable "node"
 575    :command "node test/binaries/outta-date"
 576    :version "v2.1.3")
 577   (context-coloring-test-with-fixture-async
 578    "./fixtures/empty"
 579    (lambda (teardown)
 580      (context-coloring-test-unsupported-version-mode)
 581      (add-hook
 582       'context-coloring-check-scopifier-version-hook
 583       (lambda ()
 584         (unwind-protect
 585             (progn
 586               ;; Normally the executable would be something like "outta-date"
 587               ;; rather than "node".
 588               (context-coloring-test-assert-message
 589                "Update to the minimum version of \"node\" (v2.1.3)"
 590                "*Messages*"))
 591           (funcall teardown))
 592         (funcall done)))
 593      (context-coloring-mode))))
 594
 595 (define-derived-mode
 596   context-coloring-test-disable-mode-mode
 597   fundamental-mode
 598   "Testing"
 599   "Prevent `context-coloring-test-disable-mode' from having any
 600   unintentional side-effects on mode support.")
 601
 602 (ert-deftest-async context-coloring-test-disable-mode (done)
 603   (let (torn-down)
 604     (context-coloring-define-dispatch
 605      'disable-mode
 606      :modes '(context-coloring-test-disable-mode-mode)
 607      :executable "node"
 608      :command "node test/binaries/noop"
 609      :teardown (lambda ()
 610                  (setq torn-down t)))
 611     (context-coloring-test-with-fixture-async
 612      "./fixtures/empty"
 613      (lambda (teardown)
 614        (unwind-protect
 615            (progn
 616              (context-coloring-test-disable-mode-mode)
 617              (context-coloring-mode)
 618              (context-coloring-mode -1)
 619              (when (not torn-down)
 620                (ert-fail "Expected teardown function to have been called, but it wasn't.")))
 621          (funcall teardown))
 622        (funcall done)))))
 623
 624 (defvar context-coloring-test-theme-index 0
 625   "Unique index for unique theme names.")
 626
 627 (defun context-coloring-test-get-next-theme ()
 628   "Return a unique symbol for a throwaway theme."
 629   (prog1
 630       (intern (format "context-coloring-test-theme-%s"
 631                       context-coloring-test-theme-index))
 632     (setq context-coloring-test-theme-index
 633           (+ context-coloring-test-theme-index 1))))
 634
 635 (defun context-coloring-test-assert-theme-originally-set-p
 636     (settings &optional negate)
 637   "Assert that `context-coloring-theme-originally-set-p' returns
 638 t for a theme with SETTINGS, or the inverse if NEGATE is
 639 non-nil."
 640   (let ((theme (context-coloring-test-get-next-theme)))
 641     (put theme 'theme-settings settings)
 642     (when (funcall (if negate 'identity 'not)
 643                    (context-coloring-theme-originally-set-p theme))
 644       (ert-fail (format (concat "Expected theme `%s' with settings `%s' "
 645                                 "%sto be considered to have defined a level, "
 646                                 "but it %s.")
 647                         theme settings
 648                         (if negate "not " "")
 649                         (if negate "was" "wasn't"))))))
 650
 651 (defun context-coloring-test-assert-not-theme-originally-set-p (&rest arguments)
 652   "Assert that `context-coloring-theme-originally-set-p' does not
 653 return t for a theme with SETTINGS.  Apply ARGUMENTS to
 654 `context-coloring-test-assert-theme-originally-set-p', see that
 655 function."
 656   (apply 'context-coloring-test-assert-theme-originally-set-p
 657          (append arguments '(t))))
 658
 659 (ert-deftest context-coloring-test-theme-originally-set-p ()
 660   (context-coloring-test-assert-theme-originally-set-p
 661    '((theme-face context-coloring-level-0-face)))
 662   (context-coloring-test-assert-theme-originally-set-p
 663    '((theme-face face)
 664      (theme-face context-coloring-level-0-face)))
 665   (context-coloring-test-assert-theme-originally-set-p
 666    '((theme-face context-coloring-level-0-face)
 667      (theme-face face)))
 668   (context-coloring-test-assert-not-theme-originally-set-p
 669    '((theme-face face)))
 670   )
 671
 672 (defun context-coloring-test-assert-theme-settings-highest-level
 673     (settings expected-level)
 674   "Assert that a theme with SETTINGS has the highest level
 675 EXPECTED-LEVEL."
 676   (let ((theme (context-coloring-test-get-next-theme)))
 677     (put theme 'theme-settings settings)
 678     (context-coloring-test-assert-theme-highest-level theme expected-level)))
 679
 680 (defun context-coloring-test-assert-theme-highest-level
 681     (theme expected-level &optional negate)
 682   "Assert that THEME has the highest level EXPECTED-LEVEL, or the
 683 inverse if NEGATE is non-nil."
 684   (let ((highest-level (context-coloring-theme-highest-level theme)))
 685     (when (funcall (if negate 'identity 'not) (eq highest-level expected-level))
 686       (ert-fail (format (concat "Expected theme with settings `%s' "
 687                                 "%sto have a highest level of `%s', "
 688                                 "but it %s.")
 689                         (get theme 'theme-settings)
 690                         (if negate "not " "") expected-level
 691                         (if negate "did" (format "was %s" highest-level)))))))
 692
 693 (defun context-coloring-test-assert-theme-not-highest-level (&rest arguments)
 694   "Assert that THEME's highest level is not EXPECTED-LEVEL.
 695 Apply ARGUMENTS to
 696 `context-coloring-test-assert-theme-highest-level', see that
 697 function."
 698   (apply 'context-coloring-test-assert-theme-highest-level
 699          (append arguments '(t))))
 700
 701 (ert-deftest context-coloring-test-theme-highest-level ()
 702   (context-coloring-test-assert-theme-settings-highest-level
 703    '((theme-face foo))
 704    -1)
 705   (context-coloring-test-assert-theme-settings-highest-level
 706    '((theme-face context-coloring-level-0-face))
 707    0)
 708   (context-coloring-test-assert-theme-settings-highest-level
 709    '((theme-face context-coloring-level-1-face))
 710    1)
 711   (context-coloring-test-assert-theme-settings-highest-level
 712    '((theme-face context-coloring-level-1-face)
 713      (theme-face context-coloring-level-0-face))
 714    1)
 715   (context-coloring-test-assert-theme-settings-highest-level
 716    '((theme-face context-coloring-level-0-face)
 717      (theme-face context-coloring-level-1-face))
 718    1)
 719   )
 720
 721 (defmacro context-coloring-test-deftest-define-theme (name &rest body)
 722   "Define a test with name NAME and an automatically-generated
 723 theme symbol available as a free variable `theme'.  Side-effects
 724 from enabling themes are reversed after BODY is executed and the
 725 test completes."
 726   (declare (indent defun))
 727   (let ((deftest-name (intern
 728                        (format "context-coloring-test-define-theme-%s" name))))
 729     `(ert-deftest ,deftest-name ()
 730        (context-coloring-test-kill-buffer "*Warnings*")
 731        (context-coloring-test-setup)
 732        (let ((theme (context-coloring-test-get-next-theme)))
 733          (unwind-protect
 734              (progn
 735                ,@body)
 736            ;; Always cleanup.
 737            (disable-theme theme)
 738            (context-coloring-test-cleanup))))))
 739
 740 (defun context-coloring-test-deftheme (theme)
 741   "Dynamically define theme THEME."
 742   (eval (macroexpand `(deftheme ,theme))))
 743
 744 (context-coloring-test-deftest-define-theme additive
 745   (context-coloring-test-deftheme theme)
 746   (context-coloring-define-theme
 747    theme
 748    :colors '("#aaaaaa"
 749              "#bbbbbb"))
 750   (context-coloring-test-assert-no-message "*Warnings*")
 751   (enable-theme theme)
 752   (context-coloring-test-assert-no-message "*Warnings*")
 753   (context-coloring-test-assert-face 0 "#aaaaaa")
 754   (context-coloring-test-assert-face 1 "#bbbbbb"))
 755
 756 (defun context-coloring-test-assert-defined-warning (theme)
 757   "Assert that a warning about colors already being defined for
 758 theme THEME is signaled."
 759   (context-coloring-test-assert-message
 760    (format (concat "Warning (emacs): Context coloring colors for theme "
 761                    "`%s' are already defined")
 762            theme)
 763    "*Warnings*"))
 764
 765 (context-coloring-test-deftest-define-theme unintentional-override
 766   (context-coloring-test-deftheme theme)
 767   (custom-theme-set-faces
 768    theme
 769    '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
 770    '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
 771   (context-coloring-define-theme
 772    theme
 773    :colors '("#cccccc"
 774              "#dddddd"))
 775   (context-coloring-test-assert-defined-warning theme)
 776   (context-coloring-test-kill-buffer "*Warnings*")
 777   (enable-theme theme)
 778   (context-coloring-test-assert-defined-warning theme)
 779   (context-coloring-test-assert-face 0 "#cccccc")
 780   (context-coloring-test-assert-face 1 "#dddddd"))
 781
 782 (context-coloring-test-deftest-define-theme intentional-override
 783   (context-coloring-test-deftheme theme)
 784   (custom-theme-set-faces
 785    theme
 786    '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
 787    '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
 788   (context-coloring-define-theme
 789    theme
 790    :override t
 791    :colors '("#cccccc"
 792              "#dddddd"))
 793   (context-coloring-test-assert-no-message "*Warnings*")
 794   (enable-theme theme)
 795   (context-coloring-test-assert-no-message "*Warnings*")
 796   (context-coloring-test-assert-face 0 "#cccccc")
 797   (context-coloring-test-assert-face 1 "#dddddd"))
 798
 799 (context-coloring-test-deftest-define-theme pre-recede
 800   (context-coloring-define-theme
 801    theme
 802    :recede t
 803    :colors '("#aaaaaa"
 804              "#bbbbbb"))
 805   (context-coloring-test-deftheme theme)
 806   (custom-theme-set-faces
 807    theme
 808    '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
 809    '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
 810   (enable-theme theme)
 811   (context-coloring-test-assert-no-message "*Warnings*")
 812   (context-coloring-test-assert-face 0 "#cccccc")
 813   (context-coloring-test-assert-face 1 "#dddddd"))
 814
 815 (context-coloring-test-deftest-define-theme pre-recede-delayed-application
 816   (context-coloring-define-theme
 817    theme
 818    :recede t
 819    :colors '("#aaaaaa"
 820              "#bbbbbb"))
 821   (context-coloring-test-deftheme theme)
 822   (enable-theme theme)
 823   (context-coloring-test-assert-no-message "*Warnings*")
 824   (context-coloring-test-assert-face 0 "#aaaaaa")
 825   (context-coloring-test-assert-face 1 "#bbbbbb"))
 826
 827 (context-coloring-test-deftest-define-theme post-recede
 828   (context-coloring-test-deftheme theme)
 829   (custom-theme-set-faces
 830    theme
 831    '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
 832    '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
 833   (context-coloring-define-theme
 834    theme
 835    :recede t
 836    :colors '("#cccccc"
 837              "#dddddd"))
 838   (context-coloring-test-assert-no-message "*Warnings*")
 839   (context-coloring-test-assert-face 0 "#aaaaaa")
 840   (context-coloring-test-assert-face 1 "#bbbbbb")
 841   (enable-theme theme)
 842   (context-coloring-test-assert-no-message "*Warnings*")
 843   (context-coloring-test-assert-face 0 "#aaaaaa")
 844   (context-coloring-test-assert-face 1 "#bbbbbb"))
 845
 846 (context-coloring-test-deftest-define-theme recede-not-defined
 847   (context-coloring-test-deftheme theme)
 848   (custom-theme-set-faces
 849    theme
 850    '(foo-face ((t (:foreground "#ffffff")))))
 851   (context-coloring-define-theme
 852    theme
 853    :recede t
 854    :colors '("#aaaaaa"
 855              "#bbbbbb"))
 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 unintentional-obstinance
 865   (context-coloring-define-theme
 866    theme
 867    :colors '("#aaaaaa"
 868              "#bbbbbb"))
 869   (context-coloring-test-deftheme theme)
 870   (custom-theme-set-faces
 871    theme
 872    '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
 873    '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
 874   (enable-theme theme)
 875   (context-coloring-test-assert-defined-warning theme)
 876   (context-coloring-test-assert-face 0 "#aaaaaa")
 877   (context-coloring-test-assert-face 1 "#bbbbbb"))
 878
 879 (context-coloring-test-deftest-define-theme intentional-obstinance
 880   (context-coloring-define-theme
 881    theme
 882    :override t
 883    :colors '("#aaaaaa"
 884              "#bbbbbb"))
 885   (context-coloring-test-deftheme theme)
 886   (custom-theme-set-faces
 887    theme
 888    '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
 889    '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
 890   (enable-theme theme)
 891   (context-coloring-test-assert-no-message "*Warnings*")
 892   (context-coloring-test-assert-face 0 "#aaaaaa")
 893   (context-coloring-test-assert-face 1 "#bbbbbb"))
 894
 895 (defun context-coloring-test-assert-maximum-face (maximum &optional negate)
 896   "Assert that `context-coloring-maximum-face' is MAXIMUM, or the
 897 inverse if NEGATE is non-nil."
 898   (when (funcall (if negate 'identity 'not)
 899                  (eq context-coloring-maximum-face maximum))
 900     (ert-fail (format (concat "Expected `context-coloring-maximum-face' "
 901                               "%sto be `%s', "
 902                               "but it %s.")
 903                       (if negate "not " "") maximum
 904                       (if negate
 905                           "was"
 906                         (format "was `%s'" context-coloring-maximum-face))))))
 907
 908 (defun context-coloring-test-assert-not-maximum-face (&rest arguments)
 909   "Assert that `context-coloring-maximum-face' is not MAXIMUM.
 910 Apply ARGUMENTS to `context-coloring-test-assert-maximum-face',
 911 see that function."
 912   (apply 'context-coloring-test-assert-maximum-face
 913          (append arguments '(t))))
 914
 915 (context-coloring-test-deftest-define-theme disable-cascade
 916   (let ((maximum-face-value 9999))
 917     (setq context-coloring-maximum-face maximum-face-value)
 918     (context-coloring-test-deftheme theme)
 919     (context-coloring-define-theme
 920      theme
 921      :colors '("#aaaaaa"
 922                "#bbbbbb"))
 923     (let ((second-theme (context-coloring-test-get-next-theme)))
 924       (context-coloring-test-deftheme second-theme)
 925       (context-coloring-define-theme
 926        second-theme
 927        :colors '("#cccccc"
 928                  "#dddddd"
 929                  "#eeeeee"))
 930       (let ((third-theme (context-coloring-test-get-next-theme)))
 931         (context-coloring-test-deftheme third-theme)
 932         (context-coloring-define-theme
 933          third-theme
 934          :colors '("#111111"
 935                    "#222222"
 936                    "#333333"
 937                    "#444444"))
 938         (enable-theme theme)
 939         (enable-theme second-theme)
 940         (enable-theme third-theme)
 941         (disable-theme third-theme)
 942         (context-coloring-test-assert-face 0 "#cccccc")
 943         (context-coloring-test-assert-face 1 "#dddddd")
 944         (context-coloring-test-assert-face 2 "#eeeeee")
 945         (context-coloring-test-assert-maximum-face 2))
 946       (disable-theme second-theme)
 947       (context-coloring-test-assert-face 0 "#aaaaaa")
 948       (context-coloring-test-assert-face 1 "#bbbbbb")
 949       (context-coloring-test-assert-maximum-face 1))
 950     (disable-theme theme)
 951     (context-coloring-test-assert-not-face 0 "#aaaaaa")
 952     (context-coloring-test-assert-not-face 1 "#bbbbbb")
 953     (context-coloring-test-assert-maximum-face
 954      maximum-face-value)))
 955
 956 (defun context-coloring-test-js-function-scopes ()
 957   "Test fixtures/functions-scopes.js."
 958   (context-coloring-test-assert-region-level 1 9 0)
 959   (context-coloring-test-assert-region-level 9 23 1)
 960   (context-coloring-test-assert-region-level 23 25 0)
 961   (context-coloring-test-assert-region-level 25 34 1)
 962   (context-coloring-test-assert-region-level 34 35 0)
 963   (context-coloring-test-assert-region-level 35 52 1)
 964   (context-coloring-test-assert-region-level 52 66 2)
 965   (context-coloring-test-assert-region-level 66 72 1)
 966   (context-coloring-test-assert-region-level 72 81 2)
 967   (context-coloring-test-assert-region-level 81 82 1)
 968   (context-coloring-test-assert-region-level 82 87 2)
 969   (context-coloring-test-assert-region-level 87 89 1))
 970
 971 (context-coloring-test-deftest-js-mode function-scopes)
 972 (context-coloring-test-deftest-js2-mode function-scopes)
 973
 974 (defun context-coloring-test-js-global ()
 975   "Test fixtures/global.js."
 976   (context-coloring-test-assert-region-level 20 28 1)
 977   (context-coloring-test-assert-region-level 28 35 0)
 978   (context-coloring-test-assert-region-level 35 41 1))
 979
 980 (context-coloring-test-deftest-js-mode global)
 981 (context-coloring-test-deftest-js2-mode global)
 982
 983 (defun context-coloring-test-js-block-scopes ()
 984   "Test fixtures/block-scopes.js."
 985   (context-coloring-test-assert-region-level 20 64 1)
 986    (setq context-coloring-js-block-scopes t)
 987    (context-coloring-colorize)
 988    (context-coloring-test-assert-region-level 20 27 1)
 989    (context-coloring-test-assert-region-level 27 41 2)
 990    (context-coloring-test-assert-region-level 41 42 1)
 991    (context-coloring-test-assert-region-level 42 64 2))
 992
 993 (context-coloring-test-deftest-js2-mode block-scopes)
 994
 995 (defun context-coloring-test-js-catch ()
 996   "Test fixtures/js-catch.js."
 997   (context-coloring-test-assert-region-level 20 27 1)
 998   (context-coloring-test-assert-region-level 27 51 2)
 999   (context-coloring-test-assert-region-level 51 52 1)
1000   (context-coloring-test-assert-region-level 52 73 2)
1001   (context-coloring-test-assert-region-level 73 101 3)
1002   (context-coloring-test-assert-region-level 101 102 1)
1003   (context-coloring-test-assert-region-level 102 117 3)
1004   (context-coloring-test-assert-region-level 117 123 2))
1005
1006 (context-coloring-test-deftest-js-mode catch)
1007 (context-coloring-test-deftest-js2-mode catch)
1008
1009 (defun context-coloring-test-js-key-names ()
1010   "Test fixtures/key-names.js."
1011   (context-coloring-test-assert-region-level 20 63 1))
1012
1013 (context-coloring-test-deftest-js-mode key-names)
1014 (context-coloring-test-deftest-js2-mode key-names)
1015
1016 (defun context-coloring-test-js-property-lookup ()
1017   "Test fixtures/property-lookup.js."
1018   (context-coloring-test-assert-region-level 20 26 0)
1019   (context-coloring-test-assert-region-level 26 38 1)
1020   (context-coloring-test-assert-region-level 38 44 0)
1021   (context-coloring-test-assert-region-level 44 52 1)
1022   (context-coloring-test-assert-region-level 57 63 0)
1023   (context-coloring-test-assert-region-level 63 74 1))
1024
1025 (context-coloring-test-deftest-js-mode property-lookup)
1026 (context-coloring-test-deftest-js2-mode property-lookup)
1027
1028 (defun context-coloring-test-js-key-values ()
1029   "Test fixtures/key-values.js."
1030   (context-coloring-test-assert-region-level 78 79 1))
1031
1032 (context-coloring-test-deftest-js-mode key-values)
1033 (context-coloring-test-deftest-js2-mode key-values)
1034
1035 (defun context-coloring-test-js-syntactic-comments-and-strings ()
1036   "Test comments and strings."
1037   (context-coloring-test-assert-region-level 1 8 0)
1038   (context-coloring-test-assert-region-comment-delimiter 9 12)
1039   (context-coloring-test-assert-region-comment 12 16)
1040   (context-coloring-test-assert-region-comment-delimiter 17 20)
1041   (context-coloring-test-assert-region-comment 20 27)
1042   (context-coloring-test-assert-region-string 28 40)
1043   (context-coloring-test-assert-region-level 40 41 0))
1044
1045 (defun context-coloring-test-js-syntactic-comments-and-strings-setup ()
1046   (setq context-coloring-syntactic-comments t)
1047   (setq context-coloring-syntactic-strings t))
1048
1049 (context-coloring-test-deftest-js-mode syntactic-comments-and-strings
1050   :fixture-name comments-and-strings)
1051 (context-coloring-test-deftest-js2-mode syntactic-comments-and-strings
1052   :fixture-name comments-and-strings)
1053
1054 (defalias 'context-coloring-test-js-comments-and-strings
1055   'context-coloring-test-js-syntactic-comments-and-strings
1056   "Test comments and strings.  Deprecated.")
1057
1058 (defun context-coloring-test-js-comments-and-strings-setup ()
1059   "Setup comments and strings.  Deprecated."
1060   (setq context-coloring-comments-and-strings t))
1061
1062 (context-coloring-test-deftest-js-mode comments-and-strings)
1063 (context-coloring-test-deftest-js2-mode comments-and-strings)
1064
1065 (defun context-coloring-test-js-syntactic-comments ()
1066   "Test syntactic comments."
1067   (context-coloring-test-assert-region-level 1 8 0)
1068   (context-coloring-test-assert-region-comment-delimiter 9 12)
1069   (context-coloring-test-assert-region-comment 12 16)
1070   (context-coloring-test-assert-region-comment-delimiter 17 20)
1071   (context-coloring-test-assert-region-comment 20 27)
1072   (context-coloring-test-assert-region-level 28 41 0))
1073
1074 (defun context-coloring-test-js-syntactic-comments-setup ()
1075   "Setup syntactic comments."
1076   (setq context-coloring-syntactic-comments t))
1077
1078 (context-coloring-test-deftest-js-mode syntactic-comments
1079   :fixture-name comments-and-strings)
1080 (context-coloring-test-deftest-js2-mode syntactic-comments
1081   :fixture-name comments-and-strings)
1082
1083 (defun context-coloring-test-js-syntactic-strings ()
1084   "Test syntactic strings."
1085   (context-coloring-test-assert-region-level 1 28 0)
1086   (context-coloring-test-assert-region-string 28 40)
1087   (context-coloring-test-assert-region-level 40 41 0))
1088
1089 (defun context-coloring-test-js-syntactic-strings-setup ()
1090   "Setup syntactic strings."
1091   (setq context-coloring-syntactic-strings t))
1092
1093 (context-coloring-test-deftest-js-mode syntactic-strings
1094   :fixture-name comments-and-strings)
1095 (context-coloring-test-deftest-js2-mode syntactic-strings
1096   :fixture-name comments-and-strings)
1097
1098 ;; As long as `add-text-properties' doesn't signal an error, this test passes.
1099 (defun context-coloring-test-js-unterminated-comment ()
1100   "Test unterminated multiline comments.")
1101
1102 (context-coloring-test-deftest-js2-mode unterminated-comment)
1103
1104 (context-coloring-test-deftest-emacs-lisp-mode defun
1105   (lambda ()
1106     (context-coloring-test-assert-coloring "
1107 111111 000 1111 111 111111111 1111
1108   11 111 111 111 000011
1109
1110 0000 0 0 00
1111
1112 111111 01
1113 111111 111")))
1114
1115 (context-coloring-test-deftest-emacs-lisp-mode lambda
1116   (lambda ()
1117     (context-coloring-test-assert-coloring "
1118 00000000 1111111 1111
1119            11111111 11 2222222 2222
1120                          222 22 12 2221 111 0 00")))
1121
1122 (context-coloring-test-deftest-emacs-lisp-mode quote
1123   (lambda ()
1124     (context-coloring-test-assert-coloring "
1125 (xxxxx x (x)
1126   (xx (xx x 111
1127       111111 1 111 111
1128       111111 1 1111111111 11 111 1 111 1 00001 10000 11 00001 1 100001111")))
1129
1130 (context-coloring-test-deftest-emacs-lisp-mode comment
1131   (lambda ()
1132     ;; Just check that the comment isn't parsed syntactically.
1133     (context-coloring-test-assert-coloring "
1134 (xxxxx x ()
1135   (xx (x xxxxx-xxxx xx)   ;;;;;;;;;;
1136       11 00000-0000 11))) ;;;;;;;;;;"))
1137   :setup (lambda ()
1138            (setq context-coloring-syntactic-comments t)))
1139
1140 (context-coloring-test-deftest-emacs-lisp-mode string
1141   (lambda ()
1142     (context-coloring-test-assert-coloring "
1143 (xxxxx x (x)
1144   (xxxxxx x x sss 1 0 sssss 0 1 sssssss11"))
1145   :setup (lambda ()
1146            (setq context-coloring-syntactic-strings t)))
1147
1148 (context-coloring-test-deftest-emacs-lisp-mode ignored
1149   (lambda ()
1150     (context-coloring-test-assert-coloring "
1151 (xxxxx x ()
1152   (x x 1 11 11 111 11 1 111 (1 1 1)))")))
1153
1154 (context-coloring-test-deftest-emacs-lisp-mode let
1155   (lambda ()
1156     (context-coloring-test-assert-coloring "
1157 1111 11
1158       11 01
1159       11 00001
1160       11 2222 22
1161                22 02
1162                22 000022
1163            2222 2 2 2 00002211
1164   1111 1 1 1 000011")))
1165
1166 (context-coloring-test-deftest-emacs-lisp-mode let*
1167   (lambda ()
1168     (context-coloring-test-assert-coloring "
1169 11111 11
1170        11 11
1171        11 000011
1172   1111 1 1 1 0 0 00001
1173   22222 22
1174          22 12
1175          22 00002
1176          22 02
1177          22 222
1178     2222 1 1 2 2 2 000022
1179   1111 1 1 1 0 0 000011")))
1180
1181 (defun context-coloring-test-insert-unread-space ()
1182   (setq unread-command-events (cons '(t . 32)
1183                                     unread-command-events)))
1184
1185 (defun context-coloring-test-remove-faces ()
1186   (remove-text-properties (point-min) (point-max) '(face nil)))
1187
1188 (context-coloring-test-deftest-emacs-lisp-mode iteration
1189   (lambda ()
1190     (let ((context-coloring-emacs-lisp-iterations-per-pause 1))
1191       (context-coloring-colorize)
1192       (context-coloring-test-assert-coloring "
1193 ;; `cc' `cc'
1194 (xxxxx x ())")
1195       (context-coloring-test-remove-faces)
1196       (context-coloring-test-insert-unread-space)
1197       (context-coloring-colorize)
1198       ;; The first iteration will color the first part of the comment, but
1199       ;; that's it.  Then it will be interrupted.
1200       (context-coloring-test-assert-coloring "
1201 ;; nnnn nnnn
1202 nnnnnn n nnn")))
1203   :setup (lambda ()
1204            (setq context-coloring-syntactic-comments t)
1205            (setq context-coloring-syntactic-strings t)))
1206
1207 (provide 'context-coloring-test)
1208
1209 ;;; context-coloring-test.el ends here