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

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