faces-tests.el 2.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960
  1. ;;; faces-tests.el --- Tests for faces.el -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
  3. ;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
  4. ;; Keywords:
  5. ;; This program is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. ;;; Code:
  16. (require 'ert)
  17. (require 'faces)
  18. (defface faces--test1
  19. '((t :background "black" :foreground "black"))
  20. "")
  21. (defface faces--test2
  22. '((t :box 1))
  23. "")
  24. (ert-deftest faces--test-color-at-point ()
  25. (with-temp-buffer
  26. (insert (propertize "STRING" 'face '(faces--test2 faces--test1)))
  27. (goto-char (point-min))
  28. (should (equal (background-color-at-point) "black"))
  29. (should (equal (foreground-color-at-point) "black")))
  30. (with-temp-buffer
  31. (insert (propertize "STRING" 'face '(:foreground "black" :background "black")))
  32. (goto-char (point-min))
  33. (should (equal (background-color-at-point) "black"))
  34. (should (equal (foreground-color-at-point) "black")))
  35. (with-temp-buffer
  36. (emacs-lisp-mode)
  37. (setq-local font-lock-comment-face 'faces--test1)
  38. (setq-local font-lock-constant-face 'faces--test2)
  39. (insert ";; `symbol'")
  40. (font-lock-fontify-region (point-min) (point-max))
  41. (goto-char (point-min))
  42. (should (equal (background-color-at-point) "black"))
  43. (should (equal (foreground-color-at-point) "black"))
  44. (goto-char 6)
  45. (should (equal (background-color-at-point) "black"))
  46. (should (equal (foreground-color-at-point) "black"))))
  47. (provide 'faces-tests)
  48. ;;; faces-tests.el ends here