diff options
Diffstat (limited to 'test/lisp/emacs-lisp/faceup-tests')
| -rw-r--r-- | test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el | 287 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el | 63 |
2 files changed, 350 insertions, 0 deletions
diff --git a/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el new file mode 100644 index 00000000000..6009bfa836d --- /dev/null +++ b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el @@ -0,0 +1,287 @@ +;;; faceup-test-basics.el --- Tests for the `faceup' package. + +;; Copyright (C) 2014-2017 Free Software Foundation, Inc. + +;; Author: Anders Lindgren +;; Keywords: languages, faces + +;; 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 <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Basic tests for the `faceup' package. + +;;; Code: + +(require 'faceup) + +(ert-deftest faceup-functions () + "Test primitive functions." + (should (equal (faceup-normalize-face-property '()) '())) + (should (equal (faceup-normalize-face-property 'a) '(a))) + (should (equal (faceup-normalize-face-property '(a)) '(a))) + (should (equal (faceup-normalize-face-property '(:x t)) '((:x t)))) + (should (equal (faceup-normalize-face-property '(:x t a)) '((:x t)))) + (should (equal (faceup-normalize-face-property '(:x t a b)) '((:x t)))) + (should (equal (faceup-normalize-face-property '(a :x t)) '(a (:x t)))) + (should (equal (faceup-normalize-face-property '(a b :x t)) + '(a b (:x t)))) + + (should (equal (faceup-normalize-face-property '(:x t :y nil)) + '((:y nil) (:x t)))) + (should (equal (faceup-normalize-face-property '(:x t :y nil a)) + '((:y nil) (:x t)))) + (should (equal (faceup-normalize-face-property '(:x t :y nil a b)) + '((:y nil) (:x t)))) + (should (equal (faceup-normalize-face-property '(a :x t :y nil)) + '(a (:y nil) (:x t)))) + (should (equal (faceup-normalize-face-property '(a b :x t :y nil)) + '(a b (:y nil) (:x t))))) + + +(ert-deftest faceup-markup () + "Test basic `faceup' features." + ;; ---------- + ;; Basics + (should (equal (faceup-markup-string "") "")) + (should (equal (faceup-markup-string "test") "test")) + ;; ---------- + ;; Escaping + (should (equal (faceup-markup-string "«") "««")) + (should (equal (faceup-markup-string "«A«B«C«") "««A««B««C««")) + (should (equal (faceup-markup-string "»") "«»")) + (should (equal (faceup-markup-string "»A»B»C»") "«»A«»B«»C«»")) + ;; ---------- + ;; Plain property. + ;; + ;; UU + ;; ABCDEF + (let ((s "ABCDEF")) + (set-text-properties 2 4 '(face underline) s) + (should (equal (faceup-markup-string s) "AB«U:CD»EF"))) + ;; ---------- + ;; Plain property, full text + ;; + ;; UUUUUU + ;; ABCDEF + (let ((s "ABCDEF")) + (set-text-properties 0 6 '(face underline) s) + (should (equal (faceup-markup-string s) "«U:ABCDEF»"))) + ;; ---------- + ;; Anonymous face. + ;; + ;; AA + ;; ABCDEF + (let ((s "ABCDEF")) + (set-text-properties 2 4 '(face (:underline t)) s) + (should (equal (faceup-markup-string s) "AB«:(:underline t):CD»EF"))) + ;; ---------- + ;; Anonymous face -- plist with two keys. + ;; + ;; AA + ;; ABCDEF + (let ((s "ABCDEF")) + (set-text-properties 2 4 '(face (:foo t :bar nil)) s) + (should (equal (faceup-markup-string s) + "AB«:(:foo t):«:(:bar nil):CD»»EF"))) + ;; Ditto, with plist in list. + (let ((s "ABCDEF")) + (set-text-properties 2 4 '(face ((:foo t :bar nil))) s) + (should (equal (faceup-markup-string s) + "AB«:(:foo t):«:(:bar nil):CD»»EF"))) + ;; ---------- + ;; Anonymous face -- Two plists. + ;; + ;; AA + ;; ABCDEF + (let ((s "ABCDEF")) + (set-text-properties 2 4 '(face ((:foo t) (:bar nil))) s) + (should (equal (faceup-markup-string s) + "AB«:(:bar nil):«:(:foo t):CD»»EF"))) + ;; ---------- + ;; Anonymous face -- Nested. + ;; + ;; AA + ;; IIII + ;; ABCDEF + (let ((s "ABCDEF")) + (set-text-properties 1 2 '(face ((:foo t))) s) + (set-text-properties 2 4 '(face ((:bar t) (:foo t))) s) + (set-text-properties 4 5 '(face ((:foo t))) s) + (should (equal (faceup-markup-string s) + "A«:(:foo t):B«:(:bar t):CD»E»F"))) + ;; ---------- + ;; Nested properties. + ;; + ;; UU + ;; IIII + ;; ABCDEF + (let ((s "ABCDEF")) + (set-text-properties 1 2 '(face italic) s) + (set-text-properties 2 4 '(face (underline italic)) s) + (set-text-properties 4 5 '(face italic) s) + (should (equal (faceup-markup-string s) "A«I:B«U:CD»E»F"))) + ;; ---------- + ;; Overlapping, but not nesting, properties. + ;; + ;; UUU + ;; III + ;; ABCDEF + (let ((s "ABCDEF")) + (set-text-properties 1 2 '(face italic) s) + (set-text-properties 2 4 '(face (underline italic)) s) + (set-text-properties 4 5 '(face underline) s) + (should (equal (faceup-markup-string s) "A«I:B«U:CD»»«U:E»F"))) + ;; ---------- + ;; Overlapping, but not nesting, properties. + ;; + ;; III + ;; UUU + ;; ABCDEF + (let ((s "ABCDEF")) + (set-text-properties 1 2 '(face italic) s) + (set-text-properties 2 4 '(face (italic underline)) s) + (set-text-properties 4 5 '(face underline) s) + (should (equal (faceup-markup-string s) "A«I:B»«U:«I:CD»E»F"))) + ;; ---------- + ;; More than one face at the same location. + ;; + ;; The property to the front takes precedence, it is rendered as the + ;; innermost parenthesis pair. + (let ((s "ABCDEF")) + (set-text-properties 2 4 '(face (underline italic)) s) + (should (equal (faceup-markup-string s) "AB«I:«U:CD»»EF"))) + (let ((s "ABCDEF")) + (set-text-properties 2 4 '(face (italic underline)) s) + (should (equal (faceup-markup-string s) "AB«U:«I:CD»»EF"))) + ;; ---------- + ;; Equal ranges, full text. + (let ((s "ABCDEF")) + (set-text-properties 0 6 '(face (underline italic)) s) + (should (equal (faceup-markup-string s) "«I:«U:ABCDEF»»"))) + ;; Ditto, with stray markup characters. + (let ((s "AB«CD»EF")) + (set-text-properties 0 8 '(face (underline italic)) s) + (should (equal (faceup-markup-string s) "«I:«U:AB««CD«»EF»»"))) + + ;; ---------- + ;; Multiple properties + (let ((faceup-properties '(alpha beta gamma))) + ;; One property. + (let ((s "ABCDEF")) + (set-text-properties 2 4 '(alpha (a l p h a)) s) + (should (equal (faceup-markup-string s) "AB«(alpha):(a l p h a):CD»EF"))) + + ;; Two properties, inner enclosed. + (let ((s "ABCDEFGHIJ")) + (set-text-properties 2 8 '(alpha (a l p h a)) s) + (font-lock-append-text-property 4 6 'beta '(b e t a) s) + (should (equal (faceup-markup-string s) + "AB«(alpha):(a l p h a):CD«(beta):(b e t a):EF»GH»IJ"))) + + ;; Two properties, same end + (let ((s "ABCDEFGH")) + (set-text-properties 2 6 '(alpha (a)) s) + (add-text-properties 4 6 '(beta (b)) s) + (should + (equal + (faceup-markup-string s) + "AB«(alpha):(a):CD«(beta):(b):EF»»GH"))) + + ;; Two properties, overlap. + (let ((s "ABCDEFGHIJ")) + (set-text-properties 2 6 '(alpha (a)) s) + (add-text-properties 4 8 '(beta (b)) s) + (should + (equal + (faceup-markup-string s) + "AB«(alpha):(a):CD«(beta):(b):EF»»«(beta):(b):GH»IJ"))))) + + +(ert-deftest faceup-clean () + "Test the clean features of `faceup'." + (should (equal (faceup-clean-string "") "")) + (should (equal (faceup-clean-string "test") "test")) + (should (equal (faceup-clean-string "AB«U:CD»EF") "ABCDEF")) + (should (equal (faceup-clean-string "«U:ABCDEF»") "ABCDEF")) + (should (equal (faceup-clean-string "A«I:B«U:CD»E»F") "ABCDEF")) + (should (equal (faceup-clean-string "A«I:B«U:CD»»«U:E»F") "ABCDEF")) + (should (equal (faceup-clean-string "AB«I:«U:CD»»EF") "ABCDEF")) + (should (equal (faceup-clean-string "«I:«U:ABCDEF»»") "ABCDEF")) + (should (equal (faceup-clean-string "«(foo)I:ABC»DEF") "ABCDEF")) + (should (equal (faceup-clean-string "«:(:foo t):ABC»DEF") "ABCDEF")) + ;; Escaped markup characters. + (should (equal (faceup-clean-string "««") "«")) + (should (equal (faceup-clean-string "«»") "»")) + (should (equal (faceup-clean-string "A«I:B«U:CD»«»»«U:E»F") "ABCD»EF"))) + + +(ert-deftest faceup-render () + "Test the render features of `faceup'." + (should (equal (faceup-render-string "") "")) + (should (equal (faceup-render-string "««") "«")) + (should (equal (faceup-render-string "«»") "»")) + (should (equal (faceup-render-string "A«I:B«U:CD»«»»«U:E»F") "ABCD»EF"))) + + +(defvar faceup-test-resources-directory + (concat (file-name-directory + (substring (faceup-this-file-directory) 0 -1)) + "faceup-resources/") + "The `faceup-resources' directory.") + + +(defvar faceup-test-this-file-directory nil + "The result of `faceup-this-file-directory' in various contexts. + +This is set by the file test support file +`faceup-test-this-file-directory.el'.") + + +(ert-deftest faceup-directory () + "Test `faceup-this-file-directory'." + (let ((file (concat faceup-test-resources-directory + "faceup-test-this-file-directory.el")) + (load-file-name nil)) + ;; Test normal load. + (makunbound 'faceup-test-this-file-directory) + (load file nil :nomessage) + (should (equal faceup-test-this-file-directory + faceup-test-resources-directory)) + ;; Test `eval-buffer'. + (makunbound 'faceup-test-this-file-directory) + (save-excursion + (find-file file) + (eval-buffer)) + (should (equal faceup-test-this-file-directory + faceup-test-resources-directory)) + ;; Test `eval-defun'. + (makunbound 'faceup-test-this-file-directory) + (save-excursion + (find-file file) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + ;; Note: In batch mode, this prints the result of the + ;; evaluation. Unfortunately, this is hard to fix. + (eval-defun nil) + (forward-sexp)))) + (should (equal faceup-test-this-file-directory + faceup-test-resources-directory)))) + +(provide 'faceup-test-basics) + +;;; faceup-test-basics.el ends here diff --git a/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el b/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el new file mode 100644 index 00000000000..0f136862094 --- /dev/null +++ b/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el @@ -0,0 +1,63 @@ +;;; faceup-test-files.el --- Self test of `faceup' using dummy major mode. + +;; Copyright (C) 2014-2017 Free Software Foundation, Inc. + +;; Author: Anders Lindgren +;; Keywords: languages, faces + +;; 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 <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Self test of `faceup' with a major mode that sets both the +;; `syntax-table' and the `echo-help' property. +;; +;; This file can also be seen as a blueprint of test cases for real +;; major modes. + +;;; Code: + +(require 'faceup) + +;; Note: The byte compiler needs the value to load `faceup-test-mode', +;; hence the `eval-and-compile'. +(eval-and-compile + (defvar faceup-test-files-dir (faceup-this-file-directory) + "The directory of this file.")) + +(require 'faceup-test-mode + (concat faceup-test-files-dir + "../faceup-resources/" + "faceup-test-mode.el")) + +(defun faceup-test-files-check-one (file) + "Test that FILE is fontified as the .faceup file describes. + +FILE is interpreted as relative to this source directory." + (let ((faceup-properties '(face syntax-table help-echo))) + (faceup-test-font-lock-file 'faceup-test-mode + (concat + faceup-test-files-dir + "../faceup-resources/" + file)))) +(faceup-defexplainer faceup-test-files-check-one) + +(ert-deftest faceup-files () + (should (faceup-test-files-check-one "files/test1.txt"))) + +(provide 'faceup-test-files) + +;;; faceup-test-files.el ends here |