Commit | Line | Data |
---|---|---|
372fb76b CY |
1 | ;;; font-parse-tests.el --- Test suite for font parsing. |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2011-2014 Free Software Foundation, Inc. |
372fb76b CY |
4 | |
5 | ;; Author: Chong Yidong <cyd@stupidchicken.com> | |
6 | ;; Keywords: internal | |
7 | ;; Human-Keywords: internal | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation, either version 3 of the License, or | |
14 | ;; (at your option) any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 | ||
24 | ;;; Commentary: | |
25 | ||
26 | ;; Type M-x test-font-parse RET to generate the test buffer. | |
27 | ||
372fb76b CY |
28 | ;;; Code: |
29 | ||
30 | (require 'ert) | |
31 | ||
32 | (defvar font-parse-tests--data | |
33 | `((" " ,(intern " ") nil nil nil nil) | |
34 | ("Monospace" Monospace nil nil nil nil) | |
35 | ("Foo1" Foo1 nil nil nil nil) | |
36 | ("12" nil 12.0 nil nil nil) | |
37 | ("12 " ,(intern "12 ") nil nil nil nil) | |
38 | ;; Fontconfig format | |
39 | ("Foo:" Foo nil nil nil nil) | |
40 | ("Foo-8" Foo 8.0 nil nil nil) | |
41 | ("Foo-18:" Foo 18.0 nil nil nil) | |
42 | ("Foo-18:light" Foo 18.0 light nil nil) | |
43 | ("Foo 10:weight=bold" ,(intern "Foo 10") nil bold nil nil) | |
44 | ("Foo-12:weight=bold" Foo 12.0 bold nil nil) | |
45 | ("Foo 8-20:slant=oblique" ,(intern "Foo 8") 20.0 nil oblique nil) | |
46 | ("Foo:light:roman" Foo nil light roman nil) | |
47 | ("Foo:italic:roman" Foo nil nil roman nil) | |
48 | ("Foo 12:light:oblique" ,(intern "Foo 12") nil light oblique nil) | |
49 | ("Foo-12:demibold:oblique" Foo 12.0 demibold oblique nil) | |
50 | ("Foo:black:proportional" Foo nil black nil 0) | |
51 | ("Foo-10:black:proportional" Foo 10.0 black nil 0) | |
52 | ("Foo:weight=normal" Foo nil normal nil nil) | |
53 | ("Foo:weight=bold" Foo nil bold nil nil) | |
54 | ("Foo:weight=bold:slant=italic" Foo nil bold italic) | |
55 | ("Foo:weight=bold:slant=italic:mono" Foo nil bold italic 100) | |
56 | ("Foo-10:demibold:slant=normal" Foo 10.0 demibold normal nil) | |
57 | ("Foo 11-16:oblique:weight=bold" ,(intern "Foo 11") 16.0 bold oblique nil) | |
58 | ("Foo:oblique:randomprop=randomtag:weight=bold" Foo nil bold oblique nil) | |
59 | ("Foo:randomprop=randomtag:bar=baz" Foo nil nil nil nil) | |
60 | ("Foo Book Light:bar=baz" ,(intern "Foo Book Light") nil nil nil nil) | |
61 | ("Foo Book Light 10:bar=baz" ,(intern "Foo Book Light 10") nil nil nil nil) | |
62 | ("Foo Book Light-10:bar=baz" ,(intern "Foo Book Light") 10.0 nil nil nil) | |
63 | ;; GTK format | |
64 | ("Oblique" nil nil nil oblique nil) | |
65 | ("Bold 17" nil 17.0 bold nil nil) | |
66 | ("17 Bold" ,(intern "17") nil bold nil nil) | |
67 | ("Book Oblique 2" nil 2.0 book oblique nil) | |
68 | ("Bar 7" Bar 7.0 nil nil nil) | |
69 | ("Bar Ultra-Light" Bar nil ultra-light nil nil) | |
70 | ("Bar Light 8" Bar 8.0 light nil nil) | |
71 | ("Bar Book Medium 9" Bar 9.0 medium nil nil) | |
72 | ("Bar Semi-Bold Italic 10" Bar 10.0 semi-bold italic nil) | |
73 | ("Bar Semi-Condensed Bold Italic 11" Bar 11.0 bold italic nil) | |
74 | ("Foo 10 11" ,(intern "Foo 10") 11.0 nil nil nil) | |
75 | ("Foo 1985 Book" ,(intern "Foo 1985") nil book nil nil) | |
76 | ("Foo 1985 A Book" ,(intern "Foo 1985 A") nil book nil nil) | |
77 | ("Foo 1 Book 12" ,(intern "Foo 1") 12.0 book nil nil) | |
78 | ("Foo A Book 12 A" ,(intern "Foo A Book 12 A") nil nil nil nil) | |
79 | ("Foo 1985 Book 12 Oblique" ,(intern "Foo 1985 Book 12") nil nil oblique nil) | |
80 | ("Foo 1985 Book 12 Italic 10" ,(intern "Foo 1985 Book 12") 10.0 nil italic nil) | |
81 | ("Foo Book Bar 6 Italic" ,(intern "Foo Book Bar 6") nil nil italic nil) | |
82 | ("Foo Book Bar Bold" ,(intern "Foo Book Bar") nil bold nil nil)) | |
83 | "List of font names parse data. | |
84 | Each element should have the form | |
85 | (NAME FAMILY SIZE WEIGHT SLANT SPACING) | |
86 | where NAME is the name to parse, and the remainder are the | |
87 | expected font properties from parsing NAME.") | |
88 | ||
89 | (defun font-parse-check (name prop expected) | |
90 | (let ((result (font-get (font-spec :name name) prop))) | |
91 | (if (and (symbolp result) (symbolp expected)) | |
92 | (eq result expected) | |
93 | (equal result expected)))) | |
94 | ||
95 | (put 'font-parse-check 'ert-explainer 'font-parse-explain) | |
96 | ||
97 | (defun font-parse-explain (name prop expected) | |
98 | (let ((result (font-get (font-spec :name name) prop)) | |
99 | (propname (symbol-name prop))) | |
100 | (format "Parsing `%s': expected %s `%s', got `%s'." | |
101 | name (substring propname 1) expected | |
102 | (font-get (font-spec :name name) prop)))) | |
103 | ||
104 | (ert-deftest font-parse-tests () | |
105 | "Test parsing of Fontconfig-style and GTK-style font names." | |
106 | (dolist (test font-parse-tests--data) | |
107 | (let* ((name (nth 0 test))) | |
108 | (should (font-parse-check name :family (nth 1 test))) | |
109 | (should (font-parse-check name :size (nth 2 test))) | |
110 | (should (font-parse-check name :weight (nth 3 test))) | |
111 | (should (font-parse-check name :slant (nth 4 test))) | |
112 | (should (font-parse-check name :spacing (nth 5 test)))))) | |
113 | ||
114 | ||
115 | (defun test-font-parse () | |
116 | "Test font name parsing." | |
117 | (interactive) | |
118 | (switch-to-buffer (generate-new-buffer "*Font Pase Test*")) | |
119 | (setq show-trailing-whitespace nil) | |
120 | (let ((pass-face '((t :foreground "green"))) | |
121 | (fail-face '((t :foreground "red")))) | |
122 | (dolist (test font-parse-tests--data) | |
123 | (let* ((name (nth 0 test)) | |
124 | (fs (font-spec :name name)) | |
125 | (family (font-get fs :family)) | |
126 | (size (font-get fs :size)) | |
127 | (weight (font-get fs :weight)) | |
128 | (slant (font-get fs :slant)) | |
129 | (spacing (font-get fs :spacing))) | |
130 | (insert name) | |
131 | (if (> (current-column) 20) | |
132 | (insert "\n")) | |
133 | (indent-to-column 21) | |
134 | (insert (propertize (symbol-name family) | |
135 | 'face (if (eq family (nth 1 test)) | |
136 | pass-face | |
137 | fail-face))) | |
138 | (indent-to-column 40) | |
139 | (insert (propertize (format "%s" size) | |
140 | 'face (if (equal size (nth 2 test)) | |
141 | pass-face | |
142 | fail-face))) | |
143 | (indent-to-column 48) | |
144 | (insert (propertize (format "%s" weight) | |
145 | 'face (if (eq weight (nth 3 test)) | |
146 | pass-face | |
147 | fail-face))) | |
148 | (indent-to-column 60) | |
149 | (insert (propertize (format "%s" slant) | |
150 | 'face (if (eq slant (nth 4 test)) | |
151 | pass-face | |
152 | fail-face))) | |
153 | (indent-to-column 69) | |
154 | (insert (propertize (format "%s" spacing) | |
155 | 'face (if (eq spacing (nth 5 test)) | |
156 | pass-face | |
157 | fail-face))) | |
158 | (insert "\n")))) | |
159 | (goto-char (point-min))) | |
160 | ||
c4c205d0 CY |
161 | ;; Local Variables: |
162 | ;; no-byte-compile: t | |
163 | ;; End: | |
164 | ||
372fb76b | 165 | ;;; font-parse-tests.el ends here. |