From dbe410d9ad6f656069566c8d32c38f04574c1ba9 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Fri, 1 Dec 2017 08:20:29 -0500 Subject: Fix faceup tests when run from elc String literals may be shared by the compiler, so the test string needs to be copied before adding properties to it. For single properties, just use a string literal with properties. * test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el (faceup-markup): Split into... (faceup-markup-basics, faceup-markup-escaping, faceup-markup-plain) (faceup-markup-plain-full-text, faceup-markup-anonymous-face) (faceup-markup-anonymous-face-2keys, faceup-markup-anonymous-nested) (faceup-markup-nested, faceup-markup-overlapping) (faceup-markup-multi-face, faceup-markup-multi-property): New tests. --- .../emacs-lisp/faceup-tests/faceup-test-basics.el | 218 ++++++++++----------- 1 file changed, 100 insertions(+), 118 deletions(-) (limited to 'test/lisp/emacs-lisp') diff --git a/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el index 6009bfa836d..fd58c1bbca6 100644 --- a/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el +++ b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el @@ -26,6 +26,7 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) (require 'faceup) (ert-deftest faceup-functions () @@ -52,163 +53,144 @@ '(a b (:y nil) (:x t))))) -(ert-deftest faceup-markup () - "Test basic `faceup' features." - ;; ---------- - ;; Basics +(ert-deftest faceup-markup-basics () (should (equal (faceup-markup-string "") "")) - (should (equal (faceup-markup-string "test") "test")) - ;; ---------- - ;; Escaping + (should (equal (faceup-markup-string "test") "test"))) + +(ert-deftest faceup-markup-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. - ;; + (should (equal (faceup-markup-string "»A»B»C»") "«»A«»B«»C«»"))) + +(ert-deftest faceup-markup-plain () ;; 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 - ;; + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face underline))) + "AB«U:CD»EF"))) + +(ert-deftest faceup-markup-plain-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. - ;; + (should (equal (faceup-markup-string + #("ABCDEF" 0 6 (face underline))) + "«U:ABCDEF»"))) + +(ert-deftest faceup-markup-anonymous-face () ;; 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. - ;; + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face (:underline t)))) + "AB«:(:underline t):CD»EF"))) + +(ert-deftest faceup-markup-anonymous-face-2keys () ;; 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. - ;; + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face (:foo t :bar nil)))) + "AB«:(:foo t):«:(:bar nil):CD»»EF")) + ;; Plist in list. + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face ((:foo t :bar nil))))) + "AB«:(:foo t):«:(:bar nil):CD»»EF")) + ;; Two plists. + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face ((:foo t) (:bar nil))))) + "AB«:(:bar nil):«:(:foo t):CD»»EF"))) + +(ert-deftest faceup-markup-anonymous-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. - ;; + (should (equal (faceup-markup-string + #("ABCDEF" + 1 2 (face ((:foo t))) + 2 4 (face ((:bar t) (:foo t))) + 4 5 (face ((:foo t))))) + "A«:(:foo t):B«:(:bar t):CD»E»F"))) + +(ert-deftest faceup-markup-nested () ;; 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. - ;; + (should (equal (faceup-markup-string + #("ABCDEF" + 1 2 (face italic) + 2 4 (face (underline italic)) + 4 5 (face italic))) + "A«I:B«U:CD»E»F"))) + +(ert-deftest faceup-markup-overlapping () ;; 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. - ;; + (should (equal (faceup-markup-string + #("ABCDEF" + 1 2 (face italic) + 2 4 (face (underline italic)) + 4 5 (face underline))) + "A«I:B«U:CD»»«U:E»F")) ;; 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"))) - ;; ---------- + (should (equal (faceup-markup-string + #("ABCDEF" + 1 2 (face italic) + 2 4 (face (italic underline)) + 4 5 (face underline))) + "A«I:B»«U:«I:CD»E»F"))) + +(ert-deftest faceup-markup-multi-face () ;; 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"))) - ;; ---------- + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face (underline italic)))) + "AB«I:«U:CD»»EF")) + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (face (italic underline)))) + "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»»"))) + (should (equal (faceup-markup-string + #("ABCDEF" 0 6 (face (underline italic)))) + "«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»»"))) + (should (equal (faceup-markup-string + #("AB«CD»EF" 0 8 (face (underline italic)))) + "«I:«U:AB««CD«»EF»»"))) - ;; ---------- - ;; Multiple properties +(ert-deftest faceup-markup-multi-property () (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"))) + (should (equal (faceup-markup-string + #("ABCDEF" 2 4 (alpha (a l p h a)))) + "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"))) + (should (equal (faceup-markup-string + (let ((s (copy-sequence "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) + 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"))) + (should (equal (faceup-markup-string + (let ((s (copy-sequence "ABCDEFGH"))) + (set-text-properties 2 6 '(alpha (a)) s) + (add-text-properties 4 6 '(beta (b)) s) + 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"))))) + (should (equal (faceup-markup-string + (let ((s (copy-sequence "ABCDEFGHIJ"))) + (set-text-properties 2 6 '(alpha (a)) s) + (add-text-properties 4 8 '(beta (b)) s) + s)) + "AB«(alpha):(a):CD«(beta):(b):EF»»«(beta):(b):GH»IJ")))) (ert-deftest faceup-clean () -- cgit v1.2.3