New package, `faceup'

`faceup' is a framework for regression testing of font-lock
keywords in ert.  It is based on a human-readable markup
language.  (Bug#16063 and bug#28311).

* lisp/emacs-lisp/faceup.el:
* test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el:
* test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el:
* test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el:
* test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el:
* test/lisp/emacs-lisp/faceup-resources/files/test1.txt:
* test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup:
New files.

7 files changed, 1671 insertions, 0 deletions

diff --git a/lisp/emacs-lisp/faceup.el b/lisp/emacs-lisp/faceup.el
new file mode 100644
index 00000000000..3a0f7e5c7a5
--- /dev/null
+++ b/lisp/emacs-lisp/faceup.el
@@ -0,0 +1,1183 @@
+;;; faceup.el --- Markup language for faces and font-lock regression testing  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
+
+;; Author: Anders Lindgren
+;; Version: 0.0.6
+;; Created: 2013-01-21
+;; Keywords: faces languages
+;; URL: https://github.com/Lindydancer/faceup
+
+;; 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:
+
+;; Emacs is capable of highlighting buffers based on language-specific
+;; `font-lock' rules.  This package makes it possible to perform
+;; regression test for packages that provide font-lock rules.
+;;
+;; The underlying idea is to convert text with highlights ("faces")
+;; into a plain text representation using the Faceup markup
+;; language.  This language is semi-human readable, for example:
+;;
+;;     «k:this» is a keyword
+;;
+;; By comparing the current highlight with a highlight performed with
+;; stable versions of a package, it's possible to automatically find
+;; problems that otherwise would have been hard to spot.
+;;
+;; This package is designed to be used in conjunction with Ert, the
+;; standard Emacs regression test system.
+;;
+;; The Faceup markup language is a generic markup language, regression
+;; testing is merely one way to use it.
+
+;; Regression test examples:
+;;
+;; This section describes the two typical ways regression testing with
+;; this package is performed.
+;;
+;;
+;; Full source file highlighting:
+;;
+;; The most straight-forward way to perform regression testing is to
+;; collect a number of representative source files.  From each source
+;; file, say `alpha.mylang', you can use `M-x faceup-write-file RET'
+;; to generate a Faceup file named `alpha.mylang.faceup', this file
+;; use the Faceup markup language to represent the text with
+;; highlights and is used as a reference in future tests.
+;;
+;; An Ert test case can be defined as follows:
+;;
+;;    (require 'faceup)
+;;
+;;    (defvar mylang-font-lock-test-dir (faceup-this-file-directory))
+;;
+;;    (defun mylang-font-lock-test-apps (file)
+;;      "Test that the mylang FILE is fontifies as the .faceup file describes."
+;;      (faceup-test-font-lock-file 'mylang-mode
+;;                                  (concat mylang-font-lock-test-dir file)))
+;;    (faceup-defexplainer mylang-font-lock-test-apps)
+;;
+;;    (ert-deftest mylang-font-lock-file-test ()
+;;      (should (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang"))
+;;      ;; ... Add more test files here ...
+;;      )
+;;
+;; To execute the tests, run something like `M-x ert RET t RET'.
+;;
+;;
+;; Source snippets:
+;;
+;; To test smaller snippets of code, you can use the
+;; `faceup-test-font-lock-string'.  It takes a major mode and a string
+;; written using the Faceup markup language.  The functions strips away
+;; the Faceup markup, inserts the plain text into a temporary buffer,
+;; highlights it, converts the result back into the Faceup markup
+;; language, and finally compares the result with the original Faceup
+;; string.
+;;
+;; For example:
+;;
+;;    (defun mylang-font-lock-test (faceup)
+;;      (faceup-test-font-lock-string 'mylang-mode faceup))
+;;    (faceup-defexplainer mylang-font-lock-test)
+;;
+;;    (ert-deftest mylang-font-lock-test-simple ()
+;;      "Simple MyLang font-lock tests."
+;;      (should (mylang-font-lock-test "«k:this» is a keyword"))
+;;      (should (mylang-font-lock-test "«k:function» «f:myfunc» («v:var»)")))
+;;
+
+;; Executing the tests:
+;;
+;; Once the tests have been defined, you can use `M-x ert RET t RET'
+;; to execute them.  Hopefully, you will be given the "all clear".
+;; However, if there is a problem, you will be presented with
+;; something like:
+;;
+;;     F mylang-font-lock-file-test
+;;         (ert-test-failed
+;;          ((should
+;;            (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang"))
+;;           :form
+;;           (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang")
+;;           :value nil :explanation
+;;           ((on-line 2
+;;              ("but_«k:this»_is_not_a_keyword")
+;;              ("but_this_is_not_a_keyword")))))
+;;
+;; You should read this that on line 2, the old font-lock rules
+;; highlighted `this' inside `but_this_is_not_a_keyword' (which is
+;; clearly wrong), whereas the new doesn't.  Of course, if this is the
+;; desired result (for example, the result of a recent change) you can
+;; simply regenerate the .faceup file and store it as the reference
+;; file for the future.
+
+;; The Faceup markup language:
+;;
+;; The Faceup markup language is designed to be human-readable and
+;; minimalistic.
+;;
+;; The two special characters `«' and `»' marks the start and end of a
+;; range of a face.
+;;
+;;
+;; Compact format for special faces:
+;;
+;; The compact format `«<LETTER>:text»' is used for a number of common
+;; faces.  For example, `«U:abc»' means that the text `abc' is
+;; underlined.
+;;
+;; See `faceup-face-short-alist' for the known faces and the
+;; corresponding letter.
+;;
+;;
+;; Full format:
+;;
+;; The format `«:<NAME OF FACE>:text»' is used use to encode other
+;; faces.
+;;
+;; For example `«:my-special-face:abc»' meanst that `abc' has the face
+;; `my-special-face'.
+;;
+;;
+;; Anonymous faces:
+;;
+;; An "anonymous face" is when the `face' property contains a property
+;; list (plist) on the form `(:key value)'.  This is represented using
+;; a variant of the full format: `«:(:key value):text»'.
+;;
+;; For example, `«:(:background "red"):abc»' represent the text `abc'
+;; with a red background.
+;;
+;;
+;; Multiple properties:
+;;
+;; In case a text contains more than one face property, they are
+;; represented using nested sections.
+;;
+;; For example:
+;;
+;; * `«B:abc«U:def»»' represent the text `abcdef' that is both *bold*
+;;   and *underlined*.
+;;
+;; * `«W:abc«U:def»ghi»' represent the text `abcdefghi' where the
+;;   entire text is in *warning* face and `def' is *underlined*.
+;;
+;; In case two faces partially overlap, the ranges will be split when
+;; represented in Faceup.  For example:
+;;
+;; * `«B:abc«U:def»»«U:ghi»' represent the text `abcdefghi' where
+;;   `abcdef' is bold and `defghi' is underlined.
+;;
+;;
+;; Escaping start and end markers:
+;;
+;; Any occurrence of the start or end markers in the original text
+;; will be escaped using the start marker in the Faceup
+;; representation.  In other words, the sequences `««' and `«»'
+;; represent a start and end marker, respectively.
+;;
+;;
+;; Other properties:
+;;
+;; In addition to representing the `face' property (or, more
+;; correctly, the value of `faceup-default-property') other properties
+;; can be encoded.  The variable `faceup-properties' contains a list of
+;; properties to track.  If a property behaves like the `face'
+;; property, it is encoded as described above, with the addition of
+;; the property name placed in parentheses, for example:
+;; `«(my-face)U:abd»'.
+;;
+;; The variable `faceup-face-like-properties' contains a list of
+;; properties considered face-like.
+;;
+;; Properties that are not considered face-like are always encoded
+;; using the full format and the don't nest.  For example:
+;; `«(my-fibonacci-property):(1 1 2 3 5 8):abd»'.
+;;
+;; Examples of properties that could be tracked are:
+;;
+;; * `font-lock-face' -- an alias to `face' when `font-lock-mode' is
+;;   enabled.
+;;
+;; * `syntax-table' -- used by a custom `syntax-propertize' to
+;;   override the default syntax table.
+;;
+;; * `help-echo' -- provides tooltip text displayed when the mouse is
+;;   held over a text.
+
+;; Reference section:
+;;
+;; Faceup commands and functions:
+;;
+;; `M-x faceup-write-file RET' - generate a Faceup file based on the
+;; current buffer.
+;;
+;; `M-x faceup-view-file RET' - view the current buffer converted to
+;; Faceup.
+;;
+;; `faceup-markup-{string,buffer}' - convert text with properties to
+;; the Faceup markup language.
+;;
+;; `faceup-render-view-buffer' - convert buffer with Faceup markup to
+;; a buffer with real text properties and display it.
+;;
+;; `faceup-render-string' - return string with real text properties
+;; from a string with Faceup markup.
+;;
+;; `faceup-render-to-{buffer,string}' - convert buffer with Faceup
+;; markup to a buffer/string with real text properties.
+;;
+;; `faceup-clean-{buffer,string}' - remove Faceup markup from buffer
+;; or string.
+;;
+;;
+;; Regression test support:
+;;
+;; The following functions can be used as Ert test functions, or can
+;; be used to implement new Ert test functions.
+;;
+;; `faceup-test-equal' - Test function, work like Ert:s `equal', but
+;; more ergonomically when reporting multi-line string errors.
+;; Concretely, it breaks down multi-line strings into lines and
+;; reports which line number the error occurred on and the content of
+;; that line.
+;;
+;; `faceup-test-font-lock-buffer' - Test that a buffer is highlighted
+;; according to a reference Faceup text, for a specific major mode.
+;;
+;; `faceup-test-font-lock-string' - Test that a text with Faceup
+;; markup is refontified to match the original Faceup markup.
+;;
+;; `faceup-test-font-lock-file' - Test that a file is highlighted
+;; according to a reference .faceup file.
+;;
+;; `faceup-defexplainer' - Macro, define an explainer function and set
+;; the `ert-explainer' property on the original function, for
+;; functions based on the above test functions.
+;;
+;; `faceup-this-file-directory' - Macro, the directory of the current
+;; file.
+
+;; Real-world examples:
+;;
+;; The following are examples of real-world package that use faceup to
+;; test their font-lock keywords.
+;;
+;; * [cmake-font-lock](https://github.com/Lindydancer/cmake-font-lock)
+;;   an advanced set of font-lock keywords for the CMake language
+;;
+;; * [objc-font-lock](https://github.com/Lindydancer/objc-font-lock)
+;;   highlight Objective-C function calls.
+;;
+
+;; Other Font Lock Tools:
+;;
+;; This package is part of a suite of font-lock tools.  The other
+;; tools in the suite are:
+;;
+;;
+;; Font Lock Studio:
+;;
+;; Interactive debugger for font-lock keywords (Emacs syntax
+;; highlighting rules).
+;;
+;; Font Lock Studio lets you *single-step* Font Lock keywords --
+;; matchers, highlights, and anchored rules, so that you can see what
+;; happens when a buffer is fontified.  You can set *breakpoints* on
+;; or inside rules and *run* until one has been hit.  When inside a
+;; rule, matches are *visualized* using a palette of background
+;; colors.  The *explainer* can describe a rule in plain-text English.
+;; Tight integration with *Edebug* allows you to step into Lisp
+;; expressions that are part of the Font Lock keywords.
+;;
+;;
+;; Font Lock Profiler:
+;;
+;; A profiler for font-lock keywords.  This package measures time and
+;; counts the number of times each part of a font-lock keyword is
+;; used.  For matchers, it counts the total number and the number of
+;; successful matches.
+;;
+;; The result is presented in table that can be sorted by count or
+;; time.  The table can be expanded to include each part of the
+;; font-lock keyword.
+;;
+;; In addition, this package can generate a log of all font-lock
+;; events.  This can be used to verify font-lock implementations,
+;; concretely, this is used for back-to-back tests of the real
+;; font-lock engine and Font Lock Studio, an interactive debugger for
+;; font-lock keywords.
+;;
+;;
+;; Highlight Refontification:
+;;
+;; Minor mode that visualizes how font-lock refontifies a buffer.
+;; This is useful when developing or debugging font-lock keywords,
+;; especially for keywords that span multiple lines.
+;;
+;; The background of the buffer is painted in a rainbow of colors,
+;; where each band in the rainbow represent a region of the buffer
+;; that has been refontified.  When the buffer is modified, the
+;; rainbow is updated.
+;;
+;;
+;; Face Explorer:
+;;
+;; Library and tools for faces and text properties.
+;;
+;; This library is useful for packages that convert syntax highlighted
+;; buffers to other formats.  The functions can be used to determine
+;; how a face or a face text property looks, in terms of primitive
+;; face attributes (e.g. foreground and background colors).  Two sets
+;; of functions are provided, one for existing frames and one for
+;; fictitious displays, like 8 color tty.
+;;
+;; In addition, the following tools are provided:
+;;
+;; - `face-explorer-list-faces' -- list all available faces.  Like
+;;   `list-faces-display' but with information on how a face is
+;;   defined.  In addition, a sample for the selected frame and for a
+;;   fictitious display is shown.
+;;
+;; - `face-explorer-describe-face' -- Print detailed information on
+;;   how a face is defined, and list all underlying definitions.
+;;
+;; - `face-explorer-describe-face-prop' -- Describe the `face' text
+;;   property at the point in terms of primitive face attributes.
+;;   Also show how it would look on a fictitious display.
+;;
+;; - `face-explorer-list-display-features' -- Show which features a
+;;   display supports.  Most graphical displays support all, or most,
+;;   features.  However, many tty:s don't support, for example,
+;;   strike-through.  Using specially constructed faces, the resulting
+;;   buffer will render differently in different displays, e.g. a
+;;   graphical frame and a tty connected using `emacsclient -nw'.
+;;
+;; - `face-explorer-list-face-prop-examples' -- Show a buffer with an
+;;   assortment of `face' text properties.  A sample text is shown in
+;;   four variants: Native, a manually maintained reference vector,
+;;   the result of `face-explorer-face-prop-attributes' and
+;;   `face-explorer-face-prop-attributes-for-fictitious-display'.  Any
+;;   package that convert a buffer to another format (like HTML, ANSI,
+;;   or LaTeX) could use this buffer to ensure that everything work as
+;;   intended.
+;;
+;; - `face-explorer-list-overlay-examples' -- Show a buffer with a
+;;   number of examples of overlays, some are mixed with `face' text
+;;   properties.  Any package that convert a buffer to another format
+;;   (like HTML, ANSI, or LaTeX) could use this buffer to ensure that
+;;   everything work as intended.
+;;
+;; - `face-explorer-tooltip-mode' -- Minor mode that shows tooltips
+;;   containing text properties and overlays at the mouse pointer.
+;;
+;; - `face-explorer-simulate-display-mode' -- Minor mode for make a
+;;   buffer look like it would on a fictitious display.  Using this
+;;   you can, for example, see how a theme would look in using dark or
+;;   light background, a 8 color tty, or on a grayscale graphical
+;;   monitor.
+;;
+;;
+;; Font Lock Regression Suite:
+;;
+;; A collection of example source files for a large number of
+;; programming languages, with ERT tests to ensure that syntax
+;; highlighting does not accidentally change.
+;;
+;; For each source file, font-lock reference files are provided for
+;; various Emacs versions.  The reference files contains a plain-text
+;; representation of source file with syntax highlighting, using the
+;; format "faceup".
+;;
+;; Of course, the collection source file can be used for other kinds
+;; of testing, not limited to font-lock regression testing.
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+
+(defvar faceup-default-property 'face
+  "The property that should be represented in Faceup without the (prop) part.")
+
+(defvar faceup-properties '(face)
+  "List of properties that should be converted to the Faceup format.
+
+Only face-like property use the short format.  All other use the
+non-nesting full format.  (See `faceup-face-like-properties'.)" )
+
+
+(defvar faceup-face-like-properties '(face font-lock-face)
+  "List of properties that behave like `face'.
+
+The following properties are assumed about face-like properties:
+
+* Elements are either symbols or property lists, or lists thereof.
+
+* A plain element and a list containing the same element are
+  treated as equal
+
+* Property lists and sequences of property lists are considered
+  equal.  For example:
+
+     ((:underline t :foreground \"red\"))
+
+  and
+
+     ((:underline t) (:foreground \"red\"))
+
+Face-like properties are converted to faceup in a nesting fashion.
+
+For example, the string AAAXXXAAA (where the property `prop' has
+the value `(a)' on the A:s and `(a b)' on the X:s) is converted
+as follows, when treated as a face-like property:
+
+    «(prop):a:AAA«(prop):b:XXX»AAAA»
+
+When treated as a non-face-like property:
+
+    «(prop):(a):AAA»«(prop):(a b):XXX»«(prop):(a):AAA»")
+
+
+(defvar faceup-markup-start-char 171)   ;; «
+(defvar faceup-markup-end-char   187)   ;; »
+
+(defvar faceup-face-short-alist
+  '(;; Generic faces (uppercase letters)
+    (bold                                . "B")
+    (bold-italic                         . "Q")
+    (default                             . "D")
+    (error                               . "E")
+    (highlight                           . "H")
+    (italic                              . "I")
+    (underline                           . "U")
+    (warning                             . "W")
+    ;; font-lock-specific faces (lowercase letters)
+    (font-lock-builtin-face              . "b")
+    (font-lock-comment-delimiter-face    . "m")
+    (font-lock-comment-face              . "x")
+    (font-lock-constant-face             . "c")
+    (font-lock-doc-face                  . "d")
+    (font-lock-function-name-face        . "f")
+    (font-lock-keyword-face              . "k")
+    (font-lock-negation-char-face        . "n")
+    (font-lock-preprocessor-face         . "p")
+    (font-lock-regexp-grouping-backslash . "h")
+    (font-lock-regexp-grouping-construct . "o")
+    (font-lock-string-face               . "s")
+    (font-lock-type-face                 . "t")
+    (font-lock-variable-name-face        . "v")
+    (font-lock-warning-face              . "w"))
+  "Alist from faces to one-character representation.")
+
+
+;; Plain: «W....»
+;; Nested: «W...«W...»»
+
+;; Overlapping:   xxxxxxxxxx
+;;                    yyyyyyyyyyyy
+;;                «X..«Y..»»«Y...»
+
+
+(defun faceup-markup-string (s)
+  "Return the faceup version of the string S."
+  (with-temp-buffer
+    (insert s)
+    (faceup-markup-buffer)))
+
+
+;;;###autoload
+(defun faceup-view-buffer ()
+  "Display the faceup representation of the current buffer."
+  (interactive)
+  (let ((buffer (get-buffer-create "*FaceUp*")))
+    (with-current-buffer buffer
+      (delete-region (point-min) (point-max)))
+    (faceup-markup-to-buffer buffer)
+    (display-buffer buffer)))
+
+
+;;;###autoload
+(defun faceup-write-file (&optional file-name confirm)
+  "Save the faceup representation of the current buffer to the file FILE-NAME.
+
+Unless a name is given, the file will be named xxx.faceup, where
+xxx is the file name associated with the buffer.
+
+If optional second arg CONFIRM is non-nil, this function
+asks for confirmation before overwriting an existing file.
+Interactively, confirmation is required unless you supply a prefix argument."
+  (interactive
+   (let ((suggested-name (and (buffer-file-name)
+                              (concat (buffer-file-name)
+                                      ".faceup"))))
+     (list (read-file-name "Write faceup file: "
+                           default-directory
+                           suggested-name
+                           nil
+                           (file-name-nondirectory suggested-name))
+           (not current-prefix-arg))))
+  (unless file-name
+    (setq file-name (concat (buffer-file-name) ".faceup")))
+  (let ((buffer (current-buffer)))
+    (with-temp-buffer
+      (faceup-markup-to-buffer (current-buffer) buffer)
+      ;; Note: Must set `require-final-newline' inside
+      ;; `with-temp-buffer', otherwise the value will be overridden by
+      ;; the buffers local value.
+      ;;
+      ;; Clear `window-size-change-functions' as a workaround for
+      ;; Emacs bug#19576 (`write-file' saves the wrong buffer if a
+      ;; function in the list change current buffer).
+      (let ((require-final-newline nil)
+            (window-size-change-functions '()))
+        (write-file file-name confirm)))))
+
+
+(defun faceup-markup-buffer ()
+  "Return a string with the content of the buffer using faceup markup."
+  (let ((buf (current-buffer)))
+    (with-temp-buffer
+      (faceup-markup-to-buffer (current-buffer) buf)
+      (buffer-substring-no-properties (point-min) (point-max)))))
+
+
+;; Idea:
+;;
+;; Typically, only one face is used. However, when two faces are used,
+;; the one of top is typically shorter. Hence, the faceup variant
+;; should treat the inner group of nested ranges the upper (i.e. the
+;; one towards the front.) For example:
+;;
+;;     «f:aaaaaaa«U:xxxx»aaaaaa»
+
+(defun faceup-copy-and-quote (start end to-buffer)
+  "Quote and insert the text between START and END into TO-BUFFER."
+  (let ((not-markup (concat "^"
+                            (make-string 1 faceup-markup-start-char)
+                            (make-string 1 faceup-markup-end-char))))
+    (save-excursion
+      (goto-char start)
+      (while (< (point) end)
+        (let ((old (point)))
+          (skip-chars-forward not-markup end)
+          (let ((s (buffer-substring-no-properties old (point))))
+            (with-current-buffer to-buffer
+              (insert s))))
+        ;; Quote stray markup characters.
+        (unless (= (point) end)
+          (let ((next-char (following-char)))
+            (with-current-buffer to-buffer
+              (insert faceup-markup-start-char)
+              (insert next-char)))
+          (forward-char))))))
+
+
+;; A face (string or symbol) can be on the top level.
+;;
+;; A face text property can be a arbitrary deep lisp structure.  Each
+;; list in the tree structure contains faces (symbols or strings) up
+;; to the first keyword, e.g. :foreground, thereafter the list is
+;; considered a property list, regardless of the content.  A special
+;; case are `(foreground-color . COLOR)' and `(background-color
+;; . COLOR)', old forms used to represent the foreground and
+;; background colors, respectively.
+;;
+;; Some of this is undocumented, and took some effort to reverse
+;; engineer.
+(defun faceup-normalize-face-property (value)
+  "Normalize VALUES into a list of faces and (KEY VALUE) entries."
+  (cond ((null value)
+         '())
+        ((symbolp value)
+         (list value))
+        ((stringp value)
+         (list (intern value)))
+        ((consp value)
+         (cond ((eq (car value) 'foreground-color)
+                (list (list :foreground (cdr value))))
+               ((eq (car value) 'background-color)
+                (list (list :background (cdr value))))
+               (t
+                ;; A list
+                (if (keywordp (car value))
+                    ;; Once a keyword has been seen, the rest of the
+                    ;; list is treated as a property list, regardless
+                    ;; of what it contains.
+                    (let ((res '()))
+                      (while value
+                        (let ((key (pop value))
+                              (val (pop value)))
+                          (when (keywordp key)
+                            (push (list key val) res))))
+                      res)
+                  (append
+                   (faceup-normalize-face-property (car value))
+                   (faceup-normalize-face-property (cdr value)))))))
+        (t
+         (error "Unexpected text property %s" value))))
+
+
+(defun faceup-get-text-properties (pos)
+  "Alist of properties and values at POS.
+
+Face-like properties are normalized -- value is a list of
+faces (symbols) and short (KEY VALUE) lists.  The list is
+reversed to that later elements take precedence over earlier."
+  (let ((res '()))
+    (dolist (prop faceup-properties)
+      (let ((value (get-text-property pos prop)))
+        (when value
+          (when (memq prop faceup-face-like-properties)
+            ;; Normalize face-like properties.
+            (setq value (reverse (faceup-normalize-face-property value))))
+          (push (cons prop value) res))))
+    res))
+
+
+(defun faceup-markup-to-buffer (to-buffer &optional buffer)
+  "Convert content of BUFFER to faceup form and insert in TO-BUFFER."
+  (save-excursion
+    (if buffer
+        (set-buffer buffer))
+    ;; Font-lock often only fontifies the visible sections. This
+    ;; ensures that the entire buffer is fontified before converting
+    ;; it.
+    (if (and font-lock-mode
+             ;; Prevent clearing out face attributes explicitly
+             ;; inserted by functions like `list-faces-display'.
+             ;; (Font-lock mode is enabled, for some reason, in those
+             ;; buffers.)
+             (not (and (eq major-mode 'help-mode)
+                       (not font-lock-defaults))))
+        (font-lock-fontify-region (point-min) (point-max)))
+    (let ((last-pos (point-min))
+          (pos nil)
+          ;; List of (prop . value), representing open faceup blocks.
+          (state '()))
+      (while (setq pos (faceup-next-property-change pos))
+        ;; Insert content.
+        (faceup-copy-and-quote last-pos pos to-buffer)
+        (setq last-pos pos)
+        (let ((prop-values (faceup-get-text-properties pos)))
+          (let ((next-state '()))
+            (setq state (reverse state))
+            ;; Find all existing sequences that should continue.
+            (let ((cont t))
+              (while (and state
+                          prop-values
+                          cont)
+                (let* ((prop (car (car state)))
+                       (value (cdr (car state)))
+                       (pair (assq prop prop-values)))
+                  (if (memq prop faceup-face-like-properties)
+                      ;; Element by element.
+                      (if (equal value (car (cdr pair)))
+                          (setcdr pair (cdr (cdr pair)))
+                        (setq cont nil))
+                    ;; Full value.
+                    ;;
+                    ;; Note: Comparison is done by `eq', since (at
+                    ;; least) the `display' property treats
+                    ;; eq-identical values differently than when
+                    ;; comparing using `equal'. See "Display Specs
+                    ;; That Replace The Text" in the elisp manual.
+                    (if (eq value (cdr pair))
+                        (setq prop-values (delq pair prop-values))
+                      (setq cont nil))))
+                (when cont
+                  (push (pop state) next-state))))
+            ;; End values that should not be included in the next state.
+            (while state
+              (with-current-buffer to-buffer
+                (insert (make-string 1 faceup-markup-end-char)))
+              (pop state))
+            ;; Start new ranges.
+            (with-current-buffer to-buffer
+              (while prop-values
+                (let ((pair (pop prop-values)))
+                  (if (memq (car pair) faceup-face-like-properties)
+                      ;; Face-like.
+                      (dolist (element (cdr pair))
+                        (insert (make-string 1 faceup-markup-start-char))
+                        (unless (eq (car pair) faceup-default-property)
+                          (insert "(")
+                          (insert (symbol-name (car pair)))
+                          (insert "):"))
+                        (if (symbolp element)
+                            (let ((short
+                                   (assq element faceup-face-short-alist)))
+                              (if short
+                                  (insert (cdr short) ":")
+                                (insert ":" (symbol-name element) ":")))
+                          (insert ":")
+                          (prin1 element (current-buffer))
+                          (insert ":"))
+                        (push (cons (car pair) element) next-state))
+                    ;; Not face-like.
+                    (insert (make-string 1 faceup-markup-start-char))
+                    (insert "(")
+                    (insert (symbol-name (car pair)))
+                    (insert "):")
+                    (prin1 (cdr pair) (current-buffer))
+                    (insert ":")
+                    (push pair next-state)))))
+            ;; Insert content.
+            (setq state next-state))))
+      ;; Insert whatever is left after the last face change.
+      (faceup-copy-and-quote last-pos (point-max) to-buffer))))
+
+
+
+;; Some basic facts:
+;;
+;; (get-text-property (point-max) ...) always return nil. To check the
+;; last character in the buffer, use (- (point-max) 1).
+;;
+;; If a text has more than one face, the first one in the list
+;; takes precedence, when being viewed in Emacs.
+;;
+;;   (let ((s "ABCDEF"))
+;;      (set-text-properties 1 4
+;;        '(face (font-lock-warning-face font-lock-variable-name-face)) s)
+;;      (insert s))
+;;
+;;   => ABCDEF
+;;
+;; Where DEF is drawn in "warning" face.
+
+
+(defun faceup-has-any-text-property (pos)
+  "True if any properties in `faceup-properties' are defined at POS."
+  (let ((res nil))
+    (dolist (prop faceup-properties)
+      (when (get-text-property pos prop)
+        (setq res t)))
+    res))
+
+
+(defun faceup-next-single-property-change (pos)
+  "Next position a property in `faceup-properties' changes after POS, or nil."
+  (let ((res nil))
+    (dolist (prop faceup-properties)
+      (let ((next (next-single-property-change pos prop)))
+        (when next
+          (setq res (if res
+                        (min res next)
+                      next)))))
+    res))
+
+
+(defun faceup-next-property-change (pos)
+  "Next position after POS where one of the tracked properties change.
+
+If POS is nil, also include `point-min' in the search.
+If last character contains a tracked property, return `point-max'.
+
+See `faceup-properties' for a list of tracked properties."
+  (if (eq pos (point-max))
+      ;; Last search returned `point-max'. There is no more to search
+      ;; for.
+      nil
+    (if (and (null pos)
+             (faceup-has-any-text-property (point-min)))
+        ;; `pos' is `nil' and the character at `point-min' contains a
+        ;; tracked property, return `point-min'.
+        (point-min)
+      (unless pos
+        ;; Start from the beginning.
+        (setq pos (point-min)))
+      ;; Do a normal search. Compensate for that
+      ;; `next-single-property-change' does not include the end of the
+      ;; buffer, even when a property reach it.
+      (let ((res (faceup-next-single-property-change pos)))
+        (if (and (not res)              ; No more found.
+                 (not (eq pos (point-max))) ; Not already at the end.
+                 (not (eq (point-min) (point-max))) ; Not an empty buffer.
+                 (faceup-has-any-text-property (- (point-max) 1)))
+            ;; If a property goes all the way to the end of the
+            ;; buffer, return `point-max'.
+            (point-max)
+          res)))))
+
+
+;; ----------------------------------------------------------------------
+;; Renderer
+;;
+
+;; Functions to convert from the faceup textual representation to text
+;; with real properties.
+
+(defun faceup-render-string (faceup)
+  "Return string with properties from FACEUP written with Faceup markup."
+  (with-temp-buffer
+    (insert faceup)
+    (faceup-render-to-string)))
+
+
+;;;###autoload
+(defun faceup-render-view-buffer (&optional buffer)
+  "Convert BUFFER containing Faceup markup to a new buffer and display it."
+  (interactive)
+  (with-current-buffer (or buffer (current-buffer))
+    (let ((dest-buffer (get-buffer-create "*FaceUp rendering*")))
+      (with-current-buffer dest-buffer
+        (delete-region (point-min) (point-max)))
+      (faceup-render-to-buffer dest-buffer)
+      (display-buffer dest-buffer))))
+
+
+(defun faceup-render-to-string (&optional buffer)
+  "Convert BUFFER containing faceup markup to a string with faces."
+  (unless buffer
+    (setq buffer (current-buffer)))
+  (with-temp-buffer
+    (faceup-render-to-buffer (current-buffer) buffer)
+    (buffer-substring (point-min) (point-max))))
+
+
+(defun faceup-render-to-buffer (to-buffer &optional buffer)
+  "Convert BUFFER containing faceup markup into text with faces in TO-BUFFER."
+  (with-current-buffer (or buffer (current-buffer))
+    (goto-char (point-min))
+    (let ((last-point (point))
+          (state '())                   ; List of (prop . element)
+          (not-markup (concat
+                       "^"
+                       (make-string 1 faceup-markup-start-char)
+                       (make-string 1 faceup-markup-end-char))))
+      (while (progn
+               (skip-chars-forward not-markup)
+               (if (not (eq last-point (point)))
+                   (let ((text (buffer-substring-no-properties
+                                last-point (point)))
+                         (prop-elements-alist '()))
+                     ;; Accumulate all values for each property.
+                     (dolist (prop-element state)
+                       (let ((property (car prop-element))
+                             (element (cdr prop-element)))
+                         (let ((pair (assq property prop-elements-alist)))
+                           (unless pair
+                             (setq pair (cons property '()))
+                             (push pair prop-elements-alist))
+                           (push element (cdr pair)))))
+                     ;; Apply all properties.
+                     (dolist (pair prop-elements-alist)
+                       (let ((property (car pair))
+                             (elements (reverse (cdr pair))))
+                         ;; Create one of:
+                         ;;    (property element) or
+                         ;;    (property (element element ...))
+                         (when (eq (length elements) 1)
+                           ;; This ensures that non-face-like
+                           ;; properties are restored to their
+                           ;; original state.
+                           (setq elements (car elements)))
+                         (add-text-properties 0 (length text)
+                                              (list property elements)
+                                              text)))
+                     (with-current-buffer to-buffer
+                       (insert text))
+                     (setq last-point (point))))
+               (not (eobp)))
+        (if (eq (following-char) faceup-markup-start-char)
+            ;; Start marker.
+            (progn
+              (forward-char)
+              (if (or (eq (following-char) faceup-markup-start-char)
+                      (eq (following-char) faceup-markup-end-char))
+                  ;; Escaped markup character.
+                  (progn
+                    (setq last-point (point))
+                    (forward-char))
+                ;; Markup sequence.
+                (let ((property faceup-default-property))
+                  (when (eq (following-char) ?\( )
+                    (forward-char)      ; "("
+                    (let ((p (point)))
+                      (forward-sexp)
+                      (setq property (intern (buffer-substring p (point)))))
+                    (forward-char))     ; ")"
+                  (let ((element
+                         (if (eq (following-char) ?:)
+                             ;; :element:
+                             (progn
+                               (forward-char)
+                               (prog1
+                                   (let ((p (point)))
+                                     (forward-sexp)
+                                     ;; Note: (read (current-buffer))
+                                     ;; doesn't work, as it reads more
+                                     ;; than a sexp.
+                                     (read (buffer-substring p (point))))
+                                 (forward-char)))
+                           ;; X:
+                           (prog1
+                               (car (rassoc (buffer-substring-no-properties
+                                             (point) (+ (point) 1))
+                                            faceup-face-short-alist))
+                             (forward-char 2)))))
+                    (push (cons property element) state)))
+                (setq last-point (point))))
+          ;; End marker.
+          (pop state)
+          (forward-char)
+          (setq last-point (point)))))))
+
+;; ----------------------------------------------------------------------
+
+;;;###autoload
+(defun faceup-clean-buffer ()
+  "Remove faceup markup from buffer."
+  (interactive)
+  (goto-char (point-min))
+  (let ((not-markup (concat
+                     "^"
+                     (make-string 1 faceup-markup-start-char)
+                     (make-string 1 faceup-markup-end-char))))
+    (while (progn (skip-chars-forward not-markup)
+                  (not (eobp)))
+      (if (eq (following-char) faceup-markup-end-char)
+          ;; End markers are always on their own.
+          (delete-char 1)
+        ;; Start marker.
+        (delete-char 1)
+        (if (or (eq (following-char) faceup-markup-start-char)
+                (eq (following-char) faceup-markup-end-char))
+            ;; Escaped markup character, delete the escape and skip
+            ;; the original character.
+            (forward-char)
+          ;; Property name (if present)
+          (if (eq (following-char) ?\( )
+              (let ((p (point)))
+                (forward-sexp)
+                (delete-region p (point))))
+          ;; Markup sequence.
+          (if (eq (following-char) ?:)
+              ;; :value:
+              (let ((p (point)))
+                (forward-char)
+                (forward-sexp)
+                (unless (eobp)
+                  (forward-char))
+                (delete-region p (point)))
+            ;; X:
+            (delete-char 1)             ; The one-letter form.
+            (delete-char 1)))))))       ; The colon.
+
+
+(defun faceup-clean-string (s)
+  "Remove faceup markup from string S."
+  (with-temp-buffer
+    (insert s)
+    (faceup-clean-buffer)
+    (buffer-substring (point-min) (point-max))))
+
+
+;; ----------------------------------------------------------------------
+;; Regression test support
+;;
+
+(defvar faceup-test-explain nil
+  "When non-nil, tester functions returns a text description on failure.
+
+Of course, this only work for test functions aware of this
+variable, like `faceup-test-equal' and functions based on this
+function.
+
+This is intended to be used to simplify `ert' explain functions,
+which could be defined as:
+
+    (defun my-test (args...) ...)
+    (defun my-test-explain (args...)
+      (let ((faceup-test-explain t))
+        (the-test args...)))
+    (put 'my-test 'ert-explainer 'my-test-explain)
+
+Alternative, you can use the macro `faceup-defexplainer' as follows:
+
+    (defun my-test (args...) ...)
+    (faceup-defexplainer my-test)
+
+Test functions, like `faceup-test-font-lock-buffer', built on top
+of `faceup-test-equal', and other functions that adhere to this
+variable, can easily define their own explainer functions.")
+
+;;;###autoload
+(defmacro faceup-defexplainer (function)
+  "Defines an Ert explainer function for FUNCTION.
+
+FUNCTION must return an explanation when the test fails and
+`faceup-test-explain' is set."
+  (let ((name (intern (concat (symbol-name function) "-explainer"))))
+    `(progn
+       (defun ,name (&rest args)
+         (let ((faceup-test-explain t))
+           (apply (quote ,function) args)))
+       (put (quote ,function) 'ert-explainer (quote ,name)))))
+
+
+;; ------------------------------
+;; Multi-line string support.
+;;
+
+(defun faceup-test-equal (lhs rhs)
+  "Compares two (multi-line) strings, LHS and RHS, for equality.
+
+This is intended to be used in Ert regression test rules.
+
+When `faceup-test-explain' is non-nil, instead of returning nil
+on inequality, a list is returned with a explanation what
+differs.  Currently, this function reports 1) if the number of
+lines in the strings differ.  2) the lines and the line numbers on
+which the string differed.
+
+For example:
+    (let ((a \"ABC\\nDEF\\nGHI\")
+          (b \"ABC\\nXXX\\nGHI\\nZZZ\")
+          (faceup-test-explain t))
+      (message \"%s\" (faceup-test-equal a b)))
+
+    ==> (4 3 number-of-lines-differ (on-line 2 (DEF) (XXX)))
+
+When used in an `ert' rule, the output is as below:
+
+    (ert-deftest faceup-test-equal-example ()
+      (let ((a \"ABC\\nDEF\\nGHI\")
+            (b \"ABC\\nXXX\\nGHI\\nZZZ\"))
+        (should (faceup-test-equal a b))))
+
+    F faceup-test-equal-example
+        (ert-test-failed
+         ((should
+           (faceup-test-equal a b))
+          :form
+          (faceup-test-equal \"ABC\\nDEF\\nGHI\" \"ABC\\nXXX\\nGHI\\nZZZ\")
+          :value nil :explanation
+          (4 3 number-of-lines-differ
+             (on-line 2
+                      (\"DEF\")
+                      (\"XXX\")))))"
+  (if (equal lhs rhs)
+      t
+    (if faceup-test-explain
+        (let ((lhs-lines (split-string lhs "\n"))
+              (rhs-lines (split-string rhs "\n"))
+              (explanation '())
+              (line 1))
+          (unless (= (length lhs-lines) (length rhs-lines))
+            (setq explanation (list 'number-of-lines-differ
+                                    (length lhs-lines) (length rhs-lines))))
+          (while lhs-lines
+            (let ((one (pop lhs-lines))
+                  (two (pop rhs-lines)))
+              (unless (equal one two)
+                (setq explanation
+                      (cons (list 'on-line line (list one) (list two))
+                            explanation)))
+              (setq line (+ line 1))))
+          (nreverse explanation))
+      nil)))
+
+(faceup-defexplainer faceup-test-equal)
+
+
+;; ------------------------------
+;; Font-lock regression test support.
+;;
+
+(defun faceup-test-font-lock-buffer (mode faceup &optional buffer)
+  "Verify that BUFFER is fontified as FACEUP for major mode MODE.
+
+If BUFFER is not specified the current buffer is used.
+
+Note that the major mode of the buffer is set to MODE and that
+the buffer is fontified.
+
+If MODE is a list, the first element is the major mode, the
+remaining are additional functions to call, e.g. minor modes."
+  (save-excursion
+    (if buffer
+        (set-buffer buffer))
+    (if (listp mode)
+        (dolist (m mode)
+          (funcall m))
+      (funcall mode))
+    (font-lock-fontify-region (point-min) (point-max))
+    (let ((result (faceup-markup-buffer)))
+      (faceup-test-equal faceup result))))
+
+(faceup-defexplainer faceup-test-font-lock-buffer)
+
+
+(defun faceup-test-font-lock-string (mode faceup)
+  "True if FACEUP is re-fontified as the faceup markup for major mode MODE.
+
+The string FACEUP is stripped from markup, inserted into a
+buffer, the requested major mode activated, the buffer is
+fontified, the result is again converted to the faceup form, and
+compared with the original string."
+  (with-temp-buffer
+    (insert faceup)
+    (faceup-clean-buffer)
+    (faceup-test-font-lock-buffer mode faceup)))
+
+(faceup-defexplainer faceup-test-font-lock-string)
+
+
+(defun faceup-test-font-lock-file (mode file &optional faceup-file)
+  "Verify that FILE is fontified as FACEUP-FILE for major mode MODE.
+
+If FACEUP-FILE is omitted, FILE.faceup is used."
+  (unless faceup-file
+    (setq faceup-file (concat file ".faceup")))
+  (let ((faceup (with-temp-buffer
+                  (insert-file-contents faceup-file)
+                  (buffer-substring-no-properties (point-min) (point-max)))))
+    (with-temp-buffer
+      (insert-file-contents file)
+      (faceup-test-font-lock-buffer mode faceup))))
+
+(faceup-defexplainer faceup-test-font-lock-file)
+
+
+;; ------------------------------
+;; Get current file directory. Test cases can use this to locate test
+;; files.
+;;
+
+(defun faceup-this-file-directory ()
+  "The directory of the file where the call to this function is located in.
+Intended to be called when a file is loaded."
+  (expand-file-name
+   (if load-file-name
+       ;; File is being loaded.
+       (file-name-directory load-file-name)
+     ;; File is being evaluated using, for example, `eval-buffer'.
+     default-directory)))
+
+
+;; ----------------------------------------------------------------------
+;; The end
+;;
+
+(provide 'faceup)
+
+;;; faceup.el ends here
diff --git a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
new file mode 100644
index 00000000000..ec2cf272368
--- /dev/null
+++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
@@ -0,0 +1,76 @@
+;;; faceup-test-mode.el --- Dummy major mode for testing `faceup'.
+
+;; 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:
+
+;; Dummy major-mode for testing `faceup', a regression test system for
+;; font-lock keywords (syntax highlighting rules for Emacs).
+;;
+;; This mode use `syntax-propertize' to set the `syntax-table'
+;; property on "<" and ">" in "<TEXT>" to make them act like
+;; parentheses.
+;;
+;; This mode also sets the `help-echo' property on the text WARNING,
+;; the effect is that Emacs displays a tooltip when you move your
+;; mouse on to the text.
+
+;;; Code:
+
+(defvar faceup-test-mode-syntax-table
+  (make-syntax-table)
+  "Syntax table for `faceup-test-mode'.")
+
+(defvar faceup-test-font-lock-keywords
+  '(("\\_<WARNING\\_>"
+     (0 (progn
+          (add-text-properties (match-beginning 0)
+                               (match-end 0)
+                               '(help-echo "Baloon tip: Fly smoothly!"))
+          font-lock-warning-face))))
+  "Highlight rules for `faceup-test-mode'.")
+
+(defun faceup-test-syntax-propertize (start end)
+  (goto-char start)
+  (funcall
+   (syntax-propertize-rules
+    ("\\(<\\)\\([^<>\n]*\\)\\(>\\)"
+     (1 "()  ")
+     (3 ")(  ")))
+   start end))
+
+(defmacro faceup-test-define-prog-mode (mode name &rest args)
+  "Define a major mode for a programming language.
+If `prog-mode' is defined, inherit from it."
+  (declare (indent defun))
+  `(define-derived-mode
+     ,mode ,(and (fboundp 'prog-mode) 'prog-mode)
+     ,name ,@args))
+
+(faceup-test-define-prog-mode faceup-test-mode "faceup-test"
+  "Dummy major mode for testing `faceup', a test system for font-lock."
+  (set (make-local-variable 'syntax-propertize-function)
+       #'faceup-test-syntax-propertize)
+  (setq font-lock-defaults '(faceup-test-font-lock-keywords nil)))
+
+(provide 'faceup-test-mode)
+
+;;; faceup-test-mode.el ends here
diff --git a/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el b/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
new file mode 100644
index 00000000000..e9d8b7074c2
--- /dev/null
+++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
@@ -0,0 +1,32 @@
+;;; faceup-test-this-file-directory.el --- Support file for faceup tests
+
+;; 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:
+
+;; Support file for `faceup-test-basics.el'. This file is used to test
+;; `faceup-this-file-directory' in various contexts.
+
+;;; Code:
+
+(defvar faceup-test-this-file-directory (faceup-this-file-directory))
+
+;;; faceup-test-this-file-directory.el ends here
diff --git a/test/lisp/emacs-lisp/faceup-resources/files/test1.txt b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt
new file mode 100644
index 00000000000..d971f364c2d
--- /dev/null
+++ b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt
@@ -0,0 +1,15 @@
+This is a test of `faceup', a regression test system for font-lock
+keywords. It should use major mode `faceup-test-mode'.
+
+WARNING: The first word on this line should use
+`font-lock-warning-face', and a tooltip should be displayed if the
+mouse pointer is moved over it.
+
+In this mode "<" and ">" are parentheses, but only when on the same
+line without any other "<" and ">" characters between them.
+<OK> <NOT <OK> >
+<
+NOT OK
+>
+
+test1.txt ends here.
diff --git a/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup
new file mode 100644
index 00000000000..7d4938adf17
--- /dev/null
+++ b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup
@@ -0,0 +1,15 @@
+This is a test of `faceup', a regression test system for font-lock
+keywords. It should use major mode `faceup-test-mode'.
+
+«(help-echo):"Baloon tip: Fly smoothly!":«w:WARNING»»: The first word on this line should use
+`font-lock-warning-face', and a tooltip should be displayed if the
+mouse pointer is moved over it.
+
+In this mode «s:"«(syntax-table):(4 . 41):<»"» and «s:"«(syntax-table):(5 . 40):>»"» are parentheses, but only when on the same
+line without any other «s:"«(syntax-table):(4 . 41):<»"» and «s:"«(syntax-table):(5 . 40):>»"» characters between them.
+«(syntax-table):(4 . 41):<»OK«(syntax-table):(5 . 40):>» <NOT «(syntax-table):(4 . 41):<»OK«(syntax-table):(5 . 40):>» >
+<
+NOT OK
+>
+
+test1.txt ends here.
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