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