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

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