From: Chong Yidong Date: Thu, 27 Jan 2011 23:45:04 +0000 (-0500) Subject: Convert font parse testsuite to an ERT test. X-Git-Tag: emacs-pretest-24.0.90~104^2~618^2~1322^2~108 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=372fb76be972e1d8769a83331da3b87632b423b3;p=emacs.git 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. --- diff --git a/src/ChangeLog b/src/ChangeLog index 62782e63eef..2caec5e5d11 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2011-01-27 Chong Yidong + + * font.c (font_parse_fcname): Undefine a temporary macro. + 2011-01-26 Stefan Monnier Let the debugger continue to the normal handler (bug#7825). diff --git a/src/font.c b/src/font.c index 52b239569bd..449169dad1b 100644 --- a/src/font.c +++ b/src/font.c @@ -1513,6 +1513,7 @@ font_parse_fcname (char *name, Lisp_Object font) } } #undef PROP_MATCH +#undef PROP_SAVE if (family_end) ASET (font, FONT_FAMILY_INDEX, diff --git a/test/ChangeLog b/test/ChangeLog index b03e372b8b9..f555878cb49 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,8 @@ +2011-01-27 Chong Yidong + + * automated/font-parse-tests.el: Move from + font-parse-testsuite.el. + 2011-01-26 Chong Yidong * font-parse-testsuite.el (test-font-parse-data): New file. diff --git a/test/automated/font-parse-tests.el b/test/automated/font-parse-tests.el new file mode 100644 index 00000000000..5fc0f6c604f --- /dev/null +++ b/test/automated/font-parse-tests.el @@ -0,0 +1,163 @@ +;;; font-parse-tests.el --- Test suite for font parsing. + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Chong Yidong +;; Keywords: internal +;; Human-Keywords: internal + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; Type M-x test-font-parse RET to generate the test buffer. + +;; TODO: Convert to ERT format. + +;;; Code: + +(require 'ert) + +(defvar font-parse-tests--data + `((" " ,(intern " ") nil nil nil nil) + ("Monospace" Monospace 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 + ("Foo:" Foo nil nil nil nil) + ("Foo-8" Foo 8.0 nil nil nil) + ("Foo-18:" Foo 18.0 nil nil nil) + ("Foo-18:light" Foo 18.0 light nil nil) + ("Foo 10:weight=bold" ,(intern "Foo 10") nil bold nil nil) + ("Foo-12:weight=bold" Foo 12.0 bold nil nil) + ("Foo 8-20:slant=oblique" ,(intern "Foo 8") 20.0 nil oblique nil) + ("Foo:light:roman" Foo nil light roman nil) + ("Foo:italic:roman" Foo nil nil roman nil) + ("Foo 12:light:oblique" ,(intern "Foo 12") nil light oblique nil) + ("Foo-12:demibold:oblique" Foo 12.0 demibold oblique nil) + ("Foo:black:proportional" Foo nil black nil 0) + ("Foo-10:black:proportional" Foo 10.0 black nil 0) + ("Foo:weight=normal" Foo nil normal nil nil) + ("Foo:weight=bold" Foo nil bold nil nil) + ("Foo:weight=bold:slant=italic" Foo nil bold italic) + ("Foo:weight=bold:slant=italic:mono" Foo nil bold italic 100) + ("Foo-10:demibold:slant=normal" Foo 10.0 demibold normal nil) + ("Foo 11-16:oblique:weight=bold" ,(intern "Foo 11") 16.0 bold oblique nil) + ("Foo:oblique:randomprop=randomtag:weight=bold" Foo nil bold oblique 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 10:bar=baz" ,(intern "Foo Book Light 10") nil nil nil nil) + ("Foo Book Light-10:bar=baz" ,(intern "Foo Book Light") 10.0 nil nil nil) + ;; GTK format + ("Oblique" nil nil nil oblique nil) + ("Bold 17" nil 17.0 bold nil nil) + ("17 Bold" ,(intern "17") nil bold nil nil) + ("Book Oblique 2" nil 2.0 book oblique nil) + ("Bar 7" Bar 7.0 nil nil nil) + ("Bar Ultra-Light" Bar nil ultra-light nil nil) + ("Bar Light 8" Bar 8.0 light 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-Condensed Bold Italic 11" Bar 11.0 bold italic nil) + ("Foo 10 11" ,(intern "Foo 10") 11.0 nil nil nil) + ("Foo 1985 Book" ,(intern "Foo 1985") nil book nil nil) + ("Foo 1985 A Book" ,(intern "Foo 1985 A") nil book nil nil) + ("Foo 1 Book 12" ,(intern "Foo 1") 12.0 book nil nil) + ("Foo A Book 12 A" ,(intern "Foo A Book 12 A") nil nil nil nil) + ("Foo 1985 Book 12 Oblique" ,(intern "Foo 1985 Book 12") nil nil oblique nil) + ("Foo 1985 Book 12 Italic 10" ,(intern "Foo 1985 Book 12") 10.0 nil italic 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. +Each element should have the form + (NAME FAMILY SIZE WEIGHT SLANT SPACING) +where NAME is the name to parse, and the remainder are the +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 () + "Test font name parsing." + (interactive) + (switch-to-buffer (generate-new-buffer "*Font Pase Test*")) + (setq show-trailing-whitespace nil) + (let ((pass-face '((t :foreground "green"))) + (fail-face '((t :foreground "red")))) + (dolist (test font-parse-tests--data) + (let* ((name (nth 0 test)) + (fs (font-spec :name name)) + (family (font-get fs :family)) + (size (font-get fs :size)) + (weight (font-get fs :weight)) + (slant (font-get fs :slant)) + (spacing (font-get fs :spacing))) + (insert name) + (if (> (current-column) 20) + (insert "\n")) + (indent-to-column 21) + (insert (propertize (symbol-name family) + 'face (if (eq family (nth 1 test)) + pass-face + fail-face))) + (indent-to-column 40) + (insert (propertize (format "%s" size) + 'face (if (equal size (nth 2 test)) + pass-face + fail-face))) + (indent-to-column 48) + (insert (propertize (format "%s" weight) + 'face (if (eq weight (nth 3 test)) + pass-face + fail-face))) + (indent-to-column 60) + (insert (propertize (format "%s" slant) + 'face (if (eq slant (nth 4 test)) + pass-face + fail-face))) + (indent-to-column 69) + (insert (propertize (format "%s" spacing) + 'face (if (eq spacing (nth 5 test)) + pass-face + fail-face))) + (insert "\n")))) + (goto-char (point-min))) + +;;; font-parse-tests.el ends here. diff --git a/test/font-parse-testsuite.el b/test/font-parse-testsuite.el deleted file mode 100644 index 02923159e83..00000000000 --- a/test/font-parse-testsuite.el +++ /dev/null @@ -1,135 +0,0 @@ -;;; redisplay-testsuite.el --- Test suite for redisplay. - -;; Copyright (C) 2011 Free Software Foundation, Inc. - -;; Author: Chong Yidong -;; Keywords: internal -;; Human-Keywords: internal - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - -;;; Commentary: - -;; Type M-x test-font-parse RET to generate the test buffer. - -;; TODO: Convert to ERT format. - -;;; Code: - -(defvar test-font-parse-data - '((" " " " nil nil nil nil) - ("Monospace" "Monospace" nil nil nil nil) - ("Foo1" "Foo1" nil nil nil nil) - ("12" "nil" 12.0 nil nil nil) - ("12 " "12 " nil nil nil nil) - ;; Fontconfig format - ("Foo:" "Foo" nil nil nil nil) - ("Foo-8" "Foo" 8.0 nil nil nil) - ("Foo-18:" "Foo" 18.0 nil nil nil) - ("Foo-18:light" "Foo" 18.0 light nil nil) - ("Foo 10:weight=bold" "Foo 10" nil 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:light:roman" "Foo" nil light roman nil) - ("Foo:italic:roman" "Foo" nil nil roman nil) - ("Foo 12:light:oblique" "Foo 12" nil light oblique nil) - ("Foo-12:demibold:oblique" "Foo" 12.0 demibold oblique nil) - ("Foo:black:proportional" "Foo" nil black nil 0) - ("Foo-10:black:proportional" "Foo" 10.0 black nil 0) - ("Foo:weight=normal" "Foo" nil normal nil nil) - ("Foo:weight=bold" "Foo" nil bold nil nil) - ("Foo:weight=bold:slant=italic" "Foo" nil bold italic) - ("Foo:weight=bold:slant=italic:mono" "Foo" nil bold italic 100) - ("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:oblique:randomprop=randomtag:weight=bold" - "Foo" nil bold oblique nil) - ("Foo:randomprop=randomtag:bar=baz" "Foo" nil nil nil nil) - ("Foo Book Light:bar=baz" "Foo Book Light" nil nil nil nil) - ("Foo Book Light 10:bar=baz" "Foo Book Light 10" nil nil nil nil) - ("Foo Book Light-10:bar=baz" "Foo Book Light" 10.0 nil nil nil) - ;; GTK format - ("Oblique" "nil" nil nil oblique nil) - ("Bold 17" "nil" 17.0 bold nil nil) - ("17 Bold" "17" nil bold nil nil) - ("Book Oblique 2" "nil" 2.0 book oblique nil) - ("Bar 7" "Bar" 7.0 nil nil nil) - ("Bar Ultra-Light" "Bar" nil ultra-light nil nil) - ("Bar Light 8" "Bar" 8.0 light 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-Condensed Bold Italic 11" "Bar" 11.0 bold italic nil) - ("Foo 10 11" "Foo 10" 11.0 nil nil nil) - ("Foo 1985 Book" "Foo 1985" nil book nil nil) - ("Foo 1985 A Book" "Foo 1985 A" nil book nil nil) - ("Foo A Book 12 A" "Foo A Book 12 A" nil nil nil nil) - ("Foo 1985 Book 12 Oblique" "Foo 1985 Book 12" nil nil oblique nil) - ("Foo 1985 Book 12 Italic 10" "Foo 1985 Book 12" 10.0 nil italic nil) - ("Foo Book Bar 6 Italic" "Foo Book Bar 6" nil nil italic nil) - ("Foo Book Bar Bold" "Foo Book Bar" nil bold nil nil)) - "List of font names parse data. -Each element should have the form - (NAME FAMILY SIZE WEIGHT SLANT SPACING) -where NAME is the name to parse, and the remainder are the -expected font properties from parsing NAME.") - -(defun test-font-parse () - "Test font name parsing." - (interactive) - (switch-to-buffer (generate-new-buffer "*Font Pase Test*")) - (setq show-trailing-whitespace nil) - (let ((pass-face '((t :foreground "green"))) - (fail-face '((t :foreground "red")))) - (dolist (test test-font-parse-data) - (let* ((name (nth 0 test)) - (fs (font-spec :name name)) - (family (symbol-name (font-get fs :family))) - (size (font-get fs :size)) - (weight (font-get fs :weight)) - (slant (font-get fs :slant)) - (spacing (font-get fs :spacing))) - (insert name) - (if (> (current-column) 20) - (insert "\n")) - (indent-to-column 21) - (insert (propertize family - 'face (if (equal family (nth 1 test)) - pass-face - fail-face))) - (indent-to-column 40) - (insert (propertize (format "%s" size) - 'face (if (equal size (nth 2 test)) - pass-face - fail-face))) - (indent-to-column 48) - (insert (propertize (format "%s" weight) - 'face (if (eq weight (nth 3 test)) - pass-face - fail-face))) - (indent-to-column 60) - (insert (propertize (format "%s" slant) - 'face (if (eq slant (nth 4 test)) - pass-face - fail-face))) - (indent-to-column 69) - (insert (propertize (format "%s" spacing) - 'face (if (eq spacing (nth 5 test)) - pass-face - fail-face))) - (insert "\n")))) - (goto-char (point-min))) - -;;; font-parse-testsuite.el ends here.