emacs/protesilaos.modus-themes
1
0
Fork 0
mirror of https://github.com/protesilaos/modus-themes.git synced 2026-09-10 07:16:30 -04:00
Code Issues Actions Packages Projects Releases Wiki Activity
protesilaos.modus-themes/tests/modus-themes-test.el

373 lines
16 KiB
EmacsLisp
Raw Blame History

;;; modus-themes-test.el --- Unit tests for the Modus themes -*- lexical-binding: t -*-
;; Copyright (C) 2025-2026 Free Software Foundation, Inc.
;; Author: Protesilaos <info@protesilaos.com>,
;; Rudolf Adamkovič <rudolf@adamkovic.org>
;; Maintainer: Protesilaos <info@protesilaos.com>
;; URL: https://github.com/protesilaos/modus-themes
;; This file is NOT part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Tests for the Modus themes. Note that we are using Shorthands in
;; this file, so the "mtt-" prefix really is "modus-themes-test-".
;; Evaluate the following to learn more:
;;
;; (info "(elisp) Shorthands")
;;; Code:
(require 'ert)
(require 'modus-themes)
(defmacro mtt-define-test (symbol &rest body)
"Write test for SYMBOL with BODY forms.
If the `car' of BODY is a string, use it as the docstring of the test.
Else provide a generic snippet of text."
(declare (doc-string 2) (indent defun))
(let* ((first (car body))
(has-docstring (stringp first))
(docstring (if has-docstring
first
(format "Test that `%s' does the right thing." symbol)))
(body (if has-docstring (cdr body) body)))
`(ert-deftest ,(intern (format "mtt-%s" symbol)) ()
,docstring
,@body)))
(mtt-define-test modus-themes--color-hex-p
(should (modus-themes--color-hex-p "#123"))
(should (modus-themes--color-hex-p "#123456"))
(should (modus-themes--color-hex-p "#abc"))
(should (modus-themes--color-hex-p "#ABCDEF"))
(should-not (modus-themes--color-hex-p "abc"))
(should-not (modus-themes--color-hex-p "#abcd"))
(should-not (modus-themes--color-hex-p "#12345"))
(should-not (modus-themes--color-hex-p "#1234567"))
(should-not (modus-themes--color-hex-p "#zzz"))
(should-not (modus-themes--color-hex-p "#zzz"))
(should-not (modus-themes--color-hex-p "#12g456")))
(mtt-define-test modus-themes--hex-or-name-to-rgb
(should (equal (modus-themes--hex-or-name-to-rgb "#fff") (list 1.0 1.0 1.0)))
(should (equal (modus-themes--hex-or-name-to-rgb "#000") (list 0.0 0.0 0.0)))
(should (equal (modus-themes--hex-or-name-to-rgb "#f00") (list 1.0 0.0 0.0)))
(should (equal (modus-themes--hex-or-name-to-rgb "#0f0") (list 0.0 1.0 0.0)))
(should (equal (modus-themes--hex-or-name-to-rgb "#00f") (list 0.0 0.0 1.0)))
(should (equal (modus-themes--hex-or-name-to-rgb "#ffffff") (list 1.0 1.0 1.0)))
(should (equal (modus-themes--hex-or-name-to-rgb "#000000") (list 0.0 0.0 0.0)))
(should (equal (modus-themes--hex-or-name-to-rgb "#ff0000") (list 1.0 0.0 0.0)))
(should (equal (modus-themes--hex-or-name-to-rgb "#00ff00") (list 0.0 1.0 0.0)))
;; NOTE 2026-04-12: I do not need it to be precise here, hence the `format'.
(let ((rgb-rounded-fn
(lambda (hex)
(let ((rgb (modus-themes--hex-or-name-to-rgb hex)))
(mapcar (lambda (float) (string-to-number (format "%.2f" float))) rgb)))))
(should (equal (funcall rgb-rounded-fn "#800000") (list 0.5 0.0 0.0)))
(should (equal (funcall rgb-rounded-fn "#008000") (list 0.0 0.5 0.0)))
(should (equal (funcall rgb-rounded-fn "#000080") (list 0.0 0.0 0.5))))
(should-error (modus-themes--hex-or-name-to-rgb ""))
(should-error (modus-themes--hex-or-name-to-rgb "#"))
(should-error (modus-themes--hex-or-name-to-rgb "#1"))
(should-error (modus-themes--hex-or-name-to-rgb "#12"))
(should-error (modus-themes--hex-or-name-to-rgb "#1234"))
(should-error (modus-themes--hex-or-name-to-rgb "#12345"))
(should-error (modus-themes--hex-or-name-to-rgb "#gggggg"))
(should-error (modus-themes--hex-or-name-to-rgb (list 1.0 1.0 1.0))))
(mtt-define-test modus-themes-wcag-formula
"Test that `modus-themes-wcag-formula' does the right thing.
Also see `modus-themes-test--modus-themes--hex-to-rgb'."
(should (= (modus-themes-wcag-formula "#ffffff") 1.0))
(should (= (modus-themes-wcag-formula "#000000") 0.0))
(should-error (modus-themes-wcag-formula "#00000")))
(mtt-define-test modus-themes-contrast
"Test that `modus-themes-contrast' works as intended.
Also see `modus-themes-test--modus-themes--hex-to-rgb'."
(should (= (modus-themes-contrast "#ffffff" "#000000") 21.0))
(should (= (modus-themes-contrast "#000000" "#ffffff") 21.0))
;; NOTE 2026-04-12: I do not need it to be precise here, hence the `format'.
(let ((float-2-fn (lambda (hex1 hex2) (string-to-number (format "%.2f" (modus-themes-contrast hex1 hex2))))))
(should (= (funcall float-2-fn "#ff0000" "#ffffff") 4.0))
(should (= (funcall float-2-fn "#00ff00" "#ffffff") 1.37))
(should (= (funcall float-2-fn "#0000ff" "#ffffff") 8.59))
(should (= (funcall float-2-fn "#ffff00" "#ffffff") 1.07))
(should (= (funcall float-2-fn "#00ffff" "#ffffff") 1.25))
(should (= (funcall float-2-fn "#ff00ff" "#ffffff") 3.14)))
(should-error (modus-themes-contrast "#ffffff" "#00000"))
(should-error (modus-themes-contrast "#fffff" "#00000")))
(mtt-define-test modus-themes--color-eight-to-six-digits
(should (string= (modus-themes--color-eight-to-six-digits "#f00") "#f00"))
(should (string= (modus-themes--color-eight-to-six-digits "#ff1919") "#ff1919"))
(should (string= (modus-themes--color-eight-to-six-digits "#ffff19991999") "#ff1919")))
(mtt-define-test modus-themes-adjust-value
"Test that `modus-themes-adjust-value' does the right thing.
Also see `modus-themes-test--modus-themes--hex-to-rgb'."
(should (string= (modus-themes-adjust-value "#ff0000" 10) "#ff1919"))
(should (string= (modus-themes-adjust-value "#505050" 100) "#ffffff"))
(should (string= (modus-themes-adjust-value "#505050" -100) "#000000"))
(should (string= (modus-themes-adjust-value "#505050" 0) "#505050"))
(should-error (modus-themes-adjust-value "#ff00" 10)))
(mtt-define-test modus-themes-activate
(if (custom-theme-p 'modus-operandi-tritanopia)
(should-not (modus-themes-activate 'modus-operandi-tritanopia))
(should (custom-theme-p 'modus-operandi-tritanopia))))
(mtt-define-test modus-themes--belongs-to-family-p
(should (modus-themes--belongs-to-family-p 'modus-operandi 'modus-themes))
(should-not (modus-themes--belongs-to-family-p 'my-fancy-theme 'modus-themes))
(should-not (modus-themes--belongs-to-family-p 'modus-operandi 'my-fancy-themes)))
(mtt-define-test modus-themes-get-all-known-themes
(should (equal (modus-themes-get-all-known-themes) modus-themes-items))
(should-not (modus-themes-get-all-known-themes 'my-fancy-themes)))
(mtt-define-test modus-themes--background-p
(should (modus-themes--background-p 'modus-operandi 'light))
(should-not (modus-themes--background-p 'modus-operandi 'dark))
(should-not (modus-themes--background-p 'modus-operandi t))
(should-not (modus-themes--background-p 'modus-operandi :light)))
(mtt-define-test modus-themes-sort
(let ((first-has-prefix-fn (lambda (themes prefix)
(when-let* ((first (car themes))
(name (symbol-name first)))
(string-match-p prefix name)))))
(should (funcall first-has-prefix-fn (modus-themes-sort (reverse modus-themes-items) 'light) "modus-operandi"))
(should (funcall first-has-prefix-fn (modus-themes-sort modus-themes-items 'dark) "modus-vivendi"))))
(mtt-define-test inheritance
"Ensure all faces inherit from valid faces."
;; Third-party packages, loaded if possible to better test face inheritance.
(require 'font-latex nil t)
(let ((current-theme (modus-themes-get-current-theme)))
(unwind-protect
(progn
(modus-themes-load-theme 'modus-operandi)
(should-not (seq-filter
(lambda (face)
;; The face either has no parent ...
(if-let* ((parent (face-attribute face :inherit)))
(and (symbolp parent)
(not (eq parent 'unspecified))
;; ... or its parent is a valid face.
(not (facep parent)))))
(face-list))))
(modus-themes-load-theme current-theme))))
(mtt-define-test color-dark-p
(let ((modus-operandi-sample-foregrounds
'("#a60000"
"#972500"
"#a0132f"
"#7f0000"
"#006800"
"#316500"
"#00663f"
"#2a5045"
"#6f5500"
"#884900"
"#7a4f2f"
"#624416"
"#0031a9"
"#3548cf"
"#0000b0"
"#003497"
"#721045"
"#8f0075"
"#531ab6"
"#7c318f"
"#005e8b"
"#3f578f"
"#005f5f"
"#005077"))
(modus-vivendi-sample-foregrounds
'("#ff5f59"
"#ff6b55"
"#ff7f86"
"#ff9580"
"#44bc44"
"#70b900"
"#00c06f"
"#88ca9f"
"#d0bc00"
"#fec43f"
"#dfaf7a"
"#d2b580"
"#2fafff"
"#79a8ff"
"#00bcff"
"#82b0ec"
"#feacd0"
"#f78fe7"
"#b6a0ff"
"#caa6df"
"#00d3d0"
"#4ae2f0"
"#6ae4b9"
"#9ac8e0")))
(should (seq-every-p #'modus-themes-color-dark-p modus-operandi-sample-foregrounds))
(should-not (seq-every-p #'modus-themes-color-dark-p modus-vivendi-sample-foregrounds))))
(mtt-define-test get-readable-foreground
(let ((modus-operandi-sample-foregrounds
'("#a60000"
"#972500"
"#a0132f"
"#7f0000"
"#006800"
"#316500"
"#00663f"
"#2a5045"
"#6f5500"
"#884900"
"#7a4f2f"
"#624416"
"#0031a9"
"#3548cf"
"#0000b0"
"#003497"
"#721045"
"#8f0075"
"#531ab6"
"#7c318f"
"#005e8b"
"#3f578f"
"#005f5f"
"#005077"))
(modus-vivendi-sample-foregrounds
'("#ff5f59"
"#ff6b55"
"#ff7f86"
"#ff9580"
"#44bc44"
"#70b900"
"#00c06f"
"#88ca9f"
"#d0bc00"
"#fec43f"
"#dfaf7a"
"#d2b580"
"#2fafff"
"#79a8ff"
"#00bcff"
"#82b0ec"
"#feacd0"
"#f78fe7"
"#b6a0ff"
"#caa6df"
"#00d3d0"
"#4ae2f0"
"#6ae4b9"
"#9ac8e0")))
(should (seq-every-p
(lambda (value)
(string= value "#ffffff"))
(mapcar #'modus-themes-get-readable-foreground modus-operandi-sample-foregrounds)))
(should (seq-every-p
(lambda (value)
(string= value "#000000"))
(mapcar #'modus-themes-get-readable-foreground modus-vivendi-sample-foregrounds)))))
(mtt-define-test complete-palette-mappings
"Ensure all built-in palettes contain entries for all palette mappings.
This computes a complete list of mapping names from the built-in palettes
and then cross-checks the palettes against the list. This should help ensure
consistency and completeness where adding a new mapping in one palette will
fail this test until it is added in all palettes."
(let* ((operandi-names (seq-uniq (mapcar #'car modus-themes-operandi-palette)))
(operandi-tinted-names (seq-uniq (mapcar #'car modus-themes-operandi-tinted-palette)))
(operandi-deuteranopia-names (seq-uniq (mapcar #'car modus-themes-operandi-deuteranopia-palette)))
(operandi-tritanopia-names (seq-uniq (mapcar #'car modus-themes-operandi-tritanopia-palette)))
(vivendi-names (seq-uniq (mapcar #'car modus-themes-vivendi-palette)))
(vivendi-tinted-names (seq-uniq (mapcar #'car modus-themes-vivendi-tinted-palette)))
(vivendi-deuteranopia-names (seq-uniq (mapcar #'car modus-themes-vivendi-deuteranopia-palette)))
(vivendi-tritanopia-names (seq-uniq (mapcar #'car modus-themes-vivendi-tritanopia-palette)))
(all-names (seq-uniq (append operandi-names
operandi-tinted-names
operandi-deuteranopia-names
operandi-tritanopia-names
vivendi-names
vivendi-tinted-names
vivendi-deuteranopia-names
vivendi-tritanopia-names))))
(should (seq-empty-p (seq-difference all-names operandi-names)))
(should (seq-empty-p (seq-difference all-names operandi-tinted-names)))
(should (seq-empty-p (seq-difference all-names operandi-deuteranopia-names)))
(should (seq-empty-p (seq-difference all-names operandi-tritanopia-names)))
(should (seq-empty-p (seq-difference all-names vivendi-names)))
(should (seq-empty-p (seq-difference all-names vivendi-tinted-names)))
(should (seq-empty-p (seq-difference all-names vivendi-deuteranopia-names)))
(should (seq-empty-p (seq-difference all-names vivendi-tritanopia-names)))))
(mtt-define-test modus-themes-generate-palette
"Ensure `modus-themes-generate-palette' provides enough mapping coverage
such that the generated palette does not inherit explicit color values
from a parent core palette."
(let* ((generated-palette (modus-themes-generate-palette
'((fg-main "#ffffff")
(bg-main "#000000")
(red "#ff0000")
(green "#00ff00")
(yellow "#ffff00")
(blue "#0000ff")
(magenta "#ff00ff")
(cyan "#00ffff"))))
;; These are colors we expect to have an explicit hex value,
;; either because they were provided explicitly in the call to
;; `modus-themes-generate-palette' above, or because we expect
;; `modus-themes-generate-palette' to generate the color.
(explicit-colors '( fg-main bg-main
fg-alt fg-dim bg-inactive bg-active bg-dim border
;; cyan
cyan bg-cyan-nuanced bg-cyan-subtle bg-cyan-intense
cyan-intense cyan-faint cyan-cooler cyan-warmer
;; magenta
magenta bg-magenta-nuanced bg-magenta-subtle bg-magenta-intense
magenta-intense magenta-faint magenta-cooler magenta-warmer
;; blue
blue bg-blue-nuanced bg-blue-subtle bg-blue-intense
blue-intense blue-faint blue-cooler blue-warmer
;; yellow
yellow bg-yellow-nuanced bg-yellow-subtle bg-yellow-intense
yellow-intense yellow-faint yellow-cooler yellow-warmer
;; green
green bg-green-nuanced bg-green-subtle bg-green-intense
green-intense green-faint green-cooler green-warmer
;; red
red bg-red-nuanced bg-red-subtle bg-red-intense
red-intense red-faint red-cooler red-warmer)))
;; Ensure all other colors in the palette map to a color name and not an
;; explicit hex value. If this check fails, the offending color should
;; be mapped to an appropriate color name in `modus-themes-generate-palette'.
(should (seq-empty-p (seq-remove (lambda (elem)
(or (member (car elem) explicit-colors)
(symbolp (cadr elem))))
generated-palette)))))
(provide 'modus-themes-test)
;;; modus-themes-test.el ends here
;; Local Variables:
;; read-symbol-shorthands: (("mtt" . "modus-themes-test-"))
;; End:
Reference in a new issue View git blame Copy permalink