1;;; faceup-test-basics.el --- Tests for the `faceup' package. -*- lexical-binding:t -*- 2 3;; Copyright (C) 2014-2021 Free Software Foundation, Inc. 4 5;; Author: Anders Lindgren 6;; Keywords: languages, faces 7 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs is free software: you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation, either version 3 of the License, or 13;; (at your option) any later version. 14 15;; GNU Emacs is distributed in the hope that it will be useful, 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; GNU General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 22 23;;; Commentary: 24 25;; Basic tests for the `faceup' package. 26 27;;; Code: 28 29(eval-when-compile (require 'cl-lib)) 30(require 'faceup) 31 32(ert-deftest faceup-functions () 33 "Test primitive functions." 34 (should (equal (faceup-normalize-face-property '()) '())) 35 (should (equal (faceup-normalize-face-property 'a) '(a))) 36 (should (equal (faceup-normalize-face-property '(a)) '(a))) 37 (should (equal (faceup-normalize-face-property '(:x t)) '((:x t)))) 38 (should (equal (faceup-normalize-face-property '(:x t a)) '((:x t)))) 39 (should (equal (faceup-normalize-face-property '(:x t a b)) '((:x t)))) 40 (should (equal (faceup-normalize-face-property '(a :x t)) '(a (:x t)))) 41 (should (equal (faceup-normalize-face-property '(a b :x t)) 42 '(a b (:x t)))) 43 44 (should (equal (faceup-normalize-face-property '(:x t :y nil)) 45 '((:y nil) (:x t)))) 46 (should (equal (faceup-normalize-face-property '(:x t :y nil a)) 47 '((:y nil) (:x t)))) 48 (should (equal (faceup-normalize-face-property '(:x t :y nil a b)) 49 '((:y nil) (:x t)))) 50 (should (equal (faceup-normalize-face-property '(a :x t :y nil)) 51 '(a (:y nil) (:x t)))) 52 (should (equal (faceup-normalize-face-property '(a b :x t :y nil)) 53 '(a b (:y nil) (:x t))))) 54 55 56(ert-deftest faceup-markup-basics () 57 (should (equal (faceup-markup-string "") "")) 58 (should (equal (faceup-markup-string "test") "test"))) 59 60(ert-deftest faceup-markup-escaping () 61 (should (equal (faceup-markup-string "«") "««")) 62 (should (equal (faceup-markup-string "«A«B«C«") "««A««B««C««")) 63 (should (equal (faceup-markup-string "»") "«»")) 64 (should (equal (faceup-markup-string "»A»B»C»") "«»A«»B«»C«»"))) 65 66(ert-deftest faceup-markup-plain () 67 ;; UU 68 ;; ABCDEF 69 (should (equal (faceup-markup-string 70 #("ABCDEF" 2 4 (face underline))) 71 "AB«U:CD»EF"))) 72 73(ert-deftest faceup-markup-plain-full-text () 74 ;; UUUUUU 75 ;; ABCDEF 76 (should (equal (faceup-markup-string 77 #("ABCDEF" 0 6 (face underline))) 78 "«U:ABCDEF»"))) 79 80(ert-deftest faceup-markup-anonymous-face () 81 ;; AA 82 ;; ABCDEF 83 (should (equal (faceup-markup-string 84 #("ABCDEF" 2 4 (face (:underline t)))) 85 "AB«:(:underline t):CD»EF"))) 86 87(ert-deftest faceup-markup-anonymous-face-2keys () 88 ;; AA 89 ;; ABCDEF 90 (should (equal (faceup-markup-string 91 #("ABCDEF" 2 4 (face (:foo t :bar nil)))) 92 "AB«:(:foo t):«:(:bar nil):CD»»EF")) 93 ;; Plist in list. 94 (should (equal (faceup-markup-string 95 #("ABCDEF" 2 4 (face ((:foo t :bar nil))))) 96 "AB«:(:foo t):«:(:bar nil):CD»»EF")) 97 ;; Two plists. 98 (should (equal (faceup-markup-string 99 #("ABCDEF" 2 4 (face ((:foo t) (:bar nil))))) 100 "AB«:(:bar nil):«:(:foo t):CD»»EF"))) 101 102(ert-deftest faceup-markup-anonymous-nested () 103 ;; AA 104 ;; IIII 105 ;; ABCDEF 106 (should (equal (faceup-markup-string 107 #("ABCDEF" 108 1 2 (face ((:foo t))) 109 2 4 (face ((:bar t) (:foo t))) 110 4 5 (face ((:foo t))))) 111 "A«:(:foo t):B«:(:bar t):CD»E»F"))) 112 113(ert-deftest faceup-markup-nested () 114 ;; UU 115 ;; IIII 116 ;; ABCDEF 117 (should (equal (faceup-markup-string 118 #("ABCDEF" 119 1 2 (face italic) 120 2 4 (face (underline italic)) 121 4 5 (face italic))) 122 "A«I:B«U:CD»E»F"))) 123 124(ert-deftest faceup-markup-overlapping () 125 ;; UUU 126 ;; III 127 ;; ABCDEF 128 (should (equal (faceup-markup-string 129 #("ABCDEF" 130 1 2 (face italic) 131 2 4 (face (underline italic)) 132 4 5 (face underline))) 133 "A«I:B«U:CD»»«U:E»F")) 134 ;; III 135 ;; UUU 136 ;; ABCDEF 137 (should (equal (faceup-markup-string 138 #("ABCDEF" 139 1 2 (face italic) 140 2 4 (face (italic underline)) 141 4 5 (face underline))) 142 "A«I:B»«U:«I:CD»E»F"))) 143 144(ert-deftest faceup-markup-multi-face () 145 ;; More than one face at the same location. 146 ;; 147 ;; The property to the front takes precedence, it is rendered as the 148 ;; innermost parenthesis pair. 149 (should (equal (faceup-markup-string 150 #("ABCDEF" 2 4 (face (underline italic)))) 151 "AB«I:«U:CD»»EF")) 152 (should (equal (faceup-markup-string 153 #("ABCDEF" 2 4 (face (italic underline)))) 154 "AB«U:«I:CD»»EF")) 155 ;; Equal ranges, full text. 156 (should (equal (faceup-markup-string 157 #("ABCDEF" 0 6 (face (underline italic)))) 158 "«I:«U:ABCDEF»»")) 159 ;; Ditto, with stray markup characters. 160 (should (equal (faceup-markup-string 161 #("AB«CD»EF" 0 8 (face (underline italic)))) 162 "«I:«U:AB««CD«»EF»»"))) 163 164(ert-deftest faceup-markup-multi-property () 165 (let ((faceup-properties '(alpha beta gamma))) 166 ;; One property. 167 (should (equal (faceup-markup-string 168 #("ABCDEF" 2 4 (alpha (a l p h a)))) 169 "AB«(alpha):(a l p h a):CD»EF")) 170 171 ;; Two properties, inner enclosed. 172 (should (equal (faceup-markup-string 173 (let ((s (copy-sequence "ABCDEFGHIJ"))) 174 (set-text-properties 2 8 '(alpha (a l p h a)) s) 175 (font-lock-append-text-property 4 6 'beta '(b e t a) s) 176 s)) 177 "AB«(alpha):(a l p h a):CD«(beta):(b e t a):EF»GH»IJ")) 178 179 ;; Two properties, same end 180 (should (equal (faceup-markup-string 181 (let ((s (copy-sequence "ABCDEFGH"))) 182 (set-text-properties 2 6 '(alpha (a)) s) 183 (add-text-properties 4 6 '(beta (b)) s) 184 s)) 185 "AB«(alpha):(a):CD«(beta):(b):EF»»GH")) 186 187 ;; Two properties, overlap. 188 (should (equal (faceup-markup-string 189 (let ((s (copy-sequence "ABCDEFGHIJ"))) 190 (set-text-properties 2 6 '(alpha (a)) s) 191 (add-text-properties 4 8 '(beta (b)) s) 192 s)) 193 "AB«(alpha):(a):CD«(beta):(b):EF»»«(beta):(b):GH»IJ")))) 194 195 196(ert-deftest faceup-clean () 197 "Test the clean features of `faceup'." 198 (should (equal (faceup-clean-string "") "")) 199 (should (equal (faceup-clean-string "test") "test")) 200 (should (equal (faceup-clean-string "AB«U:CD»EF") "ABCDEF")) 201 (should (equal (faceup-clean-string "«U:ABCDEF»") "ABCDEF")) 202 (should (equal (faceup-clean-string "A«I:B«U:CD»E»F") "ABCDEF")) 203 (should (equal (faceup-clean-string "A«I:B«U:CD»»«U:E»F") "ABCDEF")) 204 (should (equal (faceup-clean-string "AB«I:«U:CD»»EF") "ABCDEF")) 205 (should (equal (faceup-clean-string "«I:«U:ABCDEF»»") "ABCDEF")) 206 (should (equal (faceup-clean-string "«(foo)I:ABC»DEF") "ABCDEF")) 207 (should (equal (faceup-clean-string "«:(:foo t):ABC»DEF") "ABCDEF")) 208 ;; Escaped markup characters. 209 (should (equal (faceup-clean-string "««") "«")) 210 (should (equal (faceup-clean-string "«»") "»")) 211 (should (equal (faceup-clean-string "A«I:B«U:CD»«»»«U:E»F") "ABCD»EF"))) 212 213 214(ert-deftest faceup-render () 215 "Test the render features of `faceup'." 216 (should (equal (faceup-render-string "") "")) 217 (should (equal (faceup-render-string "««") "«")) 218 (should (equal (faceup-render-string "«»") "»")) 219 (should (equal (faceup-render-string "A«I:B«U:CD»«»»«U:E»F") "ABCD»EF"))) 220 221 222(defvar faceup-test-resources-directory 223 (concat (file-name-directory 224 (substring (faceup-this-file-directory) 0 -1)) 225 "faceup-resources/") 226 "The `faceup-resources' directory.") 227 228 229(defvar faceup-test-this-file-directory nil 230 "The result of `faceup-this-file-directory' in various contexts. 231 232This is set by the file test support file 233`faceup-test-this-file-directory.el'.") 234 235 236(ert-deftest faceup-directory () 237 "Test `faceup-this-file-directory'." 238 (let ((file (concat faceup-test-resources-directory 239 "faceup-test-this-file-directory.el")) 240 (load-file-name nil)) 241 ;; Test normal load. 242 (makunbound 'faceup-test-this-file-directory) 243 (load file nil :nomessage) 244 (should (equal faceup-test-this-file-directory 245 faceup-test-resources-directory)) 246 ;; Test `eval-buffer'. 247 (makunbound 'faceup-test-this-file-directory) 248 (save-excursion 249 (find-file file) 250 (eval-buffer)) 251 (should (equal faceup-test-this-file-directory 252 faceup-test-resources-directory)) 253 ;; Test `eval-defun'. 254 (makunbound 'faceup-test-this-file-directory) 255 (save-excursion 256 (find-file file) 257 (save-excursion 258 (goto-char (point-min)) 259 (while (not (eobp)) 260 ;; Note: In batch mode, this prints the result of the 261 ;; evaluation. Unfortunately, this is hard to fix. 262 (eval-defun nil) 263 (forward-sexp)))) 264 (should (equal faceup-test-this-file-directory 265 faceup-test-resources-directory)))) 266 267(provide 'faceup-test-basics) 268 269;;; faceup-test-basics.el ends here 270