[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/bnf-mode b9a8446 25/36: Refactor test to use shorten fo
From: |
Stefan Monnier |
Subject: |
[elpa] externals/bnf-mode b9a8446 25/36: Refactor test to use shorten font lock helpers |
Date: |
Wed, 17 Mar 2021 18:40:18 -0400 (EDT) |
branch: externals/bnf-mode
commit b9a8446445bd6bb1c92641e454846f96e48f3e31
Author: Serghei Iakovlev <egrep@protonmail.ch>
Commit: Serghei Iakovlev <egrep@protonmail.ch>
Refactor test to use shorten font lock helpers
---
test/test-bnf-mode-font-lock.el | 174 ++++++++++++----------------------------
test/utils.el | 91 ++++++++++++++++++---
2 files changed, 133 insertions(+), 132 deletions(-)
diff --git a/test/test-bnf-mode-font-lock.el b/test/test-bnf-mode-font-lock.el
index 41ea0ca..7c3489f 100644
--- a/test/test-bnf-mode-font-lock.el
+++ b/test/test-bnf-mode-font-lock.el
@@ -46,128 +46,60 @@
(describe "BNF Fontification"
(it "does not fontify strings"
- (bnf-test-with-temp-buffer
- "<string delimers> ::= \" | ' | ` | ”"
- (should-not (bnf-get-face-at 23))
- (should-not (bnf-get-face-at 27))
- (should-not (bnf-get-face-at 31))
- (should-not (bnf-get-face-at 35))))
-
- (it "fontify line comments"
- (custom-set-variables '(bnf-mode-algol-comments-style nil))
- (bnf-test-with-temp-buffer
- "; A
-
-<stm> ::= <decl> ; foo"
- (should (eq (bnf-get-face-at 1) 'font-lock-comment-delimiter-face))
- (should (eq (bnf-get-face-at 3) 'font-lock-comment-face))
- (should-not (bnf-get-face-at 5))
- (should (eq (bnf-get-face-at 24) 'font-lock-comment-face))))
-
- ;; TODO(sergei): Implement me
- (it "fontify ALGOL comments"
- (custom-set-variables '(bnf-mode-algol-comments-style t))
- (bnf-test-with-temp-buffer "" ))
-
- (it "fontify nonterminals"
- (bnf-test-with-temp-buffer
- "<stm> ::= <decl>
-angle-brackets ::= are-optional"
- ;; angle bracket
- (should-not (bnf-get-face-at 1))
- ;; "stm"
- (should (eq (bnf-get-face-at 2) 'font-lock-function-name-face))
- (should (eq (bnf-get-face-at 4) 'font-lock-function-name-face))
- ;; angle bracket
- (should-not (bnf-get-face-at 5))
- ;; "::=" symbol
- (should (eq (bnf-get-face-at 7) 'font-lock-constant-face))
- (should (eq (bnf-get-face-at 9) 'font-lock-constant-face))
- ;; angle bracket
- (should-not (bnf-get-face-at 11))
- ;; "dec" symbol
- (should (eq (bnf-get-face-at 12) 'font-lock-builtin-face))
- (should (eq (bnf-get-face-at 15) 'font-lock-builtin-face))))
-
- (it "fontify nonterminals despite the case"
- (bnf-test-with-temp-buffer
- "<RULE> ::= <foo>
-<RuLe> ::= <foO>"
- (should (eq (bnf-get-face-at 2) 'font-lock-function-name-face))
- (should (eq (bnf-get-face-at 5) 'font-lock-function-name-face))
- (should-not (bnf-get-face-at 17))
- (should (eq (bnf-get-face-at 19) 'font-lock-function-name-face))
- (should (eq (bnf-get-face-at 22) 'font-lock-function-name-face))
- (should-not (bnf-get-face-at 23))
- (should (eq (bnf-get-face-at 30) 'font-lock-builtin-face))
- (should (eq (bnf-get-face-at 32) 'font-lock-builtin-face))
- (should-not (bnf-get-face-at 33))))
-
- (it "fontify nonterminals despite the indentation"
- (bnf-test-with-temp-buffer
- " <rule> ::= <foo>"
- (should-not (bnf-get-face-at 4))
- (should (eq (bnf-get-face-at 5) 'font-lock-function-name-face))
- (should (eq (bnf-get-face-at 6) 'font-lock-function-name-face))
- (should (eq (bnf-get-face-at 7) 'font-lock-function-name-face))
- (should (eq (bnf-get-face-at 8) 'font-lock-function-name-face))
- (should-not (bnf-get-face-at 9))))
-
- (it "fontify sequences"
- (bnf-test-with-temp-buffer
- "<rule> ::= <foo> <bar> <baz>"
- ;; "<" angle bracket
- (should-not (bnf-get-face-at 1))
- ;; "rule"
- (should (eq (bnf-get-face-at 2) 'font-lock-function-name-face))
- (should (eq (bnf-get-face-at 5) 'font-lock-function-name-face))
- ;; ">" angle bracket
- (should-not (bnf-get-face-at 6))
- ;; "foo"
- (should (eq (bnf-get-face-at 13) 'font-lock-builtin-face))
- (should (eq (bnf-get-face-at 15) 'font-lock-builtin-face))
- ;; space
- (should-not (bnf-get-face-at 17))
- ;; "bar"
- (should (eq (bnf-get-face-at 19) 'font-lock-builtin-face))
- (should (eq (bnf-get-face-at 21) 'font-lock-builtin-face))
- ;; space
- (should-not (bnf-get-face-at 23))
- ;; "baz"
- (should (eq (bnf-get-face-at 25) 'font-lock-builtin-face))
- (should (eq (bnf-get-face-at 27) 'font-lock-builtin-face))))
-
- (it "fontify alternatives"
- (bnf-test-with-temp-buffer
- "<foo> | <bar> | <baz>"
- ;; "foo"
- (should (eq (bnf-get-face-at 2) 'font-lock-builtin-face))
- (should (eq (bnf-get-face-at 4) 'font-lock-builtin-face))
- ;; "|"
- (should (eq (bnf-get-face-at 7) 'font-lock-warning-face))
- ;; "bar"
- (should (eq (bnf-get-face-at 10) 'font-lock-builtin-face))
- (should (eq (bnf-get-face-at 12) 'font-lock-builtin-face))
- ;; "|"
- (should (eq (bnf-get-face-at 15) 'font-lock-warning-face))
- ;; "baz"
- (should (eq (bnf-get-face-at 18) 'font-lock-builtin-face))
- (should (eq (bnf-get-face-at 20) 'font-lock-builtin-face))))
-
- (it "fontify rule punctuation"
- (bnf-test-with-temp-buffer
- "
-<proper string> ::=
+ (expect "<string delimers> ::= \" | ' | ` | ”"
+ :to-be-fontified-as
+ '(("string delimers" function-name "::=" constant "|" warning
+ "|" warning "|" warning))))
+
+ (it "fontifies line comments with default comments style"
+ (expect "; A
+ <stm> ::= <decl> ; foo"
+ :to-be-fontified-as
+ '(("; " comment-delimiter "A" comment)
+ ("stm" function-name "::=" constant "decl" builtin
+ "; foo" comment))))
+
+
+ ;; TODO(sergei): Add test for bnf-mode-algol-comments-style
+
+ (it "does not mix terminals and nonterminals"
+ (expect "<stm> ::= <decl>
+ angle-brackets ::= are-optional"
+ :to-be-fontified-as
+ '(("stm" function-name "::=" constant "decl" builtin)
+ ("::=" constant))))
+
+ (it "fontifies nonterminals despite the case"
+ (expect "<RULE> ::= <foo>
+ <RuLe> ::= <foO>"
+ :to-be-fontified-as
+ '(("RULE" function-name "::=" constant "foo" builtin)
+ ("RuLe" function-name "::=" constant "foO" builtin))))
+
+ (it "fontifies nonterminals despite the indentation"
+ (expect " <rule> ::= <subrule>"
+ :to-be-fontified-as
+ '(("rule" function-name "::=" constant "subrule" builtin))))
+
+ (it "fontifies sequences"
+ (expect "<rule> ::= <foo> <bar> <baz>"
+ :to-be-fontified-as
+ '(("rule" function-name "::=" constant "foo" builtin
+ "bar" builtin "baz" builtin))))
+
+ (it "fontifies alternatives"
+ (expect "<foo> | <bar> | <baz>"
+ :to-be-fontified-as
+ '(("foo" builtin "|" warning "bar" builtin
+ "|" warning "baz" builtin))))
+
+ (it "fontifies rule punctuation"
+ (expect "<proper string> ::=
<any sequence of symbols not containing ` or ' >
| <empty>"
- ;; "proper string"
- (should (eq (bnf-get-face-at 3) 'font-lock-function-name-face))
- (should (eq (bnf-get-face-at 15) 'font-lock-function-name-face))
- ;; "any sequence of symbols not containing ` or ' "
- (should (eq (bnf-get-face-at 31) 'font-lock-builtin-face))
- (should (eq (bnf-get-face-at 76) 'font-lock-builtin-face))
- ;; "empty"
- (should (eq (bnf-get-face-at 90) 'font-lock-builtin-face))
- (should (eq (bnf-get-face-at 94) 'font-lock-builtin-face)))))
+ :to-be-fontified-as
+ '(("proper string" function-name "::=" constant)
+ ("any sequence of symbols not containing ` or ' " builtin)
+ ("|" warning "empty" builtin)))))
;;; test-bnf-mode-font-lock.el ends here
diff --git a/test/utils.el b/test/utils.el
index d3da4d8..58848d9 100644
--- a/test/utils.el
+++ b/test/utils.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2019-2020 Free Software Foundation, Inc
;; Author: Serghei Iakovlev <egrep@protonmail.ch>
+;; immerrr <immerrr+lua@gmail.com>
;; Maintainer: Serghei Iakovlev <egrep@protonmail.ch>
;; Version: 0.4.4
;; URL: https://github.com/sergeyklay/bnf-mode
@@ -36,10 +37,10 @@
;; Don't load old byte-compiled versions
(load-prefer-newer t))
;; Load the file under test
- (load (expand-file-name "bnf-mode" source-directory)))
+ (load (expand-file-name "bnf-mode" source-directory) nil 'nomessage))
-(cl-defmacro bnf-test-with-temp-buffer (content &rest body)
- "Evaluate BODY in a temporary buffer with CONTENT."
+(cl-defmacro with-bnf-buffer (content &rest body)
+ "Evaluate BODY in a temporary BNF buffer with CONTENT."
(declare (debug t)
(indent 1))
`(with-temp-buffer
@@ -55,13 +56,81 @@
(unwind-protect
(progn ,@body))))
-(defun bnf-get-face-at (pos &optional content)
- "Get the face at POS in CONTENT.
-If CONTENT is not given, return the face at POS in the current
-buffer."
- (if content
- (bnf-test-with-temp-buffer content
- (get-text-property pos 'face))
- (get-text-property pos 'face)))
+(defun bnf-make-font-lock-faces (sym)
+ "Decorate SYM with font-lock-%s-face.
+If SYM is a list, this function will be called recursively to
+decorate each of symbol."
+ (or (cond
+ ((symbolp sym)
+ (intern-soft (format "font-lock-%s-face" (symbol-name sym))))
+ ((listp sym) (mapcar 'bnf-make-font-lock-faces sym)))
+ sym))
+
+(defun get-str-faces (str)
+ "Find contiguous spans of non-default faces in STR.
+E.g. for properly fontified Lua string \"local x = 100\" it should return
+ '(\"local\" font-lock-keyword-face
+ \"x\" font-lock-variable-name-face
+ \"100\" font-lock-constant-face)"
+ (let ((pos 0)
+ nextpos
+ result prop newprop)
+ (while pos
+ (setq nextpos (next-property-change pos str)
+ newprop (or (get-text-property pos 'face str)
+ (get-text-property pos 'font-lock-face str)))
+ (when (not (equal prop newprop))
+ (setq prop newprop)
+ (when (listp prop)
+ (when (eq (car-safe (last prop)) 'default)
+ (setq prop (butlast prop)))
+ (when (= 1 (length prop))
+ (setq prop (car prop)))
+ (when (symbolp prop)
+ (when (eq prop 'default)
+ (setq prop nil))))
+ (when prop
+ (push (substring-no-properties str pos nextpos) result)
+ (push prop result)))
+ (setq pos nextpos))
+ (nreverse result)))
+
+(defun bnf-get-line-faces (str)
+ "Find contiguous spans of non-default faces in each line of STR.
+The result is a list of lists."
+ (mapcar
+ 'get-str-faces
+ (split-string
+ (with-bnf-buffer str (buffer-string))
+ "\n" nil)))
+
+(defun to-be-fontified-as (text faces)
+ "Check that TEXT is fontified using FACES.
+Custom matcher to test font locking using `buttercup'."
+ (let ((expected-faces (bnf-make-font-lock-faces faces))
+ (result-faces (bnf-get-line-faces text))
+ (lineno 1))
+ (when (/= (length expected-faces) (length result-faces))
+ (buttercup-fail "\
+Fontification check failed for:
+%S
+ Text contains %d lines, face list contains %d lines"
+ text (length result-faces)
+ (length expected-faces)))
+ (while expected-faces
+ (unless (equal (car expected-faces) (car result-faces))
+ (buttercup-fail "\
+Fontification check failed on line %d for:
+%S
+ Result faces: %S
+ Expected faces: %S"
+ lineno text (car expected-faces) (car result-faces)))
+ (setq expected-faces (cdr expected-faces)
+ result-faces (cdr result-faces)
+ lineno (1+ lineno)))
+ (cons t "Fontification check passed")))
+
+(buttercup-define-matcher :to-be-fontified-as (text faces)
+ (to-be-fontified-as (funcall text) (funcall faces)))
;;; utils.el ends here
- [elpa] externals/bnf-mode 3d5c4fd 30/36: Cleaned up comments syntax propertize for ALGOL 60 style, (continued)
- [elpa] externals/bnf-mode 3d5c4fd 30/36: Cleaned up comments syntax propertize for ALGOL 60 style, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 5b223e8 34/36: Provide canonical BNF sytax, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 1b4f75f 06/36: Add field containing commit SHA expanded during archive creation, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 8799c4a 09/36: Add a workaround for ert-runner to work with Emacs > 26, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode d697e0a 10/36: Migrate tests to use buttercup, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 4ba8d28 14/36: Load undercover first to improve coverage report, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 62238ee 16/36: Cleaned up Makefile, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode a3b6d86 21/36: Update change log, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 8948987 20/36: Rename bnf-test-face-at => bnf-get-face-at, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 2756c7c 26/36: Use default abbrev table provided by define-derived-mode, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode b9a8446 25/36: Refactor test to use shorten font lock helpers,
Stefan Monnier <=
- [elpa] externals/bnf-mode d8cb802 27/36: Amended tests, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 27e45bd 31/36: Cleaned up syntax table, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode a4fe013 33/36: Bump version, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode e99dd39 35/36: Amended documentation, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 0f7ebc1 17/36: Move revision number to the common place, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 4d9ca0a 22/36: Updated documentation, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode e3489f3 24/36: Use years range in copyright notice, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 639628a 28/36: Added generic test suite, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 5856e25 29/36: Fixed comments recognition in ALGOL 60 style, Stefan Monnier, 2021/03/17
- [elpa] externals/bnf-mode 1e7e342 32/36: Removed support of ALGOL 60 style comments, Stefan Monnier, 2021/03/17