X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/afda2e6a9ddff208fb7dbcda5043aa779ccfd2bc..98073fe7fa07ead749fc43c8ed0a2e138834c480:/packages/context-coloring/test/context-coloring-test.el diff --git a/packages/context-coloring/test/context-coloring-test.el b/packages/context-coloring/test/context-coloring-test.el index 39f2f801c..f5633b86e 100644 --- a/packages/context-coloring/test/context-coloring-test.el +++ b/packages/context-coloring/test/context-coloring-test.el @@ -27,7 +27,7 @@ (require 'cl-lib) (require 'context-coloring) -(require 'ert-async) +(require 'ert) (require 'js2-mode) @@ -44,39 +44,12 @@ (buffer-string))) (defmacro context-coloring-test-with-fixture (fixture &rest body) - "With the relative FIXTURE, evaluate BODY in a temporary -buffer." + "With relative FIXTURE, evaluate BODY in a temporary buffer." `(with-temp-buffer (progn (insert (context-coloring-test-read-file ,fixture)) ,@body))) -(defun context-coloring-test-with-temp-buffer-async (callback) - "Create a temporary buffer, and evaluate CALLBACK there. A -teardown callback is passed to CALLBACK for it to invoke when it -is done." - (let ((previous-buffer (current-buffer)) - (temp-buffer (generate-new-buffer " *temp*"))) - (set-buffer temp-buffer) - (funcall - callback - (lambda () - (and (buffer-name temp-buffer) - (kill-buffer temp-buffer)) - (set-buffer previous-buffer))))) - -(defun context-coloring-test-with-fixture-async (fixture callback) - "With the relative FIXTURE, evaluate CALLBACK in a temporary -buffer. A teardown callback is passed to CALLBACK for it to -invoke when it is done." - (context-coloring-test-with-temp-buffer-async - (lambda (done-with-temp-buffer) - (insert (context-coloring-test-read-file fixture)) - (funcall - callback - (lambda () - (funcall done-with-temp-buffer)))))) - ;;; Test defining utilities @@ -84,25 +57,17 @@ invoke when it is done." &key mode &key extension &key no-fixture - &key async - &key post-colorization &key enable-context-coloring-mode - &key get-args &key before-each &key after-each) - "Define a deftest defmacro for tests prefixed with NAME. MODE + "Define a deftest defmacro for tests prefixed with NAME. MODE is called to set up tests' environments. EXTENSION denotes the suffix for tests' fixture files. If NO-FIXTURE is non-nil, don't -use a fixture. If ASYNC is non-nil, pass a callback to the -defined tests' bodies for them to call when they are done. If -POST-COLORIZATION is non-nil, the tests run after -`context-coloring-colorize' finishes asynchronously. If -ENABLE-CONTEXT-COLORING-MODE is non-nil, `context-coloring-mode' -is activated before tests. GET-ARGS provides arguments to apply -to BEFORE-EACH, AFTER-EACH, and each tests' body, before and -after functions. Functions BEFORE-EACH and AFTER-EACH run before -the major mode is activated before each test, and after each -test, even if an error is signaled." +use a fixture. If ENABLE-CONTEXT-COLORING-MODE is non-nil, +`context-coloring-mode' is activated before tests. Functions +BEFORE-EACH and AFTER-EACH run before the major mode is activated +before each test, and after each test, even if an error is +signaled." (declare (indent defun)) (let ((macro-name (intern (format "context-coloring-test-deftest%s" (cond @@ -114,106 +79,39 @@ test, even if an error is signaled." &key fixture &key before &key after) - ,(format "Define a test for `%s' suffixed with NAME. - -Function BODY makes assertions. -%s - -Functions BEFORE and AFTER run before and after the test, even if -an error is signaled. - -BODY is run after `context-coloring-mode' is activated, or after -initial colorization if colorization should occur." - (cadr mode) - (cond - (no-fixture " -There is no fixture, unless FIXTURE is specified.") - (t - (format " -The default fixture has a filename matching NAME (plus the -filetype extension, \"%s\"), unless FIXTURE is specified to -override it." - extension)))) (declare (indent defun)) ;; Commas in nested backquotes are not evaluated. Binding the variables ;; here is probably the cleanest workaround. (let ((mode ,mode) - (get-args ',(cond - (get-args get-args) - (t '(lambda () (list))))) - (args (make-symbol "args")) (before-each ',before-each) (after-each ',after-each) (test-name (intern (format ,(format "%s-%%s" (cond (name) - (t "sync"))) name))) + (t "generic"))) name))) (fixture (cond (fixture (format "./fixtures/%s" fixture)) (,no-fixture "./fixtures/empty") (t (format ,(format "./fixtures/%%s.%s" extension) name))))) - ,@(cond - ((or async post-colorization) - `((let ((post-colorization ,post-colorization)) - `(ert-deftest-async ,test-name (done) - (let ((,args (funcall ,get-args))) - (context-coloring-test-with-fixture-async - ,fixture - (lambda (done-with-fixture) - (when ,before-each (apply ,before-each ,args)) - (,mode) - (when ,before (apply ,before ,args)) - (cond - (,post-colorization - (context-coloring-colorize - (lambda () - (unwind-protect - (progn - (apply ,body ,args)) - (when ,after (apply ,after ,args)) - (when ,after-each (apply ,after-each ,args)) - (funcall done-with-fixture)) - (funcall done)))) - (t - ;; Leave error handling up to the user. - (apply ,body (append - (list (lambda () - (when ,after (apply ,after ,args)) - (when ,after-each (apply ,after-each ,args)) - (funcall done-with-fixture) - (funcall done))) - ,args))))))))))) - (t - `((let ((enable-context-coloring-mode ,enable-context-coloring-mode)) - `(ert-deftest ,test-name () - (let ((,args (funcall ,get-args))) - (context-coloring-test-with-fixture - ,fixture - (when ,before-each (apply ,before-each ,args)) - (,mode) - (when ,before (apply ,before ,args)) - (when ,enable-context-coloring-mode (context-coloring-mode)) - (unwind-protect - (progn - (apply ,body ,args)) - (when ,after (apply ,after ,args)) - (when ,after-each (apply ,after-each ,args)))))))))))))) + ,@`((let ((enable-context-coloring-mode ,enable-context-coloring-mode)) + `(ert-deftest ,test-name () + (context-coloring-test-with-fixture + ,fixture + (when ,before-each (funcall ,before-each)) + (,mode) + (when ,before (funcall ,before)) + (when ,enable-context-coloring-mode (context-coloring-mode)) + (unwind-protect + (progn + (funcall ,body)) + (when ,after (funcall ,after)) + (when ,after-each (funcall ,after-each))))))))))) (context-coloring-test-define-deftest nil :mode #'fundamental-mode :no-fixture t) -(context-coloring-test-define-deftest async - :mode #'fundamental-mode - :no-fixture t - :async t) - -(context-coloring-test-define-deftest js - :mode #'js-mode - :extension "js" - :post-colorization t) - -(context-coloring-test-define-deftest js2 +(context-coloring-test-define-deftest javascript :mode #'js2-mode :extension "js" :enable-context-coloring-mode t @@ -221,14 +119,6 @@ override it." (setq js2-mode-show-parse-errors nil) (setq js2-mode-show-strict-warnings nil))) -(defmacro context-coloring-test-deftest-js-js2 (&rest args) - "Simultaneously define the same test for js and js2 (with -ARGS)." - (declare (indent defun)) - `(progn - (context-coloring-test-deftest-js ,@args) - (context-coloring-test-deftest-js2 ,@args))) - (context-coloring-test-define-deftest emacs-lisp :mode #'emacs-lisp-mode :extension "el" @@ -238,18 +128,6 @@ ARGS)." :mode #'fundamental-mode :no-fixture t) -(context-coloring-test-define-deftest define-theme - :mode #'fundamental-mode - :no-fixture t - :get-args (lambda () - (list (context-coloring-test-get-next-theme))) - :after-each (lambda (theme) - (setq context-coloring-maximum-face 7) - (setq context-coloring-original-maximum-face - context-coloring-maximum-face) - (disable-theme theme) - (context-coloring-test-kill-buffer "*Warnings*"))) - ;;; Assertion functions @@ -295,15 +173,6 @@ ARGS)." "but it did") buffer expected))))))) -(defun context-coloring-test-assert-no-message (buffer) - "Assert that BUFFER has no message." - (when (get-buffer buffer) - (ert-fail (format (concat "Expected buffer `%s' to have no messages, " - "but it did: `%s'") - buffer - (with-current-buffer buffer - (buffer-string)))))) - (defun context-coloring-test-assert-error (body error-message) "Assert that BODY signals ERROR-MESSAGE." (let ((error-signaled-p nil)) @@ -323,79 +192,74 @@ ARGS)." ;;; Miscellaneous tests -(defun context-coloring-test-assert-trimmed (result expected) - "Assert that RESULT is trimmed like EXPECTED." - (when (not (string-equal result expected)) - (ert-fail "Expected string to be trimmed, but it wasn't."))) - -(context-coloring-test-deftest trim - (lambda () - (context-coloring-test-assert-trimmed (context-coloring-trim "") "") - (context-coloring-test-assert-trimmed (context-coloring-trim " ") "") - (context-coloring-test-assert-trimmed (context-coloring-trim "a") "a") - (context-coloring-test-assert-trimmed (context-coloring-trim " a") "a") - (context-coloring-test-assert-trimmed (context-coloring-trim "a ") "a") - (context-coloring-test-assert-trimmed (context-coloring-trim " a ") "a"))) - -(context-coloring-test-deftest-async mode-startup - (lambda (done) - (js-mode) - (add-hook - 'context-coloring-colorize-hook - (lambda () - ;; If this runs we are implicitly successful; this test only confirms - ;; that colorization occurs on mode startup. - (funcall done))) - (context-coloring-mode)) - :after (lambda () - ;; TODO: This won't run if there is a timeout. Will probably have to - ;; roll our own `ert-deftest-async'. - (setq context-coloring-colorize-hook nil))) - (defmacro context-coloring-test-define-derived-mode (name) "Define a derived mode exclusively for any test with NAME." (let ((name (intern (format "context-coloring-test-%s-mode" name)))) `(define-derived-mode ,name fundamental-mode "Testing"))) +(defvar context-coloring-test-caused-p nil + "If non-nil, coloring was caused.") + +(defmacro context-coloring-test-assert-causes-coloring (&rest body) + "Assert that BODY causes coloring." + `(progn + ;; Gross, but I want this to pass on 24.3. + (ad-add-advice #'context-coloring-colorize + '(assert-causes-coloring + nil t + (advice . (lambda () + (setq context-coloring-test-caused-p t)))) + 'after + 0) + (ad-activate #'context-coloring-colorize) + ,@body + (when (not context-coloring-test-caused-p) + (ert-fail "Expected to have colorized, but it didn't.")))) + +(defun context-coloring-test-cleanup-assert-causes-coloring () + "Undo `context-coloring-test-assert-causes-coloring'." + (ad-unadvise #'context-coloring-colorize) + (setq context-coloring-test-caused-p nil)) + +(context-coloring-test-define-derived-mode mode-startup) + +(context-coloring-test-deftest mode-startup + (lambda () + (context-coloring-define-dispatch + 'mode-startup + :modes '(context-coloring-test-mode-startup-mode) + :colorizer #'ignore) + (context-coloring-test-mode-startup-mode) + (context-coloring-test-assert-causes-coloring + (context-coloring-mode))) + :after (lambda () + (context-coloring-test-cleanup-assert-causes-coloring))) + (context-coloring-test-define-derived-mode change-detection) -;; Simply cannot figure out how to trigger an idle timer; would much rather test -;; that. But (current-idle-time) always returns nil in these tests. -(context-coloring-test-deftest-async change-detection - (lambda (done) +(context-coloring-test-deftest change-detection + (lambda () (context-coloring-define-dispatch 'idle-change :modes '(context-coloring-test-change-detection-mode) - :executable "node" - :command "node test/binaries/noop") + :colorizer #'ignore + :setup #'context-coloring-setup-idle-change-detection + :teardown #'context-coloring-teardown-idle-change-detection) (context-coloring-test-change-detection-mode) - (add-hook - 'context-coloring-colorize-hook - (lambda () - (setq context-coloring-colorize-hook nil) - (add-hook - 'context-coloring-colorize-hook - (lambda () - (funcall done))) - (insert " ") - (set-window-buffer (selected-window) (current-buffer)) - (context-coloring-maybe-colorize-with-buffer (current-buffer)))) - (context-coloring-mode)) + (context-coloring-mode) + (context-coloring-test-assert-causes-coloring + (insert " ") + ;; Simply cannot figure out how to trigger an idle timer; would much rather + ;; test that. But (current-idle-time) always returns nil in these tests. + (context-coloring-maybe-colorize-with-buffer (current-buffer)))) :after (lambda () - (setq context-coloring-colorize-hook nil))) - -(context-coloring-test-deftest check-version - (lambda () - (when (not (context-coloring-check-version "2.1.3" "3.0.1")) - (ert-fail "Expected version 3.0.1 to satisfy 2.1.3, but it didn't.")) - (when (context-coloring-check-version "3.0.1" "2.1.3") - (ert-fail "Expected version 2.1.3 not to satisfy 3.0.1, but it did.")))) + (context-coloring-test-cleanup-assert-causes-coloring))) (context-coloring-test-deftest unsupported-mode (lambda () (context-coloring-mode) (context-coloring-test-assert-message - "Context coloring is not available for this major mode" + "Context coloring is unavailable here" "*Messages*"))) (context-coloring-test-deftest derived-mode @@ -403,9 +267,22 @@ ARGS)." (lisp-interaction-mode) (context-coloring-mode) (context-coloring-test-assert-not-message - "Context coloring is not available for this major mode" + "Context coloring is unavailable here" "*Messages*"))) +(context-coloring-test-deftest unavailable-message-ignored + (lambda () + (minibuffer-with-setup-hook + (lambda () + (context-coloring-mode) + (context-coloring-test-assert-not-message + "Context coloring is unavailable here" + "*Messages*")) + (execute-kbd-macro + (vconcat + [?\C-u] + [?\M-!]))))) + (context-coloring-test-define-derived-mode define-dispatch-error) (context-coloring-test-deftest define-dispatch-error @@ -420,424 +297,70 @@ ARGS)." (context-coloring-define-dispatch 'define-dispatch-no-strategy :modes '(context-coloring-test-define-dispatch-error-mode))) - "No colorizer or command defined for dispatch"))) - -(context-coloring-test-define-derived-mode missing-executable) - -(context-coloring-test-deftest missing-executable - (lambda () - (context-coloring-define-dispatch - 'scopifier - :modes '(context-coloring-test-missing-executable-mode) - :command "" - :executable "__should_not_exist__") - (context-coloring-test-missing-executable-mode) - (context-coloring-mode))) - -(context-coloring-test-define-derived-mode unsupported-version) - -(context-coloring-test-deftest-async unsupported-version - (lambda (done) - (context-coloring-define-dispatch - 'outta-date - :modes '(context-coloring-test-unsupported-version-mode) - :executable "node" - :command "node test/binaries/outta-date" - :version "v2.1.3") - (context-coloring-test-unsupported-version-mode) - (add-hook - 'context-coloring-check-scopifier-version-hook - (lambda () - (unwind-protect - (progn - ;; Normally the executable would be something like "outta-date" - ;; rather than "node". - (context-coloring-test-assert-message - "Update to the minimum version of \"node\" (v2.1.3)" - "*Messages*")) - (funcall done)))) - (context-coloring-mode)) - :after (lambda () - (setq context-coloring-check-scopifier-version-hook nil))) + "No colorizer defined for dispatch"))) (context-coloring-test-define-derived-mode disable-mode) -(context-coloring-test-deftest-async disable-mode - (lambda (done) +(context-coloring-test-deftest disable-mode + (lambda () (let (torn-down) (context-coloring-define-dispatch 'disable-mode :modes '(context-coloring-test-disable-mode-mode) - :executable "node" - :command "node test/binaries/noop" + :colorizer #'ignore :teardown (lambda () (setq torn-down t))) - (unwind-protect - (progn - (context-coloring-test-disable-mode-mode) - (context-coloring-mode) - (context-coloring-mode -1) - (when (not torn-down) - (ert-fail "Expected teardown function to have been called, but it wasn't."))) - (funcall done))))) - - -;;; Theme tests - -(defvar context-coloring-test-theme-index 0 - "Unique index for unique theme names.") - -(defun context-coloring-test-get-next-theme () - "Return a unique symbol for a throwaway theme." - (prog1 - (intern (format "context-coloring-test-theme-%s" - context-coloring-test-theme-index)) - (setq context-coloring-test-theme-index - (+ context-coloring-test-theme-index 1)))) - -(defun context-coloring-test-assert-face (level foreground &optional negate) - "Assert that a face for LEVEL exists and that its `:foreground' -is FOREGROUND, or the inverse if NEGATE is non-nil." - (let* ((face (context-coloring-level-face level)) - actual-foreground) - (when (not (or negate - face)) - (ert-fail (format (concat "Expected face for level `%s' to exist; " - "but it didn't") - level))) - (setq actual-foreground (face-attribute face :foreground)) - (when (funcall (if negate #'identity #'not) - (string-equal foreground actual-foreground)) - (ert-fail (format (concat "Expected face for level `%s' " - "%sto have foreground `%s'; " - "but it %s.") - level - (if negate "not " "") foreground - (if negate - "did" (format "was `%s'" actual-foreground))))))) - -(defun context-coloring-test-assert-not-face (&rest arguments) - "Assert that LEVEL does not have a face with `:foreground' -FOREGROUND. Apply ARGUMENTS to -`context-coloring-test-assert-face', see that function." - (apply #'context-coloring-test-assert-face - (append arguments '(t)))) - -(defun context-coloring-test-assert-theme-originally-set-p - (settings &optional negate) - "Assert that `context-coloring-theme-originally-set-p' will -return t for a theme with SETTINGS, or the inverse if NEGATE is -non-nil." - (let ((theme (context-coloring-test-get-next-theme))) - (put theme 'theme-settings settings) - (when (funcall (if negate #'identity #'not) - (context-coloring-theme-originally-set-p theme)) - (ert-fail (format (concat "Expected theme `%s' with settings `%s' " - "%sto be considered to have defined a level, " - "but it %s.") - theme settings - (if negate "not " "") - (if negate "was" "wasn't")))))) - -(defun context-coloring-test-assert-not-theme-originally-set-p (&rest arguments) - "Assert that `context-coloring-theme-originally-set-p' does not -return t for a theme with SETTINGS. Apply ARGUMENTS to -`context-coloring-test-assert-theme-originally-set-p', see that -function." - (apply #'context-coloring-test-assert-theme-originally-set-p - (append arguments '(t)))) - -(context-coloring-test-deftest theme-originally-set-p - (lambda () - (context-coloring-test-assert-theme-originally-set-p - '((theme-face context-coloring-level-0-face))) - (context-coloring-test-assert-theme-originally-set-p - '((theme-face face) - (theme-face context-coloring-level-0-face))) - (context-coloring-test-assert-theme-originally-set-p - '((theme-face context-coloring-level-0-face) - (theme-face face))) - (context-coloring-test-assert-not-theme-originally-set-p - '((theme-face face))))) - -(defun context-coloring-test-assert-theme-settings-highest-level - (settings expected-level) - "Assert that a theme with SETTINGS has the highest level -EXPECTED-LEVEL." - (let ((theme (context-coloring-test-get-next-theme))) - (put theme 'theme-settings settings) - (context-coloring-test-assert-theme-highest-level theme expected-level))) - -(defun context-coloring-test-assert-theme-highest-level - (theme expected-level &optional negate) - "Assert that THEME has the highest level EXPECTED-LEVEL, or the -inverse if NEGATE is non-nil." - (let ((highest-level (context-coloring-theme-highest-level theme))) - (when (funcall (if negate #'identity #'not) (eq highest-level expected-level)) - (ert-fail (format (concat "Expected theme with settings `%s' " - "%sto have a highest level of `%s', " - "but it %s.") - (get theme 'theme-settings) - (if negate "not " "") expected-level - (if negate "did" (format "was %s" highest-level))))))) - -(defun context-coloring-test-assert-theme-not-highest-level (&rest arguments) - "Assert that THEME's highest level is not EXPECTED-LEVEL. -Apply ARGUMENTS to -`context-coloring-test-assert-theme-highest-level', see that -function." - (apply #'context-coloring-test-assert-theme-highest-level - (append arguments '(t)))) - -(context-coloring-test-deftest theme-highest-level + (context-coloring-test-disable-mode-mode) + (context-coloring-mode) + (context-coloring-mode -1) + (when (not torn-down) + (ert-fail "Expected teardown function to have been called, but it wasn't."))))) + +(defun context-coloring-test-assert-maximum-face (expected) + "Assert that `context-coloring-maximum-face' is EXPECTED." + (when (not (= context-coloring-maximum-face expected)) + (ert-fail (format "Expected maximum face to be %s, but it was %s" + expected context-coloring-maximum-face)))) + +(deftheme context-coloring-test-custom-theme) + +(context-coloring-test-define-derived-mode custom-theme) + +(context-coloring-test-deftest custom-theme (lambda () - (context-coloring-test-assert-theme-settings-highest-level - '((theme-face foo)) - -1) - (context-coloring-test-assert-theme-settings-highest-level - '((theme-face context-coloring-level-0-face)) - 0) - (context-coloring-test-assert-theme-settings-highest-level - '((theme-face context-coloring-level-1-face)) - 1) - (context-coloring-test-assert-theme-settings-highest-level - '((theme-face context-coloring-level-1-face) - (theme-face context-coloring-level-0-face)) - 1) - (context-coloring-test-assert-theme-settings-highest-level - '((theme-face context-coloring-level-0-face) - (theme-face context-coloring-level-1-face)) - 1))) - -(defun context-coloring-test-kill-buffer (buffer) - "Kill BUFFER if it exists." - (when (get-buffer buffer) (kill-buffer buffer))) - -(defun context-coloring-test-deftheme (theme) - "Dynamically define theme THEME." - (eval (macroexpand `(deftheme ,theme)))) - -(context-coloring-test-deftest-define-theme additive - (lambda (theme) - (context-coloring-test-deftheme theme) - (context-coloring-define-theme - theme - :colors '("#aaaaaa" - "#bbbbbb")) - (context-coloring-test-assert-no-message "*Warnings*") - (enable-theme theme) - (context-coloring-test-assert-no-message "*Warnings*") - (context-coloring-test-assert-face 0 "#aaaaaa") - (context-coloring-test-assert-face 1 "#bbbbbb"))) - -(defun context-coloring-test-assert-defined-warning (theme) - "Assert that a warning about colors already being defined for -theme THEME is signaled." - (context-coloring-test-assert-message - (format (concat "Warning (emacs): Context coloring colors for theme " - "`%s' are already defined") - theme) - "*Warnings*")) - -(context-coloring-test-deftest-define-theme unintentional-override - (lambda (theme) - (context-coloring-test-deftheme theme) - (custom-theme-set-faces - theme - '(context-coloring-level-0-face ((t (:foreground "#aaaaaa")))) - '(context-coloring-level-1-face ((t (:foreground "#bbbbbb"))))) - (context-coloring-define-theme - theme - :colors '("#cccccc" - "#dddddd")) - (context-coloring-test-assert-defined-warning theme) - (context-coloring-test-kill-buffer "*Warnings*") - (enable-theme theme) - (context-coloring-test-assert-defined-warning theme) - (context-coloring-test-assert-face 0 "#cccccc") - (context-coloring-test-assert-face 1 "#dddddd"))) - -(context-coloring-test-deftest-define-theme intentional-override - (lambda (theme) - (context-coloring-test-deftheme theme) (custom-theme-set-faces - theme - '(context-coloring-level-0-face ((t (:foreground "#aaaaaa")))) - '(context-coloring-level-1-face ((t (:foreground "#bbbbbb"))))) - (context-coloring-define-theme - theme - :override t - :colors '("#cccccc" - "#dddddd")) - (context-coloring-test-assert-no-message "*Warnings*") - (enable-theme theme) - (context-coloring-test-assert-no-message "*Warnings*") - (context-coloring-test-assert-face 0 "#cccccc") - (context-coloring-test-assert-face 1 "#dddddd"))) - -(context-coloring-test-deftest-define-theme pre-recede - (lambda (theme) - (context-coloring-define-theme - theme - :recede t - :colors '("#aaaaaa" - "#bbbbbb")) - (context-coloring-test-deftheme theme) - (custom-theme-set-faces - theme - '(context-coloring-level-0-face ((t (:foreground "#cccccc")))) - '(context-coloring-level-1-face ((t (:foreground "#dddddd"))))) - (enable-theme theme) - (context-coloring-test-assert-no-message "*Warnings*") - (context-coloring-test-assert-face 0 "#cccccc") - (context-coloring-test-assert-face 1 "#dddddd"))) - -(context-coloring-test-deftest-define-theme pre-recede-delayed-application - (lambda (theme) - (context-coloring-define-theme - theme - :recede t - :colors '("#aaaaaa" - "#bbbbbb")) - (context-coloring-test-deftheme theme) - (enable-theme theme) - (context-coloring-test-assert-no-message "*Warnings*") - (context-coloring-test-assert-face 0 "#aaaaaa") - (context-coloring-test-assert-face 1 "#bbbbbb"))) - -(context-coloring-test-deftest-define-theme post-recede - (lambda (theme) - (context-coloring-test-deftheme theme) - (custom-theme-set-faces - theme - '(context-coloring-level-0-face ((t (:foreground "#aaaaaa")))) - '(context-coloring-level-1-face ((t (:foreground "#bbbbbb"))))) - (context-coloring-define-theme - theme - :recede t - :colors '("#cccccc" - "#dddddd")) - (context-coloring-test-assert-no-message "*Warnings*") - (context-coloring-test-assert-face 0 "#aaaaaa") - (context-coloring-test-assert-face 1 "#bbbbbb") - (enable-theme theme) - (context-coloring-test-assert-no-message "*Warnings*") - (context-coloring-test-assert-face 0 "#aaaaaa") - (context-coloring-test-assert-face 1 "#bbbbbb"))) - -(context-coloring-test-deftest-define-theme recede-not-defined - (lambda (theme) - (context-coloring-test-deftheme theme) - (custom-theme-set-faces - theme - '(foo-face ((t (:foreground "#ffffff"))))) - (context-coloring-define-theme - theme - :recede t - :colors '("#aaaaaa" - "#bbbbbb")) - (context-coloring-test-assert-no-message "*Warnings*") - (context-coloring-test-assert-face 0 "#aaaaaa") - (context-coloring-test-assert-face 1 "#bbbbbb") - (enable-theme theme) - (context-coloring-test-assert-no-message "*Warnings*") - (context-coloring-test-assert-face 0 "#aaaaaa") - (context-coloring-test-assert-face 1 "#bbbbbb"))) - -(context-coloring-test-deftest-define-theme unintentional-obstinance - (lambda (theme) - (context-coloring-define-theme - theme - :colors '("#aaaaaa" - "#bbbbbb")) - (context-coloring-test-deftheme theme) - (custom-theme-set-faces - theme - '(context-coloring-level-0-face ((t (:foreground "#cccccc")))) - '(context-coloring-level-1-face ((t (:foreground "#dddddd"))))) - (enable-theme theme) - (context-coloring-test-assert-defined-warning theme) - (context-coloring-test-assert-face 0 "#aaaaaa") - (context-coloring-test-assert-face 1 "#bbbbbb"))) - -(context-coloring-test-deftest-define-theme intentional-obstinance - (lambda (theme) - (context-coloring-define-theme - theme - :override t - :colors '("#aaaaaa" - "#bbbbbb")) - (context-coloring-test-deftheme theme) - (custom-theme-set-faces - theme - '(context-coloring-level-0-face ((t (:foreground "#cccccc")))) - '(context-coloring-level-1-face ((t (:foreground "#dddddd"))))) - (enable-theme theme) - (context-coloring-test-assert-no-message "*Warnings*") - (context-coloring-test-assert-face 0 "#aaaaaa") - (context-coloring-test-assert-face 1 "#bbbbbb"))) - -(defun context-coloring-test-assert-maximum-face (maximum &optional negate) - "Assert that `context-coloring-maximum-face' is MAXIMUM, or the -inverse if NEGATE is non-nil." - (when (funcall (if negate #'identity #'not) - (eq context-coloring-maximum-face maximum)) - (ert-fail (format (concat "Expected `context-coloring-maximum-face' " - "%sto be `%s', " - "but it %s.") - (if negate "not " "") maximum - (if negate - "was" - (format "was `%s'" context-coloring-maximum-face)))))) - -(defun context-coloring-test-assert-not-maximum-face (&rest arguments) - "Assert that `context-coloring-maximum-face' is not MAXIMUM. -Apply ARGUMENTS to `context-coloring-test-assert-maximum-face', -see that function." - (apply #'context-coloring-test-assert-maximum-face - (append arguments '(t)))) - -(context-coloring-test-deftest-define-theme disable-cascade - (lambda (theme) - (let ((maximum-face-value 9999)) - (setq context-coloring-maximum-face maximum-face-value) - (context-coloring-test-deftheme theme) - (context-coloring-define-theme - theme - :colors '("#aaaaaa" - "#bbbbbb")) - (let ((second-theme (context-coloring-test-get-next-theme))) - (context-coloring-test-deftheme second-theme) - (context-coloring-define-theme - second-theme - :colors '("#cccccc" - "#dddddd" - "#eeeeee")) - (let ((third-theme (context-coloring-test-get-next-theme))) - (context-coloring-test-deftheme third-theme) - (context-coloring-define-theme - third-theme - :colors '("#111111" - "#222222" - "#333333" - "#444444")) - (enable-theme theme) - (enable-theme second-theme) - (enable-theme third-theme) - (disable-theme third-theme) - (context-coloring-test-assert-face 0 "#cccccc") - (context-coloring-test-assert-face 1 "#dddddd") - (context-coloring-test-assert-face 2 "#eeeeee") - (context-coloring-test-assert-maximum-face 2)) - (disable-theme second-theme) - (context-coloring-test-assert-face 0 "#aaaaaa") - (context-coloring-test-assert-face 1 "#bbbbbb") - (context-coloring-test-assert-maximum-face 1)) - (disable-theme theme) - (context-coloring-test-assert-not-face 0 "#aaaaaa") - (context-coloring-test-assert-not-face 1 "#bbbbbb") - (context-coloring-test-assert-maximum-face - maximum-face-value)))) + 'context-coloring-test-custom-theme + '(context-coloring-level-0-face ((t :foreground "#aaaaaa"))) + '(context-coloring-level-1-face ((t :foreground "#bbbbbb")))) + (custom-set-faces + '(context-coloring-level-0-face ((t :foreground "#aaaaaa")))) + (enable-theme 'context-coloring-test-custom-theme) + (context-coloring-define-dispatch + 'theme + :modes '(context-coloring-test-custom-theme-mode) + :colorizer #'ignore) + (context-coloring-test-custom-theme-mode) + (context-coloring-colorize) + (context-coloring-test-assert-maximum-face 1) + ;; This theme should now be ignored in favor of the `user' theme. + (custom-theme-reset-faces + 'context-coloring-test-custom-theme + '(context-coloring-level-0-face nil) + '(context-coloring-level-1-face nil)) + (context-coloring-colorize) + ;; Maximum face for `user'. + (context-coloring-test-assert-maximum-face 0) + ;; Now `user' should be ignored too. + (custom-reset-faces + '(context-coloring-level-0-face nil)) + (context-coloring-colorize) + ;; Expect the package's defaults. + (context-coloring-test-assert-maximum-face + context-coloring-default-maximum-face)) + :after (lambda () + (custom-reset-faces + '(context-coloring-level-0-face nil)) + (disable-theme 'context-coloring-test-custom-theme))) ;;; Coloring tests @@ -957,7 +480,7 @@ other non-letters are guaranteed to always be discarded." (forward-char))) (setq index (1+ index))))) -(context-coloring-test-deftest-js-js2 function-scopes +(context-coloring-test-deftest-javascript function-scopes (lambda () (context-coloring-test-assert-coloring " 000 0 0 11111111 11 110 @@ -966,14 +489,14 @@ other non-letters are guaranteed to always be discarded." 22222222 122 22 1"))) -(context-coloring-test-deftest-js-js2 global +(context-coloring-test-deftest-javascript global (lambda () (context-coloring-test-assert-coloring " (xxxxxxxx () { 111 1 1 00000001xxx11 }());"))) -(context-coloring-test-deftest-js2 block-scopes +(context-coloring-test-deftest-javascript block-scopes (lambda () (context-coloring-test-assert-coloring " (xxxxxxxx () { @@ -983,11 +506,11 @@ other non-letters are guaranteed to always be discarded." 2 }());")) :before (lambda () - (setq context-coloring-js-block-scopes t)) + (setq context-coloring-javascript-block-scopes t)) :after (lambda () - (setq context-coloring-js-block-scopes nil))) + (setq context-coloring-javascript-block-scopes nil))) -(context-coloring-test-deftest-js-js2 catch +(context-coloring-test-deftest-javascript catch (lambda () (context-coloring-test-assert-coloring " (xxxxxxxx () { @@ -999,7 +522,7 @@ other non-letters are guaranteed to always be discarded." 2 }());"))) -(context-coloring-test-deftest-js-js2 key-names +(context-coloring-test-deftest-javascript key-names (lambda () (context-coloring-test-assert-coloring " (xxxxxxxx () { @@ -1009,7 +532,7 @@ other non-letters are guaranteed to always be discarded." 11 }());"))) -(context-coloring-test-deftest-js-js2 property-lookup +(context-coloring-test-deftest-javascript property-lookup (lambda () (context-coloring-test-assert-coloring " (xxxxxxxx () { @@ -1018,7 +541,7 @@ other non-letters are guaranteed to always be discarded." 00000011111111111 }());"))) -(context-coloring-test-deftest-js-js2 key-values +(context-coloring-test-deftest-javascript key-values (lambda () (context-coloring-test-assert-coloring " (xxxxxxxx () { @@ -1030,7 +553,7 @@ other non-letters are guaranteed to always be discarded." }()); }());"))) -(context-coloring-test-deftest-js-js2 syntactic-comments-and-strings +(context-coloring-test-deftest-javascript syntactic-comments-and-strings (lambda () (context-coloring-test-assert-coloring " 0000 00 @@ -1039,7 +562,7 @@ cccccccccc ssssssssssss0")) :fixture "comments-and-strings.js") -(context-coloring-test-deftest-js-js2 syntactic-comments +(context-coloring-test-deftest-javascript syntactic-comments (lambda () (context-coloring-test-assert-coloring " 0000 00 @@ -1052,7 +575,7 @@ cccccccccc :after (lambda () (setq context-coloring-syntactic-strings t))) -(context-coloring-test-deftest-js-js2 syntactic-strings +(context-coloring-test-deftest-javascript syntactic-strings (lambda () (context-coloring-test-assert-coloring " 0000 00 @@ -1065,7 +588,7 @@ ssssssssssss0")) :after (lambda () (setq context-coloring-syntactic-comments t))) -(context-coloring-test-deftest-js2 unterminated-comment +(context-coloring-test-deftest-javascript unterminated-comment ;; As long as `add-text-properties' doesn't signal an error, this test passes. (lambda ()))