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

   1 ;; -*- lexical-binding: t; -*-
   2
   3 (defconst context-coloring-test-path
   4   (file-name-directory (or load-file-name buffer-file-name)))
   5
   6 (defun context-coloring-test-resolve-path (path)
   7   (expand-file-name path context-coloring-test-path))
   8
   9 (defun get-string-from-file (path)
  10   (with-temp-buffer
  11     (insert-file-contents path)
  12     (buffer-string)))
  13
  14 (defun context-coloring-test-read-file (path)
  15   (get-string-from-file (context-coloring-test-resolve-path path)))
  16
  17 (defun context-coloring-test-setup ()
  18   (setq context-coloring-comments-and-strings nil))
  19
  20 (defun context-coloring-test-cleanup ()
  21   (setq context-coloring-comments-and-strings t)
  22   (setq context-coloring-after-colorize-hook nil)
  23   (setq context-coloring-js-block-scopes nil))
  24
  25 (defmacro context-coloring-test-with-fixture (fixture &rest body)
  26   "Evaluate BODY in a temporary buffer with the relative
  27 FIXTURE."
  28   `(with-temp-buffer
  29      (unwind-protect
  30          (progn
  31            (context-coloring-test-setup)
  32            (insert (context-coloring-test-read-file ,fixture))
  33            ,@body)
  34        (context-coloring-test-cleanup))))
  35
  36 (defun context-coloring-test-with-temp-buffer-async (callback)
  37   "Create a temporary buffer, and evaluate CALLBACK there. A
  38 teardown callback is passed to CALLBACK for it to invoke when it
  39 is done."
  40   (let ((temp-buffer (make-symbol "temp-buffer")))
  41     (let ((previous-buffer (current-buffer))
  42           (temp-buffer (generate-new-buffer " *temp*")))
  43       (set-buffer temp-buffer)
  44       (funcall
  45        callback
  46        (lambda ()
  47          (and (buffer-name temp-buffer)
  48               (kill-buffer temp-buffer))
  49          (set-buffer previous-buffer))))))
  50
  51 (defun context-coloring-test-with-fixture-async (fixture callback &optional setup)
  52   "Evaluate CALLBACK in a temporary buffer with the relative
  53 FIXTURE. A teardown callback is passed to CALLBACK for it to
  54 invoke when it is done. An optional SETUP callback can be passed
  55 to run arbitrary code before the mode is invoked."
  56   (context-coloring-test-with-temp-buffer-async
  57    (lambda (done-with-temp-buffer)
  58      (context-coloring-test-setup)
  59      (if setup (funcall setup))
  60      (insert (context-coloring-test-read-file fixture))
  61      (funcall
  62       callback
  63       (lambda ()
  64         (context-coloring-test-cleanup)
  65         (funcall done-with-temp-buffer))))))
  66
  67 (defun context-coloring-test-js-mode (fixture callback &optional setup)
  68   (context-coloring-test-with-fixture-async
  69    fixture
  70    (lambda (done-with-test)
  71      (js-mode)
  72      (context-coloring-mode)
  73      (context-coloring-colorize
  74       (lambda ()
  75         (funcall callback done-with-test))))
  76    setup))
  77
  78 (defmacro context-coloring-test-js2-mode (fixture &rest body)
  79   `(context-coloring-test-with-fixture
  80     ,fixture
  81     (require 'js2-mode)
  82     (setq js2-mode-show-parse-errors nil)
  83     (setq js2-mode-show-strict-warnings nil)
  84     (js2-mode)
  85     (context-coloring-mode)
  86     ,@body))
  87
  88 (defmacro context-coloring-test-assert-region (&rest body)
  89   `(let ((i 0)
  90          (length (- end start)))
  91      (while (< i length)
  92        (let* ((point (+ i start))
  93               (face (get-text-property point 'face))
  94               actual-level)
  95          ,@body)
  96        (setq i (+ i 1)))))
  97
  98 (defconst context-coloring-test-level-regexp
  99   "context-coloring-level-\\([[:digit:]]+\\)-face")
 100
 101 (defun context-coloring-test-assert-region-level (start end level)
 102   (context-coloring-test-assert-region
 103    (when (not (when face
 104                 (let* ((face-string (symbol-name face))
 105                        (matches (string-match context-coloring-test-level-regexp face-string)))
 106                   (when matches
 107                     (setq actual-level (string-to-number (substring face-string
 108                                                                     (match-beginning 1)
 109                                                                     (match-end 1))))
 110                     (= level actual-level)))))
 111      (ert-fail (format "Expected level in region [%s, %s), which is \"%s\", to be %s; but at point %s, it was %s"
 112                        start end (buffer-substring-no-properties start end) level point actual-level)))))
 113
 114 (defun context-coloring-test-assert-region-face (start end expected-face)
 115   (context-coloring-test-assert-region
 116    (when (not (eq face expected-face))
 117      (ert-fail (format "Expected face in region [%s, %s), which is \"%s\", to be %s; but at point %s, it was %s"
 118                        start end (buffer-substring-no-properties start end) expected-face point face)))))
 119
 120 (defun context-coloring-test-assert-region-comment-delimiter (start end)
 121   (context-coloring-test-assert-region-face start end 'font-lock-comment-delimiter-face))
 122
 123 (defun context-coloring-test-assert-region-comment (start end)
 124   (context-coloring-test-assert-region-face start end 'font-lock-comment-face))
 125
 126 (defun context-coloring-test-assert-region-string (start end)
 127   (context-coloring-test-assert-region-face start end 'font-lock-string-face))
 128
 129 (defun context-coloring-test-assert-message (expected)
 130   (with-current-buffer "*Messages*"
 131     (let ((messages (split-string (buffer-substring-no-properties (point-min) (point-max)) "\n")))
 132       (let ((message (car (nthcdr (- (length messages) 2) messages))))
 133         (should (equal message expected))))))
 134
 135 (ert-deftest context-coloring-test-unsupported-mode ()
 136   (context-coloring-test-with-fixture
 137    "./fixtures/function-scopes.js"
 138    (context-coloring-mode)
 139    (context-coloring-test-assert-message
 140     "Context coloring is not available for this major mode")))
 141
 142 (defun context-coloring-test-js-function-scopes ()
 143   (context-coloring-test-assert-region-level 1 9 0)
 144   (context-coloring-test-assert-region-level 9 23 1)
 145   (context-coloring-test-assert-region-level 23 25 0)
 146   (context-coloring-test-assert-region-level 25 34 1)
 147   (context-coloring-test-assert-region-level 34 35 0)
 148   (context-coloring-test-assert-region-level 35 52 1)
 149   (context-coloring-test-assert-region-level 52 66 2)
 150   (context-coloring-test-assert-region-level 66 72 1)
 151   (context-coloring-test-assert-region-level 72 81 2)
 152   (context-coloring-test-assert-region-level 81 82 1)
 153   (context-coloring-test-assert-region-level 82 87 2)
 154   (context-coloring-test-assert-region-level 87 89 1))
 155
 156 (ert-deftest-async context-coloring-test-js-mode-function-scopes (done)
 157   (context-coloring-test-js-mode
 158    "./fixtures/function-scopes.js"
 159    (lambda (teardown)
 160      (unwind-protect
 161          (context-coloring-test-js-function-scopes)
 162        (funcall teardown))
 163      (funcall done))))
 164
 165 (ert-deftest context-coloring-test-js2-mode-function-scopes ()
 166   (context-coloring-test-js2-mode
 167    "./fixtures/function-scopes.js"
 168    (context-coloring-test-js-function-scopes)))
 169
 170 (defun context-coloring-test-js-global ()
 171   (context-coloring-test-assert-region-level 20 28 1)
 172   (context-coloring-test-assert-region-level 28 35 0)
 173   (context-coloring-test-assert-region-level 35 41 1))
 174
 175 (ert-deftest-async context-coloring-test-js-mode-global (done)
 176   (context-coloring-test-js-mode
 177    "./fixtures/global.js"
 178    (lambda (teardown)
 179      (unwind-protect
 180          (context-coloring-test-js-global)
 181        (funcall teardown))
 182      (funcall done))))
 183
 184 (ert-deftest context-coloring-test-js2-mode-global ()
 185   (context-coloring-test-js2-mode
 186    "./fixtures/global.js"
 187    (context-coloring-test-js-global)))
 188
 189 (defun context-coloring-test-js-block-scopes ()
 190   (context-coloring-test-assert-region-level 20 64 1)
 191    (setq context-coloring-js-block-scopes t)
 192    (context-coloring-colorize)
 193    (context-coloring-test-assert-region-level 20 27 1)
 194    (context-coloring-test-assert-region-level 27 41 2)
 195    (context-coloring-test-assert-region-level 41 42 1)
 196    (context-coloring-test-assert-region-level 42 64 2))
 197
 198 (ert-deftest context-coloring-test-js2-mode-block-scopes ()
 199   (context-coloring-test-js2-mode
 200    "./fixtures/block-scopes.js"
 201    (context-coloring-test-js-block-scopes)))
 202
 203 (defun context-coloring-test-js-catch ()
 204   (context-coloring-test-assert-region-level 20 27 1)
 205   (context-coloring-test-assert-region-level 27 51 2)
 206   (context-coloring-test-assert-region-level 51 52 1)
 207   (context-coloring-test-assert-region-level 52 73 2)
 208   (context-coloring-test-assert-region-level 73 101 3)
 209   (context-coloring-test-assert-region-level 101 102 1)
 210   (context-coloring-test-assert-region-level 102 117 3)
 211   (context-coloring-test-assert-region-level 117 123 2))
 212
 213 (ert-deftest-async context-coloring-test-js-mode-catch (done)
 214   (context-coloring-test-js-mode
 215    "./fixtures/catch.js"
 216    (lambda (teardown)
 217      (unwind-protect
 218          (context-coloring-test-js-catch)
 219        (funcall teardown))
 220      (funcall done))))
 221
 222 (ert-deftest context-coloring-test-js2-mode-catch ()
 223   (context-coloring-test-js2-mode
 224    "./fixtures/catch.js"
 225    (context-coloring-test-js-catch)))
 226
 227 (defun context-coloring-test-js-key-names ()
 228   (context-coloring-test-assert-region-level 20 63 1))
 229
 230 (ert-deftest-async context-coloring-test-js-mode-key-names (done)
 231   (context-coloring-test-js-mode
 232    "./fixtures/key-names.js"
 233    (lambda (teardown)
 234      (unwind-protect
 235          (context-coloring-test-js-key-names)
 236        (funcall teardown))
 237      (funcall done))))
 238
 239 (ert-deftest context-coloring-test-js2-mode-key-names ()
 240   (context-coloring-test-js2-mode
 241    "./fixtures/key-names.js"
 242    (context-coloring-test-js-key-names)))
 243
 244 (defun context-coloring-test-js-property-lookup ()
 245   (context-coloring-test-assert-region-level 20 26 0)
 246   (context-coloring-test-assert-region-level 26 38 1)
 247   (context-coloring-test-assert-region-level 38 44 0)
 248   (context-coloring-test-assert-region-level 44 52 1)
 249   (context-coloring-test-assert-region-level 57 63 0)
 250   (context-coloring-test-assert-region-level 63 74 1))
 251
 252 (ert-deftest-async context-coloring-test-js-mode-property-lookup (done)
 253   (context-coloring-test-js-mode
 254    "./fixtures/property-lookup.js"
 255    (lambda (teardown)
 256      (unwind-protect
 257          (context-coloring-test-js-property-lookup)
 258        (funcall teardown))
 259      (funcall done))))
 260
 261 (ert-deftest context-coloring-test-js2-mode-property-lookup ()
 262   (context-coloring-test-js2-mode
 263    "./fixtures/property-lookup.js"
 264    (context-coloring-test-js-property-lookup)))
 265
 266 (defun context-coloring-test-js-key-values ()
 267   (context-coloring-test-assert-region-level 78 79 1))
 268
 269 (ert-deftest-async context-coloring-test-js-mode-key-values (done)
 270   (context-coloring-test-js-mode
 271    "./fixtures/key-values.js"
 272    (lambda (teardown)
 273      (unwind-protect
 274          (context-coloring-test-js-key-values)
 275        (funcall teardown))
 276      (funcall done))))
 277
 278 (ert-deftest context-coloring-test-js2-mode-key-values ()
 279   (context-coloring-test-js2-mode
 280    "./fixtures/key-values.js"
 281    (context-coloring-test-js-key-values)))
 282
 283 (defun context-coloring-test-js-comments-and-strings ()
 284   (context-coloring-test-assert-region-comment-delimiter 1 4)
 285   (context-coloring-test-assert-region-comment 4 8)
 286   (context-coloring-test-assert-region-comment-delimiter 9 12)
 287   (context-coloring-test-assert-region-comment 12 19)
 288   (context-coloring-test-assert-region-string 20 32)
 289   (context-coloring-test-assert-region-level 32 33 0))
 290
 291 (ert-deftest-async context-coloring-test-js-mode-comments-and-strings (done)
 292   (context-coloring-test-js-mode
 293    "./fixtures/comments-and-strings.js"
 294    (lambda (teardown)
 295      (unwind-protect
 296          (context-coloring-test-js-comments-and-strings)
 297        (funcall teardown))
 298      (funcall done))
 299    (lambda ()
 300      (setq context-coloring-comments-and-strings t))))
 301
 302 (ert-deftest context-coloring-test-js2-mode-comments-and-strings ()
 303   (context-coloring-test-js2-mode
 304    "./fixtures/comments-and-strings.js"
 305    (setq context-coloring-comments-and-strings t)
 306    (context-coloring-colorize)
 307    (context-coloring-test-js-comments-and-strings)))
 308
 309 (provide 'context-coloring-test)