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

   1 ;;; test/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 ;; Tests for both synchronous (elisp) and asynchronous (shell command) coloring
  25 ;; are available.  Basic plugin functionality is also tested.
  26
  27 ;; To run, execute `make test' from the project root.
  28
  29 ;;; Code:
  30
  31 (require 'context-coloring)
  32 (require 'ert-async)
  33 (require 'js2-mode)
  34
  35
  36 ;;; Test running utilities
  37
  38 (defconst context-coloring-test-path
  39   (file-name-directory (or load-file-name buffer-file-name))
  40   "This file's directory.")
  41
  42 (defun context-coloring-test-read-file (path)
  43   "Read a file's contents from PATH into a string."
  44   (with-temp-buffer
  45     (insert-file-contents (expand-file-name path context-coloring-test-path))
  46     (buffer-string)))
  47
  48 (defun context-coloring-test-setup ()
  49   "Prepare before all tests."
  50   (setq context-coloring-comments-and-strings nil))
  51
  52 (defun context-coloring-test-cleanup ()
  53   "Cleanup after all tests."
  54   (setq context-coloring-comments-and-strings t)
  55   (setq context-coloring-syntactic-comments nil)
  56   (setq context-coloring-syntactic-strings nil)
  57   (setq context-coloring-js-block-scopes nil)
  58   (setq context-coloring-check-scopifier-version-hook nil))
  59
  60 (defmacro context-coloring-test-with-fixture (fixture &rest body)
  61   "With the relative FIXTURE, evaluate BODY in a temporary
  62 buffer."
  63   `(with-temp-buffer
  64      (unwind-protect
  65          (progn
  66            (context-coloring-test-setup)
  67            (insert (context-coloring-test-read-file ,fixture))
  68            ,@body)
  69        (context-coloring-test-cleanup))))
  70
  71 (defun context-coloring-test-with-temp-buffer-async (callback)
  72   "Create a temporary buffer, and evaluate CALLBACK there.  A
  73 teardown callback is passed to CALLBACK for it to invoke when it
  74 is done."
  75   (let ((previous-buffer (current-buffer))
  76         (temp-buffer (generate-new-buffer " *temp*")))
  77     (set-buffer temp-buffer)
  78     (funcall
  79      callback
  80      (lambda ()
  81        (and (buffer-name temp-buffer)
  82             (kill-buffer temp-buffer))
  83        (set-buffer previous-buffer)))))
  84
  85 (defun context-coloring-test-with-fixture-async
  86     (fixture callback &optional setup)
  87   "With the relative FIXTURE, evaluate CALLBACK in a temporary
  88 buffer.  A teardown callback is passed to CALLBACK for it to
  89 invoke when it is done.  An optional SETUP callback can run
  90 arbitrary code before the mode is invoked."
  91   (context-coloring-test-with-temp-buffer-async
  92    (lambda (done-with-temp-buffer)
  93      (context-coloring-test-setup)
  94      (when setup (funcall setup))
  95      (insert (context-coloring-test-read-file fixture))
  96      (funcall
  97       callback
  98       (lambda ()
  99         (context-coloring-test-cleanup)
 100         (funcall done-with-temp-buffer))))))
 101
 102
 103 ;;; Test defining utilities
 104
 105 (defun context-coloring-test-js-mode (fixture callback &optional setup)
 106   "Use FIXTURE as the subject matter for test logic in CALLBACK.
 107 Optionally, provide setup code to run before the mode is
 108 instantiated in SETUP."
 109   (context-coloring-test-with-fixture-async
 110    fixture
 111    (lambda (done-with-test)
 112      (js-mode)
 113      (context-coloring-mode)
 114      (context-coloring-colorize
 115       (lambda ()
 116         (funcall callback done-with-test))))
 117    setup))
 118
 119 (defmacro context-coloring-test-js2-mode (fixture setup &rest body)
 120   "Use FIXTURE as the subject matter for test logic in BODY."
 121   `(context-coloring-test-with-fixture
 122     ,fixture
 123     (require 'js2-mode)
 124     (setq js2-mode-show-parse-errors nil)
 125     (setq js2-mode-show-strict-warnings nil)
 126     (js2-mode)
 127     (when ,setup (funcall ,setup))
 128     (context-coloring-mode)
 129     ,@body))
 130
 131 (cl-defmacro context-coloring-test-deftest-js-mode (name &key fixture-name)
 132   "Define an asynchronous test for `js-mode' with the name NAME
 133 in the typical format."
 134   (declare (indent defun))
 135   (let ((test-name (intern (format "context-coloring-test-js-mode-%s" name)))
 136         (fixture (format "./fixtures/%s.js" (or fixture-name name)))
 137         (function-name (intern-soft
 138                         (format "context-coloring-test-js-%s" name)))
 139         (setup-function-name (intern-soft
 140                               (format
 141                                "context-coloring-test-js-%s-setup" name))))
 142     `(ert-deftest-async ,test-name (done)
 143                         (context-coloring-test-js-mode
 144                          ,fixture
 145                          (lambda (teardown)
 146                            (unwind-protect
 147                                (,function-name)
 148                              (funcall teardown))
 149                            (funcall done))
 150                          ',setup-function-name))))
 151
 152 (cl-defmacro context-coloring-test-deftest-js2-mode (name &key fixture-name)
 153   "Define a test for `js2-mode' with the name NAME in the typical
 154 format."
 155   (declare (indent defun))
 156   (let ((test-name (intern (format "context-coloring-test-js2-mode-%s" name)))
 157         (fixture (format "./fixtures/%s.js" (or fixture-name name)))
 158         (function-name (intern-soft
 159                         (format "context-coloring-test-js-%s" name)))
 160         (setup-function-name (intern-soft
 161                               (format
 162                                "context-coloring-test-js-%s-setup" name))))
 163     `(ert-deftest ,test-name ()
 164        (context-coloring-test-js2-mode
 165         ,fixture
 166         ',setup-function-name
 167         (,function-name)))))
 168
 169
 170 ;;; Assertion functions
 171
 172 (defmacro context-coloring-test-assert-region (&rest body)
 173   "Assert something about the face of points in a region.
 174 Provides the free variables `i', `length', `point', `face' and
 175 `actual-level' to the code in BODY."
 176   `(let ((i 0)
 177          (length (- end start)))
 178      (while (< i length)
 179        (let* ((point (+ i start))
 180               (face (get-text-property point 'face)))
 181          ,@body)
 182        (setq i (+ i 1)))))
 183
 184 (defun context-coloring-test-assert-region-level (start end level)
 185   "Assert that all points in the range [START, END) are of level
 186 LEVEL."
 187   (context-coloring-test-assert-region
 188    (let (actual-level)
 189      (when (not (when face
 190                   (let* ((face-string (symbol-name face))
 191                          (matches (string-match
 192                                    context-coloring-level-face-regexp
 193                                    face-string)))
 194                     (when matches
 195                       (setq actual-level (string-to-number
 196                                           (substring face-string
 197                                                      (match-beginning 1)
 198                                                      (match-end 1))))
 199                       (= level actual-level)))))
 200        (ert-fail (format (concat "Expected level in region [%s, %s), "
 201                                  "which is \"%s\", to be %s; "
 202                                  "but at point %s, it was %s")
 203                          start end
 204                          (buffer-substring-no-properties start end) level
 205                          point actual-level))))))
 206
 207 (defun context-coloring-test-assert-region-face (start end expected-face)
 208   "Assert that all points in the range [START, END) have the face
 209 EXPECTED-FACE."
 210   (context-coloring-test-assert-region
 211    (when (not (eq face expected-face))
 212      (ert-fail (format (concat "Expected face in region [%s, %s), "
 213                                "which is \"%s\", to be %s; "
 214                                "but at point %s, it was %s")
 215                        start end
 216                        (buffer-substring-no-properties start end) expected-face
 217                        point face)))))
 218
 219 (defun context-coloring-test-assert-region-comment-delimiter (start end)
 220   "Assert that all points in the range [START, END) have
 221 `font-lock-comment-delimiter-face'."
 222   (context-coloring-test-assert-region-face
 223    start end 'font-lock-comment-delimiter-face))
 224
 225 (defun context-coloring-test-assert-region-comment (start end)
 226   "Assert that all points in the range [START, END) have
 227 `font-lock-comment-face'."
 228   (context-coloring-test-assert-region-face
 229    start end 'font-lock-comment-face))
 230
 231 (defun context-coloring-test-assert-region-string (start end)
 232   "Assert that all points in the range [START, END) have
 233 `font-lock-string-face'."
 234   (context-coloring-test-assert-region-face
 235    start end 'font-lock-string-face))
 236
 237 (defun context-coloring-test-assert-message (expected buffer)
 238   "Assert that message EXPECTED exists in BUFFER."
 239   (when (null (get-buffer buffer))
 240     (ert-fail
 241      (format
 242       (concat
 243        "Expected buffer `%s' to have message \"%s\", "
 244        "but the buffer did not have any messages.")
 245       buffer expected)))
 246   (with-current-buffer buffer
 247     (let ((messages (split-string
 248                      (buffer-substring-no-properties
 249                       (point-min)
 250                       (point-max))
 251                      "\n")))
 252       (let ((message (car (nthcdr (- (length messages) 2) messages))))
 253         (when (not (equal message expected))
 254           (ert-fail
 255            (format
 256             (concat
 257              "Expected buffer `%s' to have message \"%s\", "
 258              "but instead it was \"%s\"")
 259             buffer expected
 260             message)))))))
 261
 262 (defun context-coloring-test-assert-no-message (buffer)
 263   "Assert that BUFFER has no message."
 264   (when (get-buffer buffer)
 265     (ert-fail (format (concat "Expected buffer `%s' to have no messages, "
 266                               "but it did: `%s'")
 267                       buffer
 268                       (with-current-buffer buffer
 269                         (buffer-string))))))
 270
 271 (defun context-coloring-test-kill-buffer (buffer)
 272   "Kill BUFFER if it exists."
 273   (when (get-buffer buffer) (kill-buffer buffer)))
 274
 275 (defun context-coloring-test-assert-face (level foreground &optional negate)
 276   "Assert that a face for LEVEL exists and that its `:foreground'
 277 is FOREGROUND, or the inverse if NEGATE is non-nil."
 278   (let* ((face (context-coloring-level-face level))
 279          actual-foreground)
 280     (when (not (or negate
 281                    face))
 282       (ert-fail (format (concat "Expected face for level `%s' to exist; "
 283                                 "but it didn't")
 284                         level)))
 285     (setq actual-foreground (face-attribute face :foreground))
 286     (when (funcall (if negate 'identity 'not)
 287                    (string-equal foreground actual-foreground))
 288       (ert-fail (format (concat "Expected face for level `%s' "
 289                                 "%sto have foreground `%s'; "
 290                                 "but it %s.")
 291                         level
 292                         (if negate "not " "") foreground
 293                         (if negate
 294                             "did" (format "was `%s'" actual-foreground)))))))
 295
 296 (defun context-coloring-test-assert-not-face (&rest arguments)
 297   "Assert that LEVEL does not have a face with `:foreground'
 298 FOREGROUND.  Apply ARGUMENTS to
 299 `context-coloring-test-assert-face', see that function."
 300   (apply 'context-coloring-test-assert-face
 301          (append arguments '(t))))
 302
 303
 304 ;;; The tests
 305
 306 (ert-deftest context-coloring-test-unsupported-mode ()
 307   (context-coloring-test-with-fixture
 308    "./fixtures/function-scopes.js"
 309    (context-coloring-mode)
 310    (context-coloring-test-assert-message
 311     "Context coloring is not available for this major mode"
 312     "*Messages*")))
 313
 314 (define-derived-mode
 315   context-coloring-test-unsupported-version-mode
 316   fundamental-mode
 317   "Testing"
 318   "Prevent `context-coloring-test-unsupported-version' from
 319   having any unintentional side-effects on mode support.")
 320
 321 (ert-deftest-async context-coloring-test-unsupported-version (done)
 322   (context-coloring-define-dispatch
 323    'outta-date
 324    :modes '(context-coloring-test-unsupported-version-mode)
 325    :executable "node"
 326    :command "node test/binaries/outta-date"
 327    :version "v2.1.3")
 328   (context-coloring-test-with-fixture-async
 329    "./fixtures/function-scopes.js"
 330    (lambda (teardown)
 331      (context-coloring-test-unsupported-version-mode)
 332      (add-hook
 333       'context-coloring-check-scopifier-version-hook
 334       (lambda ()
 335         (unwind-protect
 336             (progn
 337               ;; Normally the executable would be something like "outta-date"
 338               ;; rather than "node".
 339               (context-coloring-test-assert-message
 340                "Update to the minimum version of \"node\" (v2.1.3)"
 341                "*Messages*"))
 342           (funcall teardown))
 343         (funcall done)))
 344      (context-coloring-mode))))
 345
 346 (defvar context-coloring-test-theme-index 0
 347   "Unique index for unique theme names.")
 348
 349 (defun context-coloring-test-get-next-theme ()
 350   "Return a unique symbol for a throwaway theme."
 351   (prog1
 352       (intern (format "context-coloring-test-theme-%s"
 353                       context-coloring-test-theme-index))
 354     (setq context-coloring-test-theme-index
 355           (+ context-coloring-test-theme-index 1))))
 356
 357 (defun context-coloring-test-assert-theme-originally-set-p
 358     (settings &optional negate)
 359   "Assert that `context-coloring-theme-originally-set-p' returns
 360 t for a theme with SETTINGS, or the inverse if NEGATE is
 361 non-nil."
 362   (let ((theme (context-coloring-test-get-next-theme)))
 363     (put theme 'theme-settings settings)
 364     (when (funcall (if negate 'identity 'not)
 365                    (context-coloring-theme-originally-set-p theme))
 366       (ert-fail (format (concat "Expected theme `%s' with settings `%s' "
 367                                 "%sto be considered to have defined a level, "
 368                                 "but it %s.")
 369                         theme settings
 370                         (if negate "not " "")
 371                         (if negate "was" "wasn't"))))))
 372
 373 (defun context-coloring-test-assert-not-theme-originally-set-p (&rest arguments)
 374   "Assert that `context-coloring-theme-originally-set-p' does not
 375 return t for a theme with SETTINGS.  Apply ARGUMENTS to
 376 `context-coloring-test-assert-theme-originally-set-p', see that
 377 function."
 378   (apply 'context-coloring-test-assert-theme-originally-set-p
 379          (append arguments '(t))))
 380
 381 (ert-deftest context-coloring-test-theme-originally-set-p ()
 382   (context-coloring-test-assert-theme-originally-set-p
 383    '((theme-face context-coloring-level-0-face)))
 384   (context-coloring-test-assert-theme-originally-set-p
 385    '((theme-face face)
 386      (theme-face context-coloring-level-0-face)))
 387   (context-coloring-test-assert-theme-originally-set-p
 388    '((theme-face context-coloring-level-0-face)
 389      (theme-face face)))
 390   (context-coloring-test-assert-not-theme-originally-set-p
 391    '((theme-face face)))
 392   )
 393
 394 (defun context-coloring-test-assert-theme-settings-highest-level
 395     (settings expected-level)
 396   "Assert that a theme with SETTINGS has the highest level
 397 EXPECTED-LEVEL."
 398   (let ((theme (context-coloring-test-get-next-theme)))
 399     (put theme 'theme-settings settings)
 400     (context-coloring-test-assert-theme-highest-level theme expected-level)))
 401
 402 (defun context-coloring-test-assert-theme-highest-level
 403     (theme expected-level &optional negate)
 404   "Assert that THEME has the highest level EXPECTED-LEVEL, or the
 405 inverse if NEGATE is non-nil."
 406   (let ((highest-level (context-coloring-theme-highest-level theme)))
 407     (when (funcall (if negate 'identity 'not) (eq highest-level expected-level))
 408       (ert-fail (format (concat "Expected theme with settings `%s' "
 409                                 "%sto have a highest level of `%s', "
 410                                 "but it %s.")
 411                         (get theme 'theme-settings)
 412                         (if negate "not " "") expected-level
 413                         (if negate "did" (format "was %s" highest-level)))))))
 414
 415 (defun context-coloring-test-assert-theme-not-highest-level (&rest arguments)
 416   "Assert that THEME's highest level is not EXPECTED-LEVEL.
 417 Apply ARGUMENTS to
 418 `context-coloring-test-assert-theme-highest-level', see that
 419 function."
 420   (apply 'context-coloring-test-assert-theme-highest-level
 421          (append arguments '(t))))
 422
 423 (ert-deftest context-coloring-test-theme-highest-level ()
 424   (context-coloring-test-assert-theme-settings-highest-level
 425    '((theme-face foo))
 426    -1)
 427   (context-coloring-test-assert-theme-settings-highest-level
 428    '((theme-face context-coloring-level-0-face))
 429    0)
 430   (context-coloring-test-assert-theme-settings-highest-level
 431    '((theme-face context-coloring-level-1-face))
 432    1)
 433   (context-coloring-test-assert-theme-settings-highest-level
 434    '((theme-face context-coloring-level-1-face)
 435      (theme-face context-coloring-level-0-face))
 436    1)
 437   (context-coloring-test-assert-theme-settings-highest-level
 438    '((theme-face context-coloring-level-0-face)
 439      (theme-face context-coloring-level-1-face))
 440    1)
 441   )
 442
 443 (defmacro context-coloring-test-deftest-define-theme (name &rest body)
 444   "Define a test with name NAME and an automatically-generated
 445 theme symbol available as a free variable `theme'.  Side-effects
 446 from enabling themes are reversed after BODY is executed and the
 447 test completes."
 448   (declare (indent defun))
 449   (let ((deftest-name (intern
 450                        (format "context-coloring-test-define-theme-%s" name))))
 451     `(ert-deftest ,deftest-name ()
 452        (context-coloring-test-kill-buffer "*Warnings*")
 453        (let ((theme (context-coloring-test-get-next-theme)))
 454          (unwind-protect
 455              (progn
 456                ,@body)
 457            ;; Always cleanup.
 458            (disable-theme theme))))))
 459
 460 (defun context-coloring-test-deftheme (theme)
 461   "Dynamically define theme THEME."
 462   (eval (macroexpand `(deftheme ,theme))))
 463
 464 (context-coloring-test-deftest-define-theme additive
 465   (context-coloring-test-deftheme theme)
 466   (context-coloring-define-theme
 467    theme
 468    :colors '("#aaaaaa"
 469              "#bbbbbb"))
 470   (context-coloring-test-assert-no-message "*Warnings*")
 471   (enable-theme theme)
 472   (context-coloring-test-assert-no-message "*Warnings*")
 473   (context-coloring-test-assert-face 0 "#aaaaaa")
 474   (context-coloring-test-assert-face 1 "#bbbbbb"))
 475
 476 (defun context-coloring-test-assert-defined-warning (theme)
 477   "Assert that a warning about colors already being defined for
 478 theme THEME is signaled."
 479   (context-coloring-test-assert-message
 480    (format (concat "Warning (emacs): Context coloring colors for theme "
 481                    "`%s' are already defined")
 482            theme)
 483    "*Warnings*"))
 484
 485 (context-coloring-test-deftest-define-theme unintentional-override
 486   (context-coloring-test-deftheme theme)
 487   (custom-theme-set-faces
 488    theme
 489    '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
 490    '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
 491   (context-coloring-define-theme
 492    theme
 493    :colors '("#cccccc"
 494              "#dddddd"))
 495   (context-coloring-test-assert-defined-warning theme)
 496   (context-coloring-test-kill-buffer "*Warnings*")
 497   (enable-theme theme)
 498   (context-coloring-test-assert-defined-warning theme)
 499   (context-coloring-test-assert-face 0 "#cccccc")
 500   (context-coloring-test-assert-face 1 "#dddddd"))
 501
 502 (context-coloring-test-deftest-define-theme intentional-override
 503   (context-coloring-test-deftheme theme)
 504   (custom-theme-set-faces
 505    theme
 506    '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
 507    '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
 508   (context-coloring-define-theme
 509    theme
 510    :override t
 511    :colors '("#cccccc"
 512              "#dddddd"))
 513   (context-coloring-test-assert-no-message "*Warnings*")
 514   (enable-theme theme)
 515   (context-coloring-test-assert-no-message "*Warnings*")
 516   (context-coloring-test-assert-face 0 "#cccccc")
 517   (context-coloring-test-assert-face 1 "#dddddd"))
 518
 519 (context-coloring-test-deftest-define-theme pre-recede
 520   (context-coloring-define-theme
 521    theme
 522    :recede t
 523    :colors '("#aaaaaa"
 524              "#bbbbbb"))
 525   (context-coloring-test-deftheme theme)
 526   (custom-theme-set-faces
 527    theme
 528    '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
 529    '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
 530   (enable-theme theme)
 531   (context-coloring-test-assert-no-message "*Warnings*")
 532   (context-coloring-test-assert-face 0 "#cccccc")
 533   (context-coloring-test-assert-face 1 "#dddddd"))
 534
 535 (context-coloring-test-deftest-define-theme post-recede
 536   (context-coloring-test-deftheme theme)
 537   (custom-theme-set-faces
 538    theme
 539    '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
 540    '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
 541   (context-coloring-define-theme
 542    theme
 543    :recede t
 544    :colors '("#cccccc"
 545              "#dddddd"))
 546   (context-coloring-test-assert-no-message "*Warnings*")
 547   (context-coloring-test-assert-face 0 "#aaaaaa")
 548   (context-coloring-test-assert-face 1 "#bbbbbb")
 549   (enable-theme theme)
 550   (context-coloring-test-assert-no-message "*Warnings*")
 551   (context-coloring-test-assert-face 0 "#aaaaaa")
 552   (context-coloring-test-assert-face 1 "#bbbbbb"))
 553
 554 (context-coloring-test-deftest-define-theme recede-not-defined
 555   (context-coloring-test-deftheme theme)
 556   (custom-theme-set-faces
 557    theme
 558    '(foo-face ((t (:foreground "#ffffff")))))
 559   (context-coloring-define-theme
 560    theme
 561    :recede t
 562    :colors '("#aaaaaa"
 563              "#bbbbbb"))
 564   (context-coloring-test-assert-no-message "*Warnings*")
 565   (context-coloring-test-assert-face 0 "#aaaaaa")
 566   (context-coloring-test-assert-face 1 "#bbbbbb")
 567   (enable-theme theme)
 568   (context-coloring-test-assert-no-message "*Warnings*")
 569   (context-coloring-test-assert-face 0 "#aaaaaa")
 570   (context-coloring-test-assert-face 1 "#bbbbbb"))
 571
 572 (context-coloring-test-deftest-define-theme unintentional-obstinance
 573   (context-coloring-define-theme
 574    theme
 575    :colors '("#aaaaaa"
 576              "#bbbbbb"))
 577   (context-coloring-test-deftheme theme)
 578   (custom-theme-set-faces
 579    theme
 580    '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
 581    '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
 582   (enable-theme theme)
 583   (context-coloring-test-assert-defined-warning theme)
 584   (context-coloring-test-assert-face 0 "#aaaaaa")
 585   (context-coloring-test-assert-face 1 "#bbbbbb"))
 586
 587 (context-coloring-test-deftest-define-theme intentional-obstinance
 588   (context-coloring-define-theme
 589    theme
 590    :override t
 591    :colors '("#aaaaaa"
 592              "#bbbbbb"))
 593   (context-coloring-test-deftheme theme)
 594   (custom-theme-set-faces
 595    theme
 596    '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
 597    '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
 598   (enable-theme theme)
 599   (context-coloring-test-assert-no-message "*Warnings*")
 600   (context-coloring-test-assert-face 0 "#aaaaaa")
 601   (context-coloring-test-assert-face 1 "#bbbbbb"))
 602
 603 (defun context-coloring-test-assert-maximum-face (maximum &optional negate)
 604   "Assert that `context-coloring-maximum-face' is MAXIMUM, or the
 605 inverse if NEGATE is non-nil."
 606   (when (funcall (if negate 'identity 'not)
 607                  (eq context-coloring-maximum-face maximum))
 608     (ert-fail (format (concat "Expected `context-coloring-maximum-face' "
 609                               "%sto be `%s', "
 610                               "but it %s.")
 611                       (if negate "not " "") maximum
 612                       (if negate
 613                           "was"
 614                         (format "was `%s'" context-coloring-maximum-face))))))
 615
 616 (defun context-coloring-test-assert-not-maximum-face (&rest arguments)
 617   "Assert that `context-coloring-maximum-face' is not MAXIMUM.
 618 Apply ARGUMENTS to `context-coloring-test-assert-maximum-face',
 619 see that function."
 620   (apply 'context-coloring-test-assert-maximum-face
 621          (append arguments '(t))))
 622
 623 (context-coloring-test-deftest-define-theme disable-cascade
 624   (context-coloring-test-deftheme theme)
 625   (context-coloring-define-theme
 626    theme
 627    :colors '("#aaaaaa"
 628              "#bbbbbb"))
 629   (let ((second-theme (context-coloring-test-get-next-theme)))
 630     (context-coloring-test-deftheme second-theme)
 631     (context-coloring-define-theme
 632      second-theme
 633      :colors '("#cccccc"
 634                "#dddddd"
 635                "#eeeeee"))
 636     (let ((third-theme (context-coloring-test-get-next-theme)))
 637       (context-coloring-test-deftheme third-theme)
 638       (context-coloring-define-theme
 639        third-theme
 640        :colors '("#111111"
 641                  "#222222"
 642                  "#333333"
 643                  "#444444"))
 644       (enable-theme theme)
 645       (enable-theme second-theme)
 646       (enable-theme third-theme)
 647       (disable-theme third-theme)
 648       (context-coloring-test-assert-face 0 "#cccccc")
 649       (context-coloring-test-assert-face 1 "#dddddd")
 650       (context-coloring-test-assert-face 2 "#eeeeee")
 651       (context-coloring-test-assert-maximum-face 2))
 652     (disable-theme second-theme)
 653     (context-coloring-test-assert-face 0 "#aaaaaa")
 654     (context-coloring-test-assert-face 1 "#bbbbbb")
 655     (context-coloring-test-assert-maximum-face 1))
 656   (disable-theme theme)
 657   (context-coloring-test-assert-not-face 0 "#aaaaaa")
 658   (context-coloring-test-assert-not-face 1 "#bbbbbb")
 659   (context-coloring-test-assert-not-maximum-face 1))
 660
 661 (defun context-coloring-test-js-function-scopes ()
 662   "Test fixtures/functions-scopes.js."
 663   (context-coloring-test-assert-region-level 1 9 0)
 664   (context-coloring-test-assert-region-level 9 23 1)
 665   (context-coloring-test-assert-region-level 23 25 0)
 666   (context-coloring-test-assert-region-level 25 34 1)
 667   (context-coloring-test-assert-region-level 34 35 0)
 668   (context-coloring-test-assert-region-level 35 52 1)
 669   (context-coloring-test-assert-region-level 52 66 2)
 670   (context-coloring-test-assert-region-level 66 72 1)
 671   (context-coloring-test-assert-region-level 72 81 2)
 672   (context-coloring-test-assert-region-level 81 82 1)
 673   (context-coloring-test-assert-region-level 82 87 2)
 674   (context-coloring-test-assert-region-level 87 89 1))
 675
 676 (context-coloring-test-deftest-js-mode function-scopes)
 677 (context-coloring-test-deftest-js2-mode function-scopes)
 678
 679 (defun context-coloring-test-js-global ()
 680   "Test fixtures/global.js."
 681   (context-coloring-test-assert-region-level 20 28 1)
 682   (context-coloring-test-assert-region-level 28 35 0)
 683   (context-coloring-test-assert-region-level 35 41 1))
 684
 685 (context-coloring-test-deftest-js-mode global)
 686 (context-coloring-test-deftest-js2-mode global)
 687
 688 (defun context-coloring-test-js-block-scopes ()
 689   "Test fixtures/block-scopes.js."
 690   (context-coloring-test-assert-region-level 20 64 1)
 691    (setq context-coloring-js-block-scopes t)
 692    (context-coloring-colorize)
 693    (context-coloring-test-assert-region-level 20 27 1)
 694    (context-coloring-test-assert-region-level 27 41 2)
 695    (context-coloring-test-assert-region-level 41 42 1)
 696    (context-coloring-test-assert-region-level 42 64 2))
 697
 698 (context-coloring-test-deftest-js2-mode block-scopes)
 699
 700 (defun context-coloring-test-js-catch ()
 701   "Test fixtures/js-catch.js."
 702   (context-coloring-test-assert-region-level 20 27 1)
 703   (context-coloring-test-assert-region-level 27 51 2)
 704   (context-coloring-test-assert-region-level 51 52 1)
 705   (context-coloring-test-assert-region-level 52 73 2)
 706   (context-coloring-test-assert-region-level 73 101 3)
 707   (context-coloring-test-assert-region-level 101 102 1)
 708   (context-coloring-test-assert-region-level 102 117 3)
 709   (context-coloring-test-assert-region-level 117 123 2))
 710
 711 (context-coloring-test-deftest-js-mode catch)
 712 (context-coloring-test-deftest-js2-mode catch)
 713
 714 (defun context-coloring-test-js-key-names ()
 715   "Test fixtures/key-names.js."
 716   (context-coloring-test-assert-region-level 20 63 1))
 717
 718 (context-coloring-test-deftest-js-mode key-names)
 719 (context-coloring-test-deftest-js2-mode key-names)
 720
 721 (defun context-coloring-test-js-property-lookup ()
 722   "Test fixtures/property-lookup.js."
 723   (context-coloring-test-assert-region-level 20 26 0)
 724   (context-coloring-test-assert-region-level 26 38 1)
 725   (context-coloring-test-assert-region-level 38 44 0)
 726   (context-coloring-test-assert-region-level 44 52 1)
 727   (context-coloring-test-assert-region-level 57 63 0)
 728   (context-coloring-test-assert-region-level 63 74 1))
 729
 730 (context-coloring-test-deftest-js-mode property-lookup)
 731 (context-coloring-test-deftest-js2-mode property-lookup)
 732
 733 (defun context-coloring-test-js-key-values ()
 734   "Test fixtures/key-values.js."
 735   (context-coloring-test-assert-region-level 78 79 1))
 736
 737 (context-coloring-test-deftest-js-mode key-values)
 738 (context-coloring-test-deftest-js2-mode key-values)
 739
 740 (defun context-coloring-test-js-syntactic-comments-and-strings ()
 741   "Test comments and strings."
 742   (context-coloring-test-assert-region-level 1 8 0)
 743   (context-coloring-test-assert-region-comment-delimiter 9 12)
 744   (context-coloring-test-assert-region-comment 12 16)
 745   (context-coloring-test-assert-region-comment-delimiter 17 20)
 746   (context-coloring-test-assert-region-comment 20 27)
 747   (context-coloring-test-assert-region-string 28 40)
 748   (context-coloring-test-assert-region-level 40 41 0))
 749
 750 (defun context-coloring-test-js-syntactic-comments-and-strings-setup ()
 751   (setq context-coloring-syntactic-comments t)
 752   (setq context-coloring-syntactic-strings t))
 753
 754 (context-coloring-test-deftest-js-mode syntactic-comments-and-strings
 755   :fixture-name comments-and-strings)
 756 (context-coloring-test-deftest-js2-mode syntactic-comments-and-strings
 757   :fixture-name comments-and-strings)
 758
 759 (defalias 'context-coloring-test-js-comments-and-strings
 760   'context-coloring-test-js-syntactic-comments-and-strings
 761   "Test comments and strings.  Deprecated.")
 762
 763 (defun context-coloring-test-js-comments-and-strings-setup ()
 764   "Setup comments and strings.  Deprecated."
 765   (setq context-coloring-comments-and-strings t))
 766
 767 (context-coloring-test-deftest-js-mode comments-and-strings)
 768 (context-coloring-test-deftest-js2-mode comments-and-strings)
 769
 770 (defun context-coloring-test-js-syntactic-comments ()
 771   "Test syntactic comments."
 772   (context-coloring-test-assert-region-level 1 8 0)
 773   (context-coloring-test-assert-region-comment-delimiter 9 12)
 774   (context-coloring-test-assert-region-comment 12 16)
 775   (context-coloring-test-assert-region-comment-delimiter 17 20)
 776   (context-coloring-test-assert-region-comment 20 27)
 777   (context-coloring-test-assert-region-level 28 41 0))
 778
 779 (defun context-coloring-test-js-syntactic-comments-setup ()
 780   "Setup syntactic comments."
 781   (setq context-coloring-syntactic-comments t))
 782
 783 (context-coloring-test-deftest-js-mode syntactic-comments
 784   :fixture-name comments-and-strings)
 785 (context-coloring-test-deftest-js2-mode syntactic-comments
 786   :fixture-name comments-and-strings)
 787
 788 (defun context-coloring-test-js-syntactic-strings ()
 789   "Test syntactic strings."
 790   (context-coloring-test-assert-region-level 1 28 0)
 791   (context-coloring-test-assert-region-string 28 40)
 792   (context-coloring-test-assert-region-level 40 41 0))
 793
 794 (defun context-coloring-test-js-syntactic-strings-setup ()
 795   "Setup syntactic strings."
 796   (setq context-coloring-syntactic-strings t))
 797
 798 (context-coloring-test-deftest-js-mode syntactic-strings
 799   :fixture-name comments-and-strings)
 800 (context-coloring-test-deftest-js2-mode syntactic-strings
 801   :fixture-name comments-and-strings)
 802
 803 (provide 'context-coloring-test)
 804
 805 ;;; context-coloring-test.el ends here