"Assert that the face at POSITION satisfies FACE-REGEXP."
(let ((face (get-text-property position 'face)))
(when (or
- ;; Pass a non-string to do an `eq' check (against a symbol or nil).
+ ;; Pass a non-string to do an `equal' check (against a symbol or nil).
(unless (stringp face-regexp)
- (not (eq face-regexp face)))
+ (not (equal face-regexp face)))
;; Otherwise do the matching.
(when (stringp face-regexp)
(not (string-match-p face-regexp (symbol-name face)))))
(context-coloring-test-assert-position-face
position "\\`font-lock-comment\\(-delimiter\\)?-face\\'"))
+(defun context-coloring-test-assert-position-constant-comment (position)
+ (context-coloring-test-assert-position-face position '(font-lock-constant-face
+ font-lock-comment-face)))
+
(defun context-coloring-test-assert-position-string (position)
(context-coloring-test-assert-position-face position 'font-lock-string-face))
+(defun context-coloring-test-assert-position-nil (position)
+ (context-coloring-test-assert-position-face position nil))
+
(defun context-coloring-test-assert-coloring (map)
"Assert that the current buffer's coloring matches MAP."
;; Omit the superfluous, formatting-related leading newline. Can't use
((= char 59)
(context-coloring-test-assert-position-comment (point))
(forward-char))
+ ;; 'c' = Constant comment
+ ((= char 99)
+ (context-coloring-test-assert-position-constant-comment (point))
+ (forward-char))
+ ;; 'n' = nil
+ ((= char 110)
+ (context-coloring-test-assert-position-nil (point))
+ (forward-char))
;; 's' = String
((= char 115)
(context-coloring-test-assert-position-string (point))
(context-coloring-test-assert-region-face
start end 'font-lock-string-face))
+(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))))
+
(defun context-coloring-test-assert-message (expected buffer)
- "Assert that message EXPECTED exists in BUFFER."
+ "Assert that message EXPECTED is at the end of BUFFER."
(when (null (get-buffer buffer))
(ert-fail
(format
"but the buffer did not have any messages.")
buffer expected)))
(with-current-buffer buffer
- (let ((messages (split-string
- (buffer-substring-no-properties
- (point-min)
- (point-max))
- "\n")))
- (let ((message (car (nthcdr (- (length messages) 2) messages))))
- (when (not (equal message expected))
+ (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' to have message \"%s\", "
- "but instead it was \"%s\"")
- buffer expected
- message)))))))
+ "Expected buffer `%s' not to have message \"%s\", "
+ "but it did")
+ buffer expected)))))))
(defun context-coloring-test-assert-no-message (buffer)
"Assert that BUFFER has no message."
(funcall done)))
(insert " ")
(set-window-buffer (selected-window) (current-buffer))
- (context-coloring-maybe-colorize)))
+ (context-coloring-maybe-colorize (current-buffer))))
(context-coloring-mode))))
(ert-deftest context-coloring-test-check-version ()
"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
:setup (lambda ()
(setq context-coloring-syntactic-strings t)))
-(context-coloring-test-deftest-emacs-lisp-mode unbindable
+(context-coloring-test-deftest-emacs-lisp-mode ignored
(lambda ()
(context-coloring-test-assert-coloring "
(xxxxx x ()
- (x x 1 11 11 111 11 1 111))")))
+ (x x 1 11 11 111 11 1 111 (1 1 1)))")))
(context-coloring-test-deftest-emacs-lisp-mode let
(lambda ()
2222 1 1 2 2 2 000022
1111 1 1 1 0 0 000011")))
+(defun context-coloring-test-insert-unread-space ()
+ (setq unread-command-events (cons '(t . 32)
+ unread-command-events)))
+
+(defun context-coloring-test-remove-faces ()
+ (remove-text-properties (point-min) (point-max) '(face nil)))
+
+(context-coloring-test-deftest-emacs-lisp-mode iteration
+ (lambda ()
+ (let ((context-coloring-emacs-lisp-iterations-per-pause 1))
+ (context-coloring-colorize)
+ (context-coloring-test-assert-coloring "
+;; `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.
+ (context-coloring-test-assert-coloring "
+;; nnnn nnnn
+nnnnnn n nnn")))
+ :setup (lambda ()
+ (setq context-coloring-syntactic-comments t)
+ (setq context-coloring-syntactic-strings t)))
+
(provide 'context-coloring-test)
;;; context-coloring-test.el ends here