X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/b34a45afce1534164683210a8ceaf2923c176f8b..69347627ae1f60a116b3ef04084093df0fe89456:/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 e22ee2987..f643e914c 100644 --- a/packages/context-coloring/test/context-coloring-test.el +++ b/packages/context-coloring/test/context-coloring-test.el @@ -25,8 +25,9 @@ ;;; Code: +(require 'cl-lib) (require 'context-coloring) -(require 'ert-async) +(require 'ert) (require 'js2-mode) @@ -37,170 +38,348 @@ "This file's directory.") (defun context-coloring-test-read-file (path) - "Read a file's contents from PATH into a string." + "Return the file's contents from PATH as a string." (with-temp-buffer (insert-file-contents (expand-file-name path context-coloring-test-path)) (buffer-string))) -(defun context-coloring-test-setup () - "Prepare before all tests." - (setq context-coloring-syntactic-comments nil) - (setq context-coloring-syntactic-strings nil)) - -(defun context-coloring-test-cleanup () - "Cleanup after all tests." - (setq context-coloring-comments-and-strings nil) - (setq context-coloring-js-block-scopes nil) - (setq context-coloring-colorize-hook nil) - (setq context-coloring-check-scopifier-version-hook nil) - (setq context-coloring-maximum-face 7) - (setq context-coloring-original-maximum-face - context-coloring-maximum-face)) - (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 - (unwind-protect - (progn - (context-coloring-test-setup) - (insert (context-coloring-test-read-file ,fixture)) - ,@body) - (context-coloring-test-cleanup)))) - -(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 &optional setup) - "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. An optional SETUP callback can run -arbitrary code before the mode is invoked." - (context-coloring-test-with-temp-buffer-async - (lambda (done-with-temp-buffer) - (context-coloring-test-setup) - (when setup (funcall setup)) - (insert (context-coloring-test-read-file fixture)) - (funcall - callback - (lambda () - (context-coloring-test-cleanup) - (funcall done-with-temp-buffer)))))) + (progn + (insert (context-coloring-test-read-file ,fixture)) + ,@body))) ;;; Test defining utilities -(defun context-coloring-test-js-mode (fixture callback &optional setup) - "Use FIXTURE as the subject matter for test logic in CALLBACK. -Optionally, provide setup code to run before the mode is -instantiated in SETUP." - (context-coloring-test-with-fixture-async - fixture - (lambda (done-with-test) - (js-mode) - (context-coloring-mode) - (context-coloring-colorize - (lambda () - (funcall callback done-with-test)))) - setup)) - -(defmacro context-coloring-test-js2-mode (fixture setup &rest body) - "Use FIXTURE as the subject matter for test logic in BODY." - `(context-coloring-test-with-fixture - ,fixture - (require 'js2-mode) - (setq js2-mode-show-parse-errors nil) - (setq js2-mode-show-strict-warnings nil) - (js2-mode) - (when ,setup (funcall ,setup)) - (context-coloring-mode) - ,@body)) - -(cl-defmacro context-coloring-test-deftest-js-mode (name &key fixture-name) - "Define an asynchronous test for `js-mode' with the name NAME -in the typical format." +(cl-defmacro context-coloring-test-define-deftest (name + &key mode + &key extension + &key no-fixture + &key enable-context-coloring-mode + &key before-each + &key after-each) + "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 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 ((test-name (intern (format "context-coloring-test-js-mode-%s" name))) - (fixture (format "./fixtures/%s.js" (or fixture-name name))) - (function-name (intern-soft - (format "context-coloring-test-js-%s" name))) - (setup-function-name (intern-soft - (format - "context-coloring-test-js-%s-setup" name)))) - `(ert-deftest-async ,test-name (done) - (context-coloring-test-js-mode - ,fixture - (lambda (teardown) - (unwind-protect - (,function-name) - (funcall teardown)) - (funcall done)) - ',setup-function-name)))) - -(cl-defmacro context-coloring-test-deftest-js2-mode (name &key fixture-name) - "Define a test for `js2-mode' with the name NAME in the typical -format." - (declare (indent defun)) - (let ((test-name (intern (format "context-coloring-test-js2-mode-%s" name))) - (fixture (format "./fixtures/%s.js" (or fixture-name name))) - (function-name (intern-soft - (format "context-coloring-test-js-%s" name))) - (setup-function-name (intern-soft - (format - "context-coloring-test-js-%s-setup" name)))) - `(ert-deftest ,test-name () - (context-coloring-test-js2-mode - ,fixture - ',setup-function-name - (,function-name))))) - -(cl-defmacro context-coloring-test-deftest-emacs-lisp-mode (name - body - &key setup) - "Define a test for `emacs-lisp-mode' with name and fixture as -NAME, with BODY containing the assertions, and SETUP defining the -environment." - (declare (indent defun)) - (let ((test-name (intern (format "context-coloring-emacs-lisp-mode-%s" name))) - (fixture (format "./fixtures/%s.el" name))) - `(ert-deftest ,test-name () - (context-coloring-test-with-fixture - ,fixture - (emacs-lisp-mode) - (when ,setup (funcall ,setup)) - (context-coloring-mode) - (funcall ,body))))) + (let ((macro-name (intern (format "context-coloring-test-deftest%s" + (cond + ;; No name means no dash. + ((eq name nil) "") + (t (format "-%s" name))))))) + `(cl-defmacro ,macro-name (name + body + &key fixture + &key before + &key after) + (declare (indent defun)) + ;; Commas in nested backquotes are not evaluated. Binding the variables + ;; here is probably the cleanest workaround. + (let ((mode ,mode) + (before-each ',before-each) + (after-each ',after-each) + (test-name (intern (format ,(format "%s-%%s" + (cond + (name) + (t "generic"))) name))) + (fixture (cond + (fixture (format "./fixtures/%s" fixture)) + (,no-fixture "./fixtures/empty") + (t (format ,(format "./fixtures/%%s.%s" extension) name))))) + ,@`((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 javascript + :mode #'js2-mode + :extension "js" + :enable-context-coloring-mode t + :before-each (lambda () + (setq js2-mode-show-parse-errors nil) + (setq js2-mode-show-strict-warnings nil))) + +(context-coloring-test-define-deftest emacs-lisp + :mode #'emacs-lisp-mode + :extension "el" + :enable-context-coloring-mode t) + +(context-coloring-test-define-deftest eval-expression + :mode #'fundamental-mode + :no-fixture t) ;;; Assertion functions +(defun context-coloring-test-get-last-message () + "Get the last message in the current messages bufffer." + (let ((messages (split-string + (buffer-substring-no-properties + (point-min) + (point-max)) + "\n"))) + (car (nthcdr (- (length messages) 2) messages)))) + +(defun context-coloring-test-assert-message (expected buffer) + "Assert that message EXPECTED is at the end of BUFFER." + (when (null (get-buffer buffer)) + (ert-fail + (format + (concat + "Expected buffer `%s' to have message \"%s\", " + "but the buffer did not have any messages.") + buffer expected))) + (with-current-buffer buffer + (let ((message (context-coloring-test-get-last-message))) + (when (not (equal message expected)) + (ert-fail + (format + (concat + "Expected buffer `%s' to have message \"%s\", " + "but instead it was \"%s\"") + buffer expected + message)))))) + +(defun context-coloring-test-assert-not-message (expected buffer) + "Assert that message EXPECTED is not at the end of BUFFER." + (when (get-buffer buffer) + (with-current-buffer buffer + (let ((message (context-coloring-test-get-last-message))) + (when (equal message expected) + (ert-fail + (format + (concat + "Expected buffer `%s' not to have message \"%s\", " + "but it did") + buffer expected))))))) + +(defun context-coloring-test-assert-error (body error-message) + "Assert that BODY signals ERROR-MESSAGE." + (let ((error-signaled-p nil)) + (condition-case err + (progn + (funcall body)) + (error + (setq error-signaled-p t) + (when (not (string-equal (cadr err) error-message)) + (ert-fail (format (concat "Expected the error \"%s\" to be thrown, " + "but instead it was \"%s\".") + error-message + (cadr err)))))) + (when (not error-signaled-p) + (ert-fail "Expected an error to be thrown, but there wasn't.")))) + + +;;; Miscellaneous tests + +(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) + +(context-coloring-test-deftest change-detection + (lambda () + (context-coloring-define-dispatch + 'idle-change + :modes '(context-coloring-test-change-detection-mode) + :colorizer #'ignore + :setup #'context-coloring-setup-idle-change-detection + :teardown #'context-coloring-teardown-idle-change-detection) + (context-coloring-test-change-detection-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 () + (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 unavailable here" + "*Messages*"))) + +(context-coloring-test-deftest derived-mode + (lambda () + (lisp-interaction-mode) + (context-coloring-mode) + (context-coloring-test-assert-not-message + "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 + (lambda () + (context-coloring-test-assert-error + (lambda () + (context-coloring-define-dispatch + 'define-dispatch-no-modes)) + "No mode or predicate defined for dispatch") + (context-coloring-test-assert-error + (lambda () + (context-coloring-define-dispatch + 'define-dispatch-no-strategy + :modes '(context-coloring-test-define-dispatch-error-mode))) + "No colorizer defined for dispatch"))) + +(context-coloring-test-define-derived-mode disable-mode) + +(context-coloring-test-deftest disable-mode + (lambda () + (let (torn-down) + (context-coloring-define-dispatch + 'disable-mode + :modes '(context-coloring-test-disable-mode-mode) + :colorizer #'ignore + :teardown (lambda () + (setq torn-down t))) + (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 () + (custom-theme-set-faces + '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 + +(defun context-coloring-test-face-to-level (face) + "Convert FACE symbol to its corresponding level, or nil." + (when face + (let* ((face-string (symbol-name face)) + (matches (string-match + context-coloring-level-face-regexp + face-string))) + (when matches + (string-to-number (match-string 1 face-string)))))) + (defun context-coloring-test-assert-position-level (position level) "Assert that POSITION has LEVEL." - (let ((face (get-text-property position 'face)) - actual-level) - (when (not (and face - (let* ((face-string (symbol-name face)) - (matches (string-match - context-coloring-level-face-regexp - face-string))) - (when matches - (setq actual-level (string-to-number - (substring face-string - (match-beginning 1) - (match-end 1)))) - (= level actual-level))))) + (let* ((face (get-text-property position 'face)) + (actual-level (context-coloring-test-face-to-level face))) + (when (not (= level actual-level)) (ert-fail (format (concat "Expected level at position %s, " "which is \"%s\", to be %s; " "but it was %s") @@ -226,21 +405,39 @@ environment." face))))) (defun context-coloring-test-assert-position-comment (position) + "Assert that the face at POSITION is a comment." (context-coloring-test-assert-position-face position "\\`font-lock-comment\\(-delimiter\\)?-face\\'")) (defun context-coloring-test-assert-position-constant-comment (position) + "Assert that the face at POSITION is a constant comment." (context-coloring-test-assert-position-face position '(font-lock-constant-face font-lock-comment-face))) (defun context-coloring-test-assert-position-string (position) + "Assert that the face at POSITION is a string." (context-coloring-test-assert-position-face position 'font-lock-string-face)) (defun context-coloring-test-assert-position-nil (position) + "Assert that the face at POSITION is nil." (context-coloring-test-assert-position-face position nil)) (defun context-coloring-test-assert-coloring (map) - "Assert that the current buffer's coloring matches MAP." + "Assert that the current buffer's coloring will match MAP. + +MAP's newlines should correspond to the current fixture. + +The following characters appearing in MAP assert coloring for +corresponding points in the fixture: + +0-9: Level equals number. +C: Face is constant comment. +c: Face is comment. +n: Face is nil. +s: Face is string. + +Any other characters are discarded. Characters \"x\" and any +other non-letters are guaranteed to always be discarded." ;; Omit the superfluous, formatting-related leading newline. Can't use ;; `save-excursion' here because if an assertion fails it will cause future ;; tests to get messed up. @@ -255,7 +452,7 @@ environment." (cond ;; Newline ((= char 10) - (next-logical-line) + (forward-line) (beginning-of-line)) ;; Number ((and (>= char 48) @@ -263,13 +460,13 @@ environment." (context-coloring-test-assert-position-level (point) (string-to-number char-string)) (forward-char)) - ;; ';' = Comment - ((= char 59) - (context-coloring-test-assert-position-comment (point)) + ;; 'C' = Constant comment + ((= char 67) + (context-coloring-test-assert-position-constant-comment (point)) (forward-char)) - ;; 'c' = Constant comment + ;; 'c' = Comment ((= char 99) - (context-coloring-test-assert-position-constant-comment (point)) + (context-coloring-test-assert-position-comment (point)) (forward-char)) ;; 'n' = nil ((= char 110) @@ -283,850 +480,182 @@ environment." (forward-char))) (setq index (1+ index))))) -(defmacro context-coloring-test-assert-region (&rest body) - "Assert something about the face of points in a region. -Provides the free variables `i', `length', `point', `face' and -`actual-level' to the code in BODY." - `(let ((i 0) - (length (- end start))) - (while (< i length) - (let* ((point (+ i start)) - (face (get-text-property point 'face))) - ,@body) - (setq i (+ i 1))))) - -(defun context-coloring-test-assert-region-level (start end level) - "Assert that all points in the range [START, END) are of level -LEVEL." - (context-coloring-test-assert-region - (let (actual-level) - (when (not (when face - (let* ((face-string (symbol-name face)) - (matches (string-match - context-coloring-level-face-regexp - face-string))) - (when matches - (setq actual-level (string-to-number - (substring face-string - (match-beginning 1) - (match-end 1)))) - (= level actual-level))))) - (ert-fail (format (concat "Expected level in region [%s, %s), " - "which is \"%s\", to be %s; " - "but at point %s, it was %s") - start end - (buffer-substring-no-properties start end) level - point actual-level)))))) - -(defun context-coloring-test-assert-region-face (start end expected-face) - "Assert that all points in the range [START, END) have the face -EXPECTED-FACE." - (context-coloring-test-assert-region - (when (not (eq face expected-face)) - (ert-fail (format (concat "Expected face in region [%s, %s), " - "which is \"%s\", to be %s; " - "but at point %s, it was %s") - start end - (buffer-substring-no-properties start end) expected-face - point face))))) - -(defun context-coloring-test-assert-region-comment-delimiter (start end) - "Assert that all points in the range [START, END) have -`font-lock-comment-delimiter-face'." - (context-coloring-test-assert-region-face - start end 'font-lock-comment-delimiter-face)) - -(defun context-coloring-test-assert-region-comment (start end) - "Assert that all points in the range [START, END) have -`font-lock-comment-face'." - (context-coloring-test-assert-region-face - start end 'font-lock-comment-face)) - -(defun context-coloring-test-assert-region-string (start end) - "Assert that all points in the range [START, END) have -`font-lock-string-face'." - (context-coloring-test-assert-region-face - start end 'font-lock-string-face)) +(context-coloring-test-deftest-javascript function-scopes + (lambda () + (context-coloring-test-assert-coloring " +000 0 0 11111111 11 110 +11111111 011 1 + 111 1 1 22222222 22 221 + 22222222 122 22 +1"))) -(defun context-coloring-test-get-last-message () - (let ((messages (split-string - (buffer-substring-no-properties - (point-min) - (point-max)) - "\n"))) - (car (nthcdr (- (length messages) 2) messages)))) +(context-coloring-test-deftest-javascript global + (lambda () + (context-coloring-test-assert-coloring " +(xxxxxxxx () { + 111 1 1 0000001xxx11 +}());"))) -(defun context-coloring-test-assert-message (expected buffer) - "Assert that message EXPECTED is at the end of BUFFER." - (when (null (get-buffer buffer)) - (ert-fail - (format - (concat - "Expected buffer `%s' to have message \"%s\", " - "but the buffer did not have any messages.") - buffer expected))) - (with-current-buffer buffer - (let ((message (context-coloring-test-get-last-message))) - (when (not (equal message expected)) - (ert-fail - (format - (concat - "Expected buffer `%s' to have message \"%s\", " - "but instead it was \"%s\"") - buffer expected - message)))))) +(context-coloring-test-deftest-javascript block-scopes + (lambda () + (context-coloring-test-assert-coloring " +(xxxxxxxx () { + 11 111 2 + 222 12 + 222 22 + 22222 12 + 2 +}()); + +(xxxxxxxx () { + 'xxx xxxxxx'; + 11 111 2 + 222 12 + 222 22 + 22222 22 + 2 +}());")) + :before (lambda () + (setq context-coloring-javascript-block-scopes t)) + :after (lambda () + (setq context-coloring-javascript-block-scopes nil))) + +(context-coloring-test-deftest-javascript catch + (lambda () + (context-coloring-test-assert-coloring " +(xxxxxxxx () { + 111 11 22222 222 2 + 222 1 2 22 + 222 22 33333 333 3 + 333 1 3 33 + 3 + 2 +}());"))) + +(context-coloring-test-deftest-javascript key-names + (lambda () + (context-coloring-test-assert-coloring " +(xxxxxxxx () { + 111111 1 + 11 11 + 1 1 1 + 11 +}());"))) + +(context-coloring-test-deftest-javascript property-lookup + (lambda () + (context-coloring-test-assert-coloring " +(xxxxxxxx () { + 0000001111111 + 0000001 111111 + 00000011111111111 +}());"))) -(defun context-coloring-test-assert-not-message (expected buffer) - "Assert that message EXPECTED is not at the end of BUFFER." - (when (get-buffer buffer) - (with-current-buffer buffer - (let ((message (context-coloring-test-get-last-message))) - (when (equal message expected) - (ert-fail - (format - (concat - "Expected buffer `%s' not to have message \"%s\", " - "but it did") - buffer expected))))))) +(context-coloring-test-deftest-javascript key-values + (lambda () + (context-coloring-test-assert-coloring " +(xxxxxxxx () { + xxx x; + (xxxxxxxx () { + xxxxxx { + x: 1 + }; + }()); +}());"))) + +(context-coloring-test-deftest-javascript syntactic-comments-and-strings + (lambda () + (context-coloring-test-assert-coloring " +0000 00 +ccccccc +cccccccccc +ssssssssssss0")) + :fixture "comments-and-strings.js") -(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-kill-buffer (buffer) - "Kill BUFFER if it exists." - (when (get-buffer buffer) (kill-buffer buffer))) - -(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)))) +(context-coloring-test-deftest-javascript syntactic-comments + (lambda () + (context-coloring-test-assert-coloring " +0000 00 +ccccccc +cccccccccc +0000000000000")) + :fixture "comments-and-strings.js" + :before (lambda () + (setq context-coloring-syntactic-strings nil)) + :after (lambda () + (setq context-coloring-syntactic-strings t))) -(defun context-coloring-test-assert-error (body error-message) - "Assert that BODY signals ERROR-MESSAGE." - (let ((error-signaled-p nil)) - (condition-case err - (progn - (funcall body)) - (error - (setq error-signaled-p t) - (when (not (string-equal (cadr err) error-message)) - (ert-fail (format (concat "Expected the error \"%s\" to be thrown, " - "but instead it was \"%s\".") - error-message - (cadr err)))))) - (when (not error-signaled-p) - (ert-fail "Expected an error to be thrown, but there wasn't.")))) +(context-coloring-test-deftest-javascript syntactic-strings + (lambda () + (context-coloring-test-assert-coloring " +0000 00 +0000000 +0000000000 +ssssssssssss0")) + :fixture "comments-and-strings.js" + :before (lambda () + (setq context-coloring-syntactic-comments nil)) + :after (lambda () + (setq context-coloring-syntactic-comments t))) -(defun context-coloring-test-assert-trimmed (result expected) - (when (not (string-equal result expected)) - (ert-fail "Expected string to be trimmed, but it wasn't."))) - - -;;; The tests - -(ert-deftest context-coloring-test-trim () - (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")) - -(ert-deftest-async context-coloring-test-async-mode-startup (done) - (context-coloring-test-with-fixture-async - "./fixtures/empty" - (lambda (teardown) - (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 teardown) - (funcall done))) - (context-coloring-mode)))) - -(define-derived-mode - context-coloring-change-detection-mode - fundamental-mode - "Testing" - "Prevent `context-coloring-test-change-detection' from - having any unintentional side-effects on mode support.") - -;; 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. -(ert-deftest-async context-coloring-test-change-detection (done) - (context-coloring-define-dispatch - 'idle-change - :modes '(context-coloring-change-detection-mode) - :executable "node" - :command "node test/binaries/noop") - (context-coloring-test-with-fixture-async - "./fixtures/empty" - (lambda (teardown) - (context-coloring-change-detection-mode) - (add-hook - 'context-coloring-colorize-hook - (lambda () - (setq context-coloring-colorize-hook nil) - (add-hook - 'context-coloring-colorize-hook - (lambda () - (funcall teardown) - (funcall done))) - (insert " ") - (set-window-buffer (selected-window) (current-buffer)) - (context-coloring-maybe-colorize (current-buffer)))) - (context-coloring-mode)))) - -(ert-deftest context-coloring-test-check-version () - (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."))) - -(ert-deftest context-coloring-test-unsupported-mode () - (context-coloring-test-with-fixture - "./fixtures/empty" - (context-coloring-mode) - (context-coloring-test-assert-message - "Context coloring is not available for this major mode" - "*Messages*"))) - -(ert-deftest context-coloring-test-derived-mode () - (context-coloring-test-with-fixture - "./fixtures/empty" - (lisp-interaction-mode) - (context-coloring-mode) - (context-coloring-test-assert-not-message - "Context coloring is not available for this major mode" - "*Messages*"))) - -(define-derived-mode - context-coloring-test-define-dispatch-error-mode - fundamental-mode - "Testing" - "Prevent `context-coloring-test-define-dispatch-error' from - having any unintentional side-effects on mode support.") - -(ert-deftest context-coloring-test-define-dispatch-error () - (context-coloring-test-assert-error - (lambda () - (context-coloring-define-dispatch - 'define-dispatch-no-modes)) - "No mode defined for dispatch") - (context-coloring-test-assert-error - (lambda () - (context-coloring-define-dispatch - 'define-dispatch-no-strategy - :modes '(context-coloring-test-define-dispatch-error-mode))) - "No colorizer, scopifier or command defined for dispatch")) - -(define-derived-mode - context-coloring-test-define-dispatch-scopifier-mode - fundamental-mode - "Testing" - "Prevent `context-coloring-test-define-dispatch-scopifier' from - having any unintentional side-effects on mode support.") - -(ert-deftest context-coloring-test-define-dispatch-scopifier () - (context-coloring-define-dispatch - 'define-dispatch-scopifier - :modes '(context-coloring-test-define-dispatch-scopifier-mode) - :scopifier (lambda () (vector))) - (with-temp-buffer - (context-coloring-test-define-dispatch-scopifier-mode) - (context-coloring-mode) - (context-coloring-colorize))) - -(define-derived-mode - context-coloring-test-missing-executable-mode - fundamental-mode - "Testing" - "Prevent `context-coloring-test-define-dispatch-scopifier' from - having any unintentional side-effects on mode support.") - -(ert-deftest context-coloring-test-missing-executable () - (context-coloring-define-dispatch - 'scopifier - :modes '(context-coloring-test-missing-executable-mode) - :command "" - :executable "__should_not_exist__") - (with-temp-buffer - (context-coloring-test-missing-executable-mode) - (context-coloring-mode))) - -(define-derived-mode - context-coloring-test-unsupported-version-mode - fundamental-mode - "Testing" - "Prevent `context-coloring-test-unsupported-version' from - having any unintentional side-effects on mode support.") - -(ert-deftest-async context-coloring-test-unsupported-version (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-with-fixture-async - "./fixtures/empty" - (lambda (teardown) - (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 teardown)) - (funcall done))) - (context-coloring-mode)))) - -(define-derived-mode - context-coloring-test-disable-mode-mode - fundamental-mode - "Testing" - "Prevent `context-coloring-test-disable-mode' from having any - unintentional side-effects on mode support.") - -(ert-deftest-async context-coloring-test-disable-mode (done) - (let (torn-down) - (context-coloring-define-dispatch - 'disable-mode - :modes '(context-coloring-test-disable-mode-mode) - :executable "node" - :command "node test/binaries/noop" - :teardown (lambda () - (setq torn-down t))) - (context-coloring-test-with-fixture-async - "./fixtures/empty" - (lambda (teardown) - (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 teardown)) - (funcall done))))) - -(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-theme-originally-set-p - (settings &optional negate) - "Assert that `context-coloring-theme-originally-set-p' returns -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)))) - -(ert-deftest context-coloring-test-theme-originally-set-p () - (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)))) - -(ert-deftest context-coloring-test-theme-highest-level () - (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) - ) - -(defmacro context-coloring-test-deftest-define-theme (name &rest body) - "Define a test with name NAME and an automatically-generated -theme symbol available as a free variable `theme'. Side-effects -from enabling themes are reversed after BODY is executed and the -test completes." - (declare (indent defun)) - (let ((deftest-name (intern - (format "context-coloring-test-define-theme-%s" name)))) - `(ert-deftest ,deftest-name () - (context-coloring-test-kill-buffer "*Warnings*") - (context-coloring-test-setup) - (let ((theme (context-coloring-test-get-next-theme))) - (unwind-protect - (progn - ,@body) - ;; Always cleanup. - (disable-theme theme) - (context-coloring-test-cleanup)))))) - -(defun context-coloring-test-deftheme (theme) - "Dynamically define theme THEME." - (eval (macroexpand `(deftheme ,theme)))) - -(context-coloring-test-deftest-define-theme additive - (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 - (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 - (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 - (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 - (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 - (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 - (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 - (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 - (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 - (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))) - -(defun context-coloring-test-js-function-scopes () - "Test fixtures/functions-scopes.js." - (context-coloring-test-assert-region-level 1 9 0) - (context-coloring-test-assert-region-level 9 23 1) - (context-coloring-test-assert-region-level 23 25 0) - (context-coloring-test-assert-region-level 25 34 1) - (context-coloring-test-assert-region-level 34 35 0) - (context-coloring-test-assert-region-level 35 52 1) - (context-coloring-test-assert-region-level 52 66 2) - (context-coloring-test-assert-region-level 66 72 1) - (context-coloring-test-assert-region-level 72 81 2) - (context-coloring-test-assert-region-level 81 82 1) - (context-coloring-test-assert-region-level 82 87 2) - (context-coloring-test-assert-region-level 87 89 1)) - -(context-coloring-test-deftest-js-mode function-scopes) -(context-coloring-test-deftest-js2-mode function-scopes) - -(defun context-coloring-test-js-global () - "Test fixtures/global.js." - (context-coloring-test-assert-region-level 20 28 1) - (context-coloring-test-assert-region-level 28 35 0) - (context-coloring-test-assert-region-level 35 41 1)) - -(context-coloring-test-deftest-js-mode global) -(context-coloring-test-deftest-js2-mode global) - -(defun context-coloring-test-js-block-scopes () - "Test fixtures/block-scopes.js." - (context-coloring-test-assert-region-level 20 64 1) - (setq context-coloring-js-block-scopes t) - (context-coloring-colorize) - (context-coloring-test-assert-region-level 20 27 1) - (context-coloring-test-assert-region-level 27 41 2) - (context-coloring-test-assert-region-level 41 42 1) - (context-coloring-test-assert-region-level 42 64 2)) - -(context-coloring-test-deftest-js2-mode block-scopes) - -(defun context-coloring-test-js-catch () - "Test fixtures/js-catch.js." - (context-coloring-test-assert-region-level 20 27 1) - (context-coloring-test-assert-region-level 27 51 2) - (context-coloring-test-assert-region-level 51 52 1) - (context-coloring-test-assert-region-level 52 73 2) - (context-coloring-test-assert-region-level 73 101 3) - (context-coloring-test-assert-region-level 101 102 1) - (context-coloring-test-assert-region-level 102 117 3) - (context-coloring-test-assert-region-level 117 123 2)) - -(context-coloring-test-deftest-js-mode catch) -(context-coloring-test-deftest-js2-mode catch) - -(defun context-coloring-test-js-key-names () - "Test fixtures/key-names.js." - (context-coloring-test-assert-region-level 20 63 1)) - -(context-coloring-test-deftest-js-mode key-names) -(context-coloring-test-deftest-js2-mode key-names) - -(defun context-coloring-test-js-property-lookup () - "Test fixtures/property-lookup.js." - (context-coloring-test-assert-region-level 20 26 0) - (context-coloring-test-assert-region-level 26 38 1) - (context-coloring-test-assert-region-level 38 44 0) - (context-coloring-test-assert-region-level 44 52 1) - (context-coloring-test-assert-region-level 57 63 0) - (context-coloring-test-assert-region-level 63 74 1)) - -(context-coloring-test-deftest-js-mode property-lookup) -(context-coloring-test-deftest-js2-mode property-lookup) - -(defun context-coloring-test-js-key-values () - "Test fixtures/key-values.js." - (context-coloring-test-assert-region-level 78 79 1)) - -(context-coloring-test-deftest-js-mode key-values) -(context-coloring-test-deftest-js2-mode key-values) - -(defun context-coloring-test-js-syntactic-comments-and-strings () - "Test comments and strings." - (context-coloring-test-assert-region-level 1 8 0) - (context-coloring-test-assert-region-comment-delimiter 9 12) - (context-coloring-test-assert-region-comment 12 16) - (context-coloring-test-assert-region-comment-delimiter 17 20) - (context-coloring-test-assert-region-comment 20 27) - (context-coloring-test-assert-region-string 28 40) - (context-coloring-test-assert-region-level 40 41 0)) - -(defun context-coloring-test-js-syntactic-comments-and-strings-setup () - (setq context-coloring-syntactic-comments t) - (setq context-coloring-syntactic-strings t)) - -(context-coloring-test-deftest-js-mode syntactic-comments-and-strings - :fixture-name comments-and-strings) -(context-coloring-test-deftest-js2-mode syntactic-comments-and-strings - :fixture-name comments-and-strings) - -(defalias 'context-coloring-test-js-comments-and-strings - 'context-coloring-test-js-syntactic-comments-and-strings - "Test comments and strings. Deprecated.") - -(defun context-coloring-test-js-comments-and-strings-setup () - "Setup comments and strings. Deprecated." - (setq context-coloring-comments-and-strings t)) - -(context-coloring-test-deftest-js-mode comments-and-strings) -(context-coloring-test-deftest-js2-mode comments-and-strings) - -(defun context-coloring-test-js-syntactic-comments () - "Test syntactic comments." - (context-coloring-test-assert-region-level 1 8 0) - (context-coloring-test-assert-region-comment-delimiter 9 12) - (context-coloring-test-assert-region-comment 12 16) - (context-coloring-test-assert-region-comment-delimiter 17 20) - (context-coloring-test-assert-region-comment 20 27) - (context-coloring-test-assert-region-level 28 41 0)) - -(defun context-coloring-test-js-syntactic-comments-setup () - "Setup syntactic comments." - (setq context-coloring-syntactic-comments t)) - -(context-coloring-test-deftest-js-mode syntactic-comments - :fixture-name comments-and-strings) -(context-coloring-test-deftest-js2-mode syntactic-comments - :fixture-name comments-and-strings) - -(defun context-coloring-test-js-syntactic-strings () - "Test syntactic strings." - (context-coloring-test-assert-region-level 1 28 0) - (context-coloring-test-assert-region-string 28 40) - (context-coloring-test-assert-region-level 40 41 0)) - -(defun context-coloring-test-js-syntactic-strings-setup () - "Setup syntactic strings." - (setq context-coloring-syntactic-strings t)) - -(context-coloring-test-deftest-js-mode syntactic-strings - :fixture-name comments-and-strings) -(context-coloring-test-deftest-js2-mode syntactic-strings - :fixture-name comments-and-strings) - -;; As long as `add-text-properties' doesn't signal an error, this test passes. -(defun context-coloring-test-js-unterminated-comment () - "Test unterminated multiline comments.") - -(context-coloring-test-deftest-js2-mode unterminated-comment) - -(context-coloring-test-deftest-emacs-lisp-mode defun +(context-coloring-test-deftest-javascript unterminated-comment + ;; As long as `add-text-properties' doesn't signal an error, this test passes. + (lambda ())) + +(defun context-coloring-test-assert-javascript-elevated-level () + "Assert that the \"initial-level.js\" file has elevated scope." + (context-coloring-test-assert-coloring " + +111 1 1 0000001xxx11")) + +(defun context-coloring-test-assert-javascript-global-level () + "Assert that the \"initial-level.js\" file has global scope." + (context-coloring-test-assert-coloring " + +000 0 0 0000000xxx00")) + +(context-coloring-test-deftest-javascript initial-level + (lambda () + (context-coloring-test-assert-javascript-elevated-level)) + :fixture "initial-level.js" + :before (lambda () + (setq context-coloring-initial-level 1)) + :after (lambda () + (setq context-coloring-initial-level 0))) + +(defun context-coloring-test-setup-top-level-scope (string) + "Make STRING the first line and colorize again." + (goto-char (point-min)) + (kill-whole-line 0) + (insert string) + ;; Reparsing triggers recoloring. + (js2-reparse)) + +(context-coloring-test-deftest-javascript top-level-scope + (lambda () + (let ((positive-indicators + (list "#!/usr/bin/env node" + "/*jslint node: true */" + "// jshint node: true" + "/*eslint-env node */" + "module.exports" + "module.exports.a" + "exports.a" + "require('a')")) + (negative-indicators + (list "// Blah blah jshint blah." + "module" + "exports" + "var require; require('a')"))) + (dolist (indicator positive-indicators) + (context-coloring-test-setup-top-level-scope indicator) + (context-coloring-test-assert-javascript-elevated-level)) + (dolist (indicator negative-indicators) + (context-coloring-test-setup-top-level-scope indicator) + (context-coloring-test-assert-javascript-global-level)))) + :fixture "initial-level.js") + +(context-coloring-test-deftest-emacs-lisp defun (lambda () (context-coloring-test-assert-coloring " 111111 000 1111 111 111111111 1111 @@ -1135,48 +664,77 @@ see that function." 0000 0 0 00 111111 01 -111111 111"))) +111111 111 +111111 0 1sss11"))) -(context-coloring-test-deftest-emacs-lisp-mode lambda +(context-coloring-test-deftest-emacs-lisp defadvice + (lambda () + (context-coloring-test-assert-coloring " +1111111111 0 1111111 111111 11111 111 111111111 + 2222 222 122 + 22 1 2221"))) + +(context-coloring-test-deftest-emacs-lisp lambda (lambda () (context-coloring-test-assert-coloring " 00000000 1111111 1111 11111111 11 2222222 2222 222 22 12 2221 111 0 00"))) -(context-coloring-test-deftest-emacs-lisp-mode quote +(context-coloring-test-deftest-emacs-lisp quote (lambda () (context-coloring-test-assert-coloring " +(xxxxx 0000000 00 00000) +(xxx () (xxxxxxxxx (,0000))) + (xxxxx x (x) (xx (xx x 111 111111 1 111 111 - 111111 1 1111111111 11 111 1 111 1 00001 10000 11 00001 1 100001111"))) + 111111 1 1111111111 11 111 1 111 1 00001 10000 11 00001 1 10000 + sss ccc + 1111 + +(xxxxxx '(sss cc + sss cc + )) -(context-coloring-test-deftest-emacs-lisp-mode comment +(xxxxxx () 111111 11111)"))) + +(context-coloring-test-deftest-emacs-lisp splice + (lambda () + (context-coloring-test-assert-coloring " +(xxxxxx () + 111111 00001 100001)"))) + +(context-coloring-test-deftest-emacs-lisp comment (lambda () ;; Just check that the comment isn't parsed syntactically. (context-coloring-test-assert-coloring " (xxxxx x () - (xx (x xxxxx-xxxx xx) ;;;;;;;;;; - 11 00000-0000 11))) ;;;;;;;;;;")) - :setup (lambda () - (setq context-coloring-syntactic-comments t))) + (xx (x xxxxx-xxxx xx) cccccccccc + 11 00000-0000 11))) cccccccccc"))) -(context-coloring-test-deftest-emacs-lisp-mode string +(context-coloring-test-deftest-emacs-lisp string (lambda () (context-coloring-test-assert-coloring " (xxxxx x (x) - (xxxxxx x x sss 1 0 sssss 0 1 sssssss11")) - :setup (lambda () - (setq context-coloring-syntactic-strings t))) + (xxxxxx x x sss 1 0 sssss 0 1 sssssss11"))) -(context-coloring-test-deftest-emacs-lisp-mode ignored +(context-coloring-test-deftest-emacs-lisp ignored (lambda () (context-coloring-test-assert-coloring " (xxxxx x () - (x x 1 11 11 111 11 1 111 (1 1 1)))"))) + (x x 1 11 11 111 111 11 11 11 1 111 (1 1 1)))"))) + +(context-coloring-test-deftest-emacs-lisp sexp + (lambda () + (context-coloring-test-assert-coloring " +(xxx () + `,@sss + `,@11 + `,@11)"))) -(context-coloring-test-deftest-emacs-lisp-mode let +(context-coloring-test-deftest-emacs-lisp let (lambda () (context-coloring-test-assert-coloring " 1111 11 @@ -1186,9 +744,12 @@ see that function." 22 02 22 000022 2222 2 2 2 00002211 - 1111 1 1 1 000011"))) + 1111 1 1 1 000011 -(context-coloring-test-deftest-emacs-lisp-mode let* +1111 cc ccccccc + 1sss11"))) + +(context-coloring-test-deftest-emacs-lisp let* (lambda () (context-coloring-test-assert-coloring " 11111 11 @@ -1201,33 +762,120 @@ see that function." 22 02 22 222 2222 1 1 2 2 2 000022 - 1111 1 1 1 0 0 000011"))) + 1111 1 1 1 0 0 000011")) + :fixture "let-star.el") + +(context-coloring-test-deftest-emacs-lisp cond + (lambda () + (context-coloring-test-assert-coloring " +(xxx (x) + 11111 + 11 11 + 10000 11 + 1111 1 00001 11 + 11 11111 1 000011 + cc c + sss1)"))) + +(context-coloring-test-deftest-emacs-lisp condition-case + (lambda () + (context-coloring-test-assert-coloring " +1111111111-1111 111 + 111111 000 00001 + 111111 111 00001 + 1111111 111111 111 000011 + +(111111111-1111-111111-11111 111 + cc c + (xxx () 222) + (11111 (xxx () 222)) + sss)"))) + +(context-coloring-test-deftest-emacs-lisp dolist + (lambda () + (context-coloring-test-assert-coloring " +1111111 111111 + 2222222 2222 1111 2222222 + 3333333 33 33 222 1111 2222223321"))) (defun context-coloring-test-insert-unread-space () + "Simulate the insertion of a space as if by a user." (setq unread-command-events (cons '(t . 32) unread-command-events))) (defun context-coloring-test-remove-faces () + "Remove all faces in the current buffer." (remove-text-properties (point-min) (point-max) '(face nil))) -(context-coloring-test-deftest-emacs-lisp-mode iteration +(context-coloring-test-deftest-emacs-lisp iteration (lambda () - (let ((context-coloring-emacs-lisp-iterations-per-pause 1)) + (let ((context-coloring-elisp-sexps-per-pause 2)) (context-coloring-colorize) (context-coloring-test-assert-coloring " -;; `cc' `cc' +cc `CC' `CC' (xxxxx x ())") (context-coloring-test-remove-faces) (context-coloring-test-insert-unread-space) (context-coloring-colorize) - ;; The first iteration will color the first part of the comment, but - ;; that's it. Then it will be interrupted. + ;; Coloring is interrupted after the first "sexp" (the comment in this + ;; case). (context-coloring-test-assert-coloring " -;; nnnn nnnn -nnnnnn n nnn"))) - :setup (lambda () - (setq context-coloring-syntactic-comments t) - (setq context-coloring-syntactic-strings t))) +cc `CC' `CC' +nnnnnn n nnn")))) + +(context-coloring-test-deftest-emacs-lisp changed + (lambda () + (context-coloring-test-remove-faces) + ;; Goto line 3. + (goto-char (point-min)) + (forward-line (1- 3)) + (insert " ") + ;; Mock `pos-visible-in-window-p' because in batch mode `get-buffer-window' + ;; returns nil. Emacs must not have a window in that environment. + (cl-letf (((symbol-function 'pos-visible-in-window-p) + (let ((calls 0)) + (lambda () + (prog1 + ;; First and third calls start from center. Second and + ;; fourth calls are made immediately after moving past + ;; the first defun in either direction "off screen". + (cond + ((= calls 0) t) + ((= calls 1) nil) + ((= calls 2) t) + ((= calls 4) nil)) + (setq calls (1+ calls))))))) + (context-coloring-colorize)) + (context-coloring-test-assert-coloring " +nnnn n nnn nnnnnnnn +0000 + +0000 +nnnnn n nnn nnnnnnnn"))) + +(context-coloring-test-deftest-emacs-lisp unbalanced-parenthesis + (lambda () + (context-coloring-test-assert-coloring " +1111 111 +nnnn nn"))) + +(context-coloring-test-deftest-eval-expression let + (lambda () + (minibuffer-with-setup-hook + (lambda () + ;; Perform the test in a hook as it's the only way I know of examining + ;; the minibuffer's contents. The contents are implicitly submitted, + ;; so we have to ignore the errors in the arbitrary test subject code. + (insert "(ignore-errors (let (a) (message a free)))") + (context-coloring-colorize) + (context-coloring-test-assert-coloring " +xxxx: 0000000-000000 1111 111 11111111 1 0000110")) + ;; Simulate user input because `call-interactively' is blocking and + ;; doesn't seem to run the hook. + (execute-kbd-macro + (vconcat + [?\C-u] ;; Don't output the result of the arbitrary test subject code. + [?\M-:]))))) (provide 'context-coloring-test)