Commit 372fb76b authored by Chong Yidong's avatar Chong Yidong

Convert font parse testsuite to an ERT test.

* test/automated/font-parse-tests.el: Move from
font-parse-testsuite.el.

* src/font.c (font_parse_fcname): Undefine a temporary macro.
parent 19cc6697
2011-01-27 Chong Yidong <cyd@stupidchicken.com>
* font.c (font_parse_fcname): Undefine a temporary macro.
2011-01-26 Stefan Monnier <monnier@iro.umontreal.ca> 2011-01-26 Stefan Monnier <monnier@iro.umontreal.ca>
Let the debugger continue to the normal handler (bug#7825). Let the debugger continue to the normal handler (bug#7825).
...@@ -1513,6 +1513,7 @@ font_parse_fcname (char *name, Lisp_Object font) ...@@ -1513,6 +1513,7 @@ font_parse_fcname (char *name, Lisp_Object font)
} }
} }
#undef PROP_MATCH #undef PROP_MATCH
#undef PROP_SAVE
if (family_end) if (family_end)
ASET (font, FONT_FAMILY_INDEX, ASET (font, FONT_FAMILY_INDEX,
......
2011-01-27 Chong Yidong <cyd@stupidchicken.com>
* automated/font-parse-tests.el: Move from
font-parse-testsuite.el.
2011-01-26 Chong Yidong <cyd@stupidchicken.com> 2011-01-26 Chong Yidong <cyd@stupidchicken.com>
* font-parse-testsuite.el (test-font-parse-data): New file. * font-parse-testsuite.el (test-font-parse-data): New file.
......
;;; redisplay-testsuite.el --- Test suite for redisplay. ;;; font-parse-tests.el --- Test suite for font parsing.
;; Copyright (C) 2011 Free Software Foundation, Inc. ;; Copyright (C) 2011 Free Software Foundation, Inc.
...@@ -29,63 +29,91 @@ ...@@ -29,63 +29,91 @@
;;; Code: ;;; Code:
(defvar test-font-parse-data (require 'ert)
'((" " " " nil nil nil nil)
("Monospace" "Monospace" nil nil nil nil) (defvar font-parse-tests--data
("Foo1" "Foo1" nil nil nil nil) `((" " ,(intern " ") nil nil nil nil)
("12" "nil" 12.0 nil nil nil) ("Monospace" Monospace nil nil nil nil)
("12 " "12 " nil nil nil nil) ("Foo1" Foo1 nil nil nil nil)
("12" nil 12.0 nil nil nil)
("12 " ,(intern "12 ") nil nil nil nil)
;; Fontconfig format ;; Fontconfig format
("Foo:" "Foo" nil nil nil nil) ("Foo:" Foo nil nil nil nil)
("Foo-8" "Foo" 8.0 nil nil nil) ("Foo-8" Foo 8.0 nil nil nil)
("Foo-18:" "Foo" 18.0 nil nil nil) ("Foo-18:" Foo 18.0 nil nil nil)
("Foo-18:light" "Foo" 18.0 light nil nil) ("Foo-18:light" Foo 18.0 light nil nil)
("Foo 10:weight=bold" "Foo 10" nil bold nil nil) ("Foo 10:weight=bold" ,(intern "Foo 10") nil bold nil nil)
("Foo-12:weight=bold" "Foo" 12.0 bold nil nil) ("Foo-12:weight=bold" Foo 12.0 bold nil nil)
("Foo 8-20:slant=oblique" "Foo 8" 20.0 nil oblique nil) ("Foo 8-20:slant=oblique" ,(intern "Foo 8") 20.0 nil oblique nil)
("Foo:light:roman" "Foo" nil light roman nil) ("Foo:light:roman" Foo nil light roman nil)
("Foo:italic:roman" "Foo" nil nil roman nil) ("Foo:italic:roman" Foo nil nil roman nil)
("Foo 12:light:oblique" "Foo 12" nil light oblique nil) ("Foo 12:light:oblique" ,(intern "Foo 12") nil light oblique nil)
("Foo-12:demibold:oblique" "Foo" 12.0 demibold oblique nil) ("Foo-12:demibold:oblique" Foo 12.0 demibold oblique nil)
("Foo:black:proportional" "Foo" nil black nil 0) ("Foo:black:proportional" Foo nil black nil 0)
("Foo-10:black:proportional" "Foo" 10.0 black nil 0) ("Foo-10:black:proportional" Foo 10.0 black nil 0)
("Foo:weight=normal" "Foo" nil normal nil nil) ("Foo:weight=normal" Foo nil normal nil nil)
("Foo:weight=bold" "Foo" nil bold nil nil) ("Foo:weight=bold" Foo nil bold nil nil)
("Foo:weight=bold:slant=italic" "Foo" nil bold italic) ("Foo:weight=bold:slant=italic" Foo nil bold italic)
("Foo:weight=bold:slant=italic:mono" "Foo" nil bold italic 100) ("Foo:weight=bold:slant=italic:mono" Foo nil bold italic 100)
("Foo-10:demibold:slant=normal" "Foo" 10.0 demibold normal nil) ("Foo-10:demibold:slant=normal" Foo 10.0 demibold normal nil)
("Foo 11-16:oblique:weight=bold" "Foo 11" 16.0 bold oblique nil) ("Foo 11-16:oblique:weight=bold" ,(intern "Foo 11") 16.0 bold oblique nil)
("Foo:oblique:randomprop=randomtag:weight=bold" ("Foo:oblique:randomprop=randomtag:weight=bold" Foo nil bold oblique nil)
"Foo" nil bold oblique nil) ("Foo:randomprop=randomtag:bar=baz" Foo nil nil nil nil)
("Foo:randomprop=randomtag:bar=baz" "Foo" nil nil nil nil) ("Foo Book Light:bar=baz" ,(intern "Foo Book Light") nil nil nil nil)
("Foo Book Light:bar=baz" "Foo Book Light" nil nil nil nil) ("Foo Book Light 10:bar=baz" ,(intern "Foo Book Light 10") nil nil nil nil)
("Foo Book Light 10:bar=baz" "Foo Book Light 10" nil nil nil nil) ("Foo Book Light-10:bar=baz" ,(intern "Foo Book Light") 10.0 nil nil nil)
("Foo Book Light-10:bar=baz" "Foo Book Light" 10.0 nil nil nil)
;; GTK format ;; GTK format
("Oblique" "nil" nil nil oblique nil) ("Oblique" nil nil nil oblique nil)
("Bold 17" "nil" 17.0 bold nil nil) ("Bold 17" nil 17.0 bold nil nil)
("17 Bold" "17" nil bold nil nil) ("17 Bold" ,(intern "17") nil bold nil nil)
("Book Oblique 2" "nil" 2.0 book oblique nil) ("Book Oblique 2" nil 2.0 book oblique nil)
("Bar 7" "Bar" 7.0 nil nil nil) ("Bar 7" Bar 7.0 nil nil nil)
("Bar Ultra-Light" "Bar" nil ultra-light nil nil) ("Bar Ultra-Light" Bar nil ultra-light nil nil)
("Bar Light 8" "Bar" 8.0 light nil nil) ("Bar Light 8" Bar 8.0 light nil nil)
("Bar Book Medium 9" "Bar" 9.0 medium nil nil) ("Bar Book Medium 9" Bar 9.0 medium nil nil)
("Bar Semi-Bold Italic 10" "Bar" 10.0 semi-bold italic nil) ("Bar Semi-Bold Italic 10" Bar 10.0 semi-bold italic nil)
("Bar Semi-Condensed Bold Italic 11" "Bar" 11.0 bold italic nil) ("Bar Semi-Condensed Bold Italic 11" Bar 11.0 bold italic nil)
("Foo 10 11" "Foo 10" 11.0 nil nil nil) ("Foo 10 11" ,(intern "Foo 10") 11.0 nil nil nil)
("Foo 1985 Book" "Foo 1985" nil book nil nil) ("Foo 1985 Book" ,(intern "Foo 1985") nil book nil nil)
("Foo 1985 A Book" "Foo 1985 A" nil book nil nil) ("Foo 1985 A Book" ,(intern "Foo 1985 A") nil book nil nil)
("Foo A Book 12 A" "Foo A Book 12 A" nil nil nil nil) ("Foo 1 Book 12" ,(intern "Foo 1") 12.0 book nil nil)
("Foo 1985 Book 12 Oblique" "Foo 1985 Book 12" nil nil oblique nil) ("Foo A Book 12 A" ,(intern "Foo A Book 12 A") nil nil nil nil)
("Foo 1985 Book 12 Italic 10" "Foo 1985 Book 12" 10.0 nil italic nil) ("Foo 1985 Book 12 Oblique" ,(intern "Foo 1985 Book 12") nil nil oblique nil)
("Foo Book Bar 6 Italic" "Foo Book Bar 6" nil nil italic nil) ("Foo 1985 Book 12 Italic 10" ,(intern "Foo 1985 Book 12") 10.0 nil italic nil)
("Foo Book Bar Bold" "Foo Book Bar" nil bold nil nil)) ("Foo Book Bar 6 Italic" ,(intern "Foo Book Bar 6") nil nil italic nil)
("Foo Book Bar Bold" ,(intern "Foo Book Bar") nil bold nil nil))
"List of font names parse data. "List of font names parse data.
Each element should have the form Each element should have the form
(NAME FAMILY SIZE WEIGHT SLANT SPACING) (NAME FAMILY SIZE WEIGHT SLANT SPACING)
where NAME is the name to parse, and the remainder are the where NAME is the name to parse, and the remainder are the
expected font properties from parsing NAME.") expected font properties from parsing NAME.")
(defun font-parse-check (name prop expected)
(let ((result (font-get (font-spec :name name) prop)))
(if (and (symbolp result) (symbolp expected))
(eq result expected)
(equal result expected))))
(put 'font-parse-check 'ert-explainer 'font-parse-explain)
(defun font-parse-explain (name prop expected)
(let ((result (font-get (font-spec :name name) prop))
(propname (symbol-name prop)))
(format "Parsing `%s': expected %s `%s', got `%s'."
name (substring propname 1) expected
(font-get (font-spec :name name) prop))))
(ert-deftest font-parse-tests ()
"Test parsing of Fontconfig-style and GTK-style font names."
(dolist (test font-parse-tests--data)
(let* ((name (nth 0 test)))
(should (font-parse-check name :family (nth 1 test)))
(should (font-parse-check name :size (nth 2 test)))
(should (font-parse-check name :weight (nth 3 test)))
(should (font-parse-check name :slant (nth 4 test)))
(should (font-parse-check name :spacing (nth 5 test))))))
(defun test-font-parse () (defun test-font-parse ()
"Test font name parsing." "Test font name parsing."
(interactive) (interactive)
...@@ -93,10 +121,10 @@ expected font properties from parsing NAME.") ...@@ -93,10 +121,10 @@ expected font properties from parsing NAME.")
(setq show-trailing-whitespace nil) (setq show-trailing-whitespace nil)
(let ((pass-face '((t :foreground "green"))) (let ((pass-face '((t :foreground "green")))
(fail-face '((t :foreground "red")))) (fail-face '((t :foreground "red"))))
(dolist (test test-font-parse-data) (dolist (test font-parse-tests--data)
(let* ((name (nth 0 test)) (let* ((name (nth 0 test))
(fs (font-spec :name name)) (fs (font-spec :name name))
(family (symbol-name (font-get fs :family))) (family (font-get fs :family))
(size (font-get fs :size)) (size (font-get fs :size))
(weight (font-get fs :weight)) (weight (font-get fs :weight))
(slant (font-get fs :slant)) (slant (font-get fs :slant))
...@@ -105,8 +133,8 @@ expected font properties from parsing NAME.") ...@@ -105,8 +133,8 @@ expected font properties from parsing NAME.")
(if (> (current-column) 20) (if (> (current-column) 20)
(insert "\n")) (insert "\n"))
(indent-to-column 21) (indent-to-column 21)
(insert (propertize family (insert (propertize (symbol-name family)
'face (if (equal family (nth 1 test)) 'face (if (eq family (nth 1 test))
pass-face pass-face
fail-face))) fail-face)))
(indent-to-column 40) (indent-to-column 40)
...@@ -132,4 +160,4 @@ expected font properties from parsing NAME.") ...@@ -132,4 +160,4 @@ expected font properties from parsing NAME.")
(insert "\n")))) (insert "\n"))))
(goto-char (point-min))) (goto-char (point-min)))
;;; font-parse-testsuite.el ends here. ;;; font-parse-tests.el ends here.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment