;;; context-coloring-test.el --- Tests for context coloring -*- lexical-binding: t; -*-
-;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
(require 'cl-lib)
(require 'context-coloring)
+(require 'context-coloring-javascript)
+(require 'context-coloring-emacs-lisp)
(require 'ert)
-(require 'js2-mode)
;;; Test running utilities
:mode #'fundamental-mode
:no-fixture t)
+(defun context-coloring-test-js2-mode ()
+ "Enable js2-mode and parse synchronously."
+ (js2-mode)
+ (js2-reparse))
+
(context-coloring-test-define-deftest javascript
- :mode #'js2-mode
+ :mode #'context-coloring-test-js2-mode
:extension "js"
:enable-context-coloring-mode t
:before-each (lambda ()
(context-coloring-test-deftest mode-startup
(lambda ()
- (context-coloring-define-dispatch
+ (puthash
'mode-startup
- :modes '(context-coloring-test-mode-startup-mode)
- :colorizer #'ignore)
+ (list :modes '(context-coloring-test-mode-startup-mode))
+ context-coloring-dispatch-hash-table)
(context-coloring-test-mode-startup-mode)
(context-coloring-test-assert-causes-coloring
(context-coloring-mode)))
(context-coloring-test-deftest change-detection
(lambda ()
- (context-coloring-define-dispatch
+ (puthash
'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)
+ (list :modes '(context-coloring-test-change-detection-mode)
+ :setup #'context-coloring-setup-idle-change-detection
+ :teardown #'context-coloring-teardown-idle-change-detection)
+ context-coloring-dispatch-hash-table)
(context-coloring-test-change-detection-mode)
(context-coloring-mode)
(context-coloring-test-assert-causes-coloring
"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
[?\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
+ (puthash
'disable-mode
- :modes '(context-coloring-test-disable-mode-mode)
- :colorizer #'ignore
- :teardown (lambda ()
- (setq torn-down t)))
+ (list :modes '(context-coloring-test-disable-mode-mode)
+ :teardown (lambda ()
+ (setq torn-down t)))
+ context-coloring-dispatch-hash-table)
(context-coloring-test-disable-mode-mode)
(context-coloring-mode)
(context-coloring-mode -1)
(custom-set-faces
'(context-coloring-level-0-face ((t :foreground "#aaaaaa"))))
(enable-theme 'context-coloring-test-custom-theme)
- (context-coloring-define-dispatch
+ (puthash
'theme
- :modes '(context-coloring-test-custom-theme-mode)
- :colorizer #'ignore)
+ (list :modes '(context-coloring-test-custom-theme-mode))
+ context-coloring-dispatch-hash-table)
(context-coloring-test-custom-theme-mode)
(context-coloring-colorize)
(context-coloring-test-assert-maximum-face 1)
;;; 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")
(lambda ()
(context-coloring-test-assert-coloring "
(xxxxxxxx () {
- 111 1 1 00000001xxx11
+ 111 1 1 0000001xxx11
}());")))
(context-coloring-test-deftest-javascript block-scopes
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 ()
;; 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 "
1111 cc ccccccc
1sss11")))
+(context-coloring-test-deftest-emacs-lisp empty-varlist
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+1111111 1 11
+1111111 111
+
+1111 1cc
+ 11
+1111111 111")))
+
+(context-coloring-test-deftest-emacs-lisp varlist-spacing
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(111 (
+ (1 (222222 ()))))
+
+(111111 ( 1 1 )
+ 1 1)
+
+(111111111 0 ( (1) )
+ 1)")))
+
(context-coloring-test-deftest-emacs-lisp let*
(lambda ()
(context-coloring-test-assert-coloring "
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 macroexp-let2
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+1111 11111
+ 222222222-2222 00000000-00000000-0 2 111
+ 2 11121
+
+(11111111-1111 00000000-00000000-0)
+(11111111-1111)")))
(context-coloring-test-deftest-emacs-lisp cond
(lambda ()