diff --git a/doc/anim/string-escape-highlight.gif b/doc/anim/string-escape-highlight.gif new file mode 100644 index 000000000..a96617aae Binary files /dev/null and b/doc/anim/string-escape-highlight.gif differ diff --git a/doc/haskell-mode.texi b/doc/haskell-mode.texi index 9b37d4a97..f32af765c 100644 --- a/doc/haskell-mode.texi +++ b/doc/haskell-mode.texi @@ -250,6 +250,14 @@ control @code{font-lock-mode}. @image{anim/font-lock} @end ifhtml +Syntax highlighting facilities parse strings and string escape sequences +and are able to highlight unrecognized constructs. + +@ifhtml +@image{anim/string-escape-highlight} +@end ifhtml + + @section Managing imports There are a few functions for managing imports. diff --git a/haskell-font-lock.el b/haskell-font-lock.el index 085f5f405..22e072c24 100644 --- a/haskell-font-lock.el +++ b/haskell-font-lock.el @@ -28,14 +28,21 @@ (require 'cl-lib) (require 'haskell-compat) +(require 'haskell-lexeme) (require 'font-lock) +;;;###autoload +(defgroup haskell-appearance nil + "Haskell Appearance." + :group 'haskell) + + (defcustom haskell-font-lock-symbols nil "Display \\ and -> and such using symbols in fonts. This may sound like a neat trick, but be extra careful: it changes the alignment and can thus lead to nasty surprises with regards to layout." - :group 'haskell + :group 'haskell-appearance :type 'boolean) (defcustom haskell-font-lock-symbols-alist @@ -77,7 +84,7 @@ PREDICATE if present is a function of one argument (the start position of the symbol) which should return non-nil if this mapping should be disabled at that position." :type '(alist string string) - :group 'haskell) + :group 'haskell-appearance) (defun haskell-font-lock-dot-is-not-composition (start) "Return non-nil if the \".\" at START is not a composition operator. @@ -107,20 +114,20 @@ This is the case if the \".\" is part of a \"forall . \"." If a quasi quote is seen in Haskell code its contents will have font faces assigned as if respective mode was enabled." - :group 'haskell + :group 'haskell-appearance :type '(repeat (cons string symbol))) ;;;###autoload (defface haskell-keyword-face '((t :inherit font-lock-keyword-face)) "Face used to highlight Haskell keywords." - :group 'haskell) + :group 'haskell-appearance) ;;;###autoload (defface haskell-constructor-face '((t :inherit font-lock-type-face)) "Face used to highlight Haskell constructors." - :group 'haskell) + :group 'haskell-appearance) ;; This used to be `font-lock-variable-name-face' but it doesn't result in ;; a highlighting that's consistent with other modes (it's mostly used @@ -128,7 +135,7 @@ font faces assigned as if respective mode was enabled." (defface haskell-definition-face '((t :inherit font-lock-function-name-face)) "Face used to highlight Haskell definitions." - :group 'haskell) + :group 'haskell-appearance) ;; This is probably just wrong, but it used to use ;; `font-lock-function-name-face' with a result that was not consistent with @@ -137,20 +144,20 @@ font faces assigned as if respective mode was enabled." (defface haskell-operator-face '((t :inherit font-lock-variable-name-face)) "Face used to highlight Haskell operators." - :group 'haskell) + :group 'haskell-appearance) ;;;###autoload (defface haskell-pragma-face '((t :inherit font-lock-preprocessor-face)) "Face used to highlight Haskell pragmas." - :group 'haskell) + :group 'haskell-appearance) ;;;###autoload (defface haskell-literate-comment-face '((t :inherit font-lock-doc-face)) "Face with which to fontify literate comments. Inherit from `default' to avoid fontification of them." - :group 'haskell) + :group 'haskell-appearance) (defface haskell-quasi-quote-face '((t :inherit font-lock-string-face)) @@ -158,7 +165,7 @@ Inherit from `default' to avoid fontification of them." Some quote types are fontified according to other mode defined in `haskell-font-lock-quasi-quote-modes'." - :group 'haskell) + :group 'haskell-appearance) (defun haskell-font-lock-compose-symbol (alist) "Compose a sequence of ascii chars into a symbol. @@ -200,13 +207,13 @@ Regexp match data 0 points to the chars." ;; no face. So force evaluation by using `keep'. keep))))) -;; The font lock regular expressions. -(defun haskell-font-lock-keywords-create (literate) - "Create fontification definitions for Haskell scripts. -Returns keywords suitable for `font-lock-keywords'." +(defun haskell-font-lock-keywords () + ;; this has to be a function because it depends on global value of + ;; `haskell-font-lock-symbols' + "Generate font lock eywords." (let* (;; Bird-style literate scripts start a line of code with ;; "^>", otherwise a line of code starts with "^". - (line-prefix (if (eq literate 'bird) "^> ?" "^")) + (line-prefix "^\\(?:> ?\\)?") (varid "\\b[[:lower:]_][[:alnum:]'_]*\\b") ;; We allow ' preceding conids because of DataKinds/PolyKinds @@ -234,8 +241,7 @@ Returns keywords suitable for `font-lock-keywords'." (topdecl-var (concat line-prefix "\\(" varid "\\(?:\\s-*,\\s-*" varid "\\)*" "\\)\\s-*" ;; optionally allow for a single newline after identifier - ;; NOTE: not supported for bird-style .lhs files - (if (eq literate 'bird) nil "\\([\n]\\s-+\\)?") + "\\([\n]\\s-+\\)?" ;; A toplevel declaration can be followed by a definition ;; (=), a type (::) or (∷), a guard, or a pattern which can ;; either be a variable, a constructor, a parenthesized @@ -324,90 +330,6 @@ Returns keywords suitable for `font-lock-keywords'." 'haskell-operator-face)))) keywords)) -(defconst haskell-basic-syntactic-keywords - '(;; Character constants (since apostrophe can't have string syntax). - ;; Beware: do not match something like 's-}' or '\n"+' since the first ' - ;; might be inside a comment or a string. - ;; This still gets fooled with "'"'"'"'"'"', but ... oh well. - ("\\Sw\\('\\)\\([^\\'\n]\\|\\\\.[^\\'\n \"}]*\\)\\('\\)" (1 "\"") (3 "\"")) - ;; Deal with instances of `--' which don't form a comment - ("[!#$%&*+./:<=>?@^|~\\]*--[!#$%&*+./:<=>?@^|~\\-]*" (0 (cond ((or (nth 3 (syntax-ppss)) (numberp (nth 4 (syntax-ppss)))) - ;; There are no such instances inside - ;; nestable comments or strings - nil) - ((string-match "\\`-*\\'" (match-string 0)) - ;; Sequence of hyphens. Do nothing in - ;; case of things like `{---'. - nil) - ((string-match "\\`[^-]+--.*" (match-string 0)) - ;; Extra characters before comment starts - ".") - (t ".")))) ; other symbol sequence - - ;; Implement Haskell Report 'escape' and 'gap' rules. Backslash - ;; inside of a string is escaping unless it is preceeded by - ;; another escaping backslash. There can be whitespace between - ;; those two. - ;; - ;; Backslashes outside of string never escape. - ;; - ;; Note that (> 0 (skip-syntax-backward ".")) this skips over *escaping* - ;; backslashes only. - ("\\\\" (0 (when (save-excursion (and (nth 3 (syntax-ppss)) - (goto-char (match-beginning 0)) - (skip-syntax-backward "->") - (or (not (eq ?\\ (char-before))) - (> 0 (skip-syntax-backward "."))))) - "\\"))) - - ;; QuasiQuotes syntax: [quoter| string |], quoter is unqualified - ;; name, no spaces, string is arbitrary (including newlines), - ;; finishes at the first occurence of |], no escaping is provided. - ;; - ;; The quoter cannot be "e", "t", "d", or "p", since those overlap - ;; with Template Haskell quotations. - ;; - ;; QuasiQuotes opens only when outside of a string or a comment - ;; and closes only when inside a quasiquote. - ;; - ;; (syntax-ppss) returns list with two interesting elements: - ;; nth 3. non-nil if inside a string. (it is the character that will - ;; terminate the string, or t if the string should be terminated - ;; by a generic string delimiter.) - ;; nth 4. nil if outside a comment, t if inside a non-nestable comment, - ;; else an integer (the current comment nesting). - ;; - ;; Note also that we need to do in in a single pass, hence a regex - ;; that covers both the opening and the ending of a quasiquote. - - ("\\(\\[[[:alnum:]]+\\)?\\(|\\)\\(]\\)?" - (2 (save-excursion - (goto-char (match-beginning 0)) - (if (eq ?\[ (char-after)) - ;; opening case - (unless (or (nth 3 (syntax-ppss)) - (nth 4 (syntax-ppss)) - (member (match-string 1) - '("[e" "[t" "[d" "[p"))) - "\"") - ;; closing case - (when (and (eq ?| (nth 3 (syntax-ppss))) - (equal "]" (match-string 3)) - ) - "\""))))) - )) - -(defconst haskell-bird-syntactic-keywords - (cons '("^[^\n>]" (0 "<")) - haskell-basic-syntactic-keywords)) - -(defconst haskell-latex-syntactic-keywords - (append - '(("^\\\\begin{code}\\(\n\\)" 1 "!") - ;; Note: buffer is widened during font-locking. - ("\\`\\(.\\|\n\\)" (1 "!")) ; start comment at buffer start - ("^\\(\\\\\\)end{code}$" 1 "!")) - haskell-basic-syntactic-keywords)) (defun haskell-font-lock-fontify-block (lang-mode start end) "Fontify a block as LANG-MODE." @@ -456,20 +378,51 @@ Returns keywords suitable for `font-lock-keywords'." nil) ;; fontify normally as string because lang-mode is not present 'haskell-quasi-quote-face)) - 'font-lock-string-face)) - ;; Else comment. If it's from syntax table, use default face. - ((or (eq 'syntax-table (nth 7 state)) - (and (eq haskell-literate 'bird) - (memq (char-before (nth 8 state)) '(nil ?\n)))) + (save-excursion + (let + ((state2 + (parse-partial-sexp (point) (point-max) nil nil state + 'syntax-table)) + (end-of-string (point))) + + (put-text-property (nth 8 state) (point) + 'face 'font-lock-string-face) + + + (if (or (equal t (nth 3 state)) (nth 3 state2)) + ;; This is an unterminated string constant, use warning + ;; face for the opening quote. + (put-text-property (nth 8 state) (1+ (nth 8 state)) + 'face 'font-lock-warning-face)) + + (goto-char (1+ (nth 8 state))) + (while (re-search-forward "\\\\" end-of-string t) + + (goto-char (1- (point))) + + (if (looking-at haskell-lexeme-string-literal-inside-item) + (goto-char (match-end 0)) + + ;; We are looking at an unacceptable escape + ;; sequence. Use warning face to highlight that. + (put-text-property (point) (1+ (point)) + 'face 'font-lock-warning-face) + (goto-char (1+ (point))))))) + ;; must return nil here so that it is not fontified again as string + nil)) + ;; Detect literate comment lines starting with syntax class '<' + ((save-excursion + (goto-char (nth 8 state)) + (equal (string-to-syntax "<") (syntax-after (point)))) 'haskell-literate-comment-face) ;; Detect pragmas. A pragma is enclosed in special comment ;; delimeters {-# .. #-}. ((save-excursion (goto-char (nth 8 state)) - (and (looking-at "{-#") + (and (looking-at-p "{-#") (forward-comment 1) (goto-char (- (point) 3)) - (looking-at "#-}"))) + (looking-at-p "#-}"))) 'haskell-pragma-face) ;; Haddock comment start with either "-- [|^*$]" or "{- ?[|^*$]" ;; (note space optional for nested comments and mandatory for @@ -485,8 +438,8 @@ Returns keywords suitable for `font-lock-keywords'." ;; comments newline is outside of comment. ((save-excursion (goto-char (nth 8 state)) - (or (looking-at "\\(?:{- ?\\|-- \\)[|^*$]") - (and (looking-at "--") ; are we at double dash comment + (or (looking-at-p "\\(?:{- ?\\|-- \\)[|^*$]") + (and (looking-at-p "--") ; are we at double dash comment (forward-line -1) ; this is nil on first line (eq (get-text-property (line-end-position) 'face) 'font-lock-doc-face) ; is a doc face @@ -496,40 +449,11 @@ Returns keywords suitable for `font-lock-keywords'." 'font-lock-doc-face) (t 'font-lock-comment-face))) -(defconst haskell-font-lock-keywords - (haskell-font-lock-keywords-create nil) - "Font lock definitions for non-literate Haskell.") - -(defconst haskell-font-lock-bird-literate-keywords - (haskell-font-lock-keywords-create 'bird) - "Font lock definitions for Bird-style literate Haskell.") - -(defconst haskell-font-lock-latex-literate-keywords - (haskell-font-lock-keywords-create 'latex) - "Font lock definitions for LaTeX-style literate Haskell.") - -;;;###autoload -(defun haskell-font-lock-choose-keywords () - (let ((literate (if (boundp 'haskell-literate) haskell-literate))) - (cl-case literate - (bird haskell-font-lock-bird-literate-keywords) - ((latex tex) haskell-font-lock-latex-literate-keywords) - (t haskell-font-lock-keywords)))) - -(defun haskell-font-lock-choose-syntactic-keywords () - (let ((literate (if (boundp 'haskell-literate) haskell-literate))) - (cl-case literate - (bird haskell-bird-syntactic-keywords) - ((latex tex) haskell-latex-syntactic-keywords) - (t haskell-basic-syntactic-keywords)))) - (defun haskell-font-lock-defaults-create () "Locally set `font-lock-defaults' for Haskell." (set (make-local-variable 'font-lock-defaults) - '(haskell-font-lock-choose-keywords - nil nil ((?\' . "w") (?_ . "w")) nil - (font-lock-syntactic-keywords - . haskell-font-lock-choose-syntactic-keywords) + '((haskell-font-lock-keywords) + nil nil nil nil (font-lock-syntactic-face-function . haskell-syntactic-face-function) ;; Get help from font-lock-syntactic-keywords. diff --git a/haskell-lexeme.el b/haskell-lexeme.el index 1de854fc9..4b2872968 100644 --- a/haskell-lexeme.el +++ b/haskell-lexeme.el @@ -129,6 +129,9 @@ Note that negative sign char is not part of a number.") "BEL" "BS" "HT" "LF" "VT" "FF" "CR" "SO" "SI" "DLE" "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB" "CAN" "EM" "SUB" "ESC" "FS" "GS" "RS" "US" "SP" "DEL" + (regexp "[0-9]+") + (: "x" (regexp "[0-9a-fA-F]+")) + (: "o" (regexp "[0-7]+")) (: "^" (regexp "[]A-Z@^_\\[]")) (regexp "[ \t\n\r\v\f]*\\\\"))))) "Regexp matching an item that is a single character or a single @@ -140,9 +143,11 @@ strictly only escape sequences defined in Haskell Report.") (defconst haskell-lexeme-string-literal (rx (: (group "\"") (group (* (| (regexp "\\\\[ \t\n\r\v\f]*\\\\") - "\\\"" - (regexp "[^\"\n]")))) - (group (| "\"" (regexp "$"))))) + (regexp "\\\\[ \t\n\r\v\f]+") + (regexp "\\\\[^ \t\n\r\v\f]") + (regexp "[^\"\n\\]")))) + (group (| "\"" (regexp "$") (regexp "\\\\?\\'") + )))) "Regexp matching a string literal lookalike. Note that `haskell-lexeme-string-literal' matches more than @@ -165,12 +170,12 @@ Regexp has subgroup expressions: (group (* (| (not (any "|")) (: "|" (not (any "]")))) )) - (group "|") - "]")) + (group (| "|" eos)) + (| "]" eos))) "Regexp matching a quasi quote literal. Quasi quotes start with '[xxx|' or '[$xxx|' sequence and end with -'|]'. The 'xxx' is quoter name There is no escaping mechanism +'|]'. The 'xxx' is a quoter name. There is no escaping mechanism provided for the ending sequence. Regexp has subgroup expressions: @@ -237,11 +242,22 @@ symbol or identifier can be done with: (haskell-lexeme-classify-by-first-char (char-after (match-beginning 1))) See `haskell-lexeme-classify-by-first-char' for details." - (skip-syntax-forward "->") + (while + ;; Due to how unterminated strings terminate at newline, some + ;; newlines have syntax set to generic string delimeter. We want + ;; those to be treated as whitespace anyway + (or + (> (skip-syntax-forward "->") 0) + (> (skip-chars-forward "\n") 0))) (let ((case-fold-search nil) (point (point-marker))) (or + (and + (equal (string-to-syntax "<") (syntax-after (point))) + (progn + (set-match-data (list point (set-marker (make-marker) (line-end-position)))) + 'literate-comment)) (and (looking-at "{-") (save-excursion (forward-comment 1) diff --git a/haskell-mode.el b/haskell-mode.el index 62fabad2a..a37f702ea 100644 --- a/haskell-mode.el +++ b/haskell-mode.el @@ -501,6 +501,97 @@ executable found in PATH.") table) "Syntax table used in Haskell mode.") +(defun haskell-syntax-propertize (begin end) + (save-excursion + (when haskell-literate + (goto-char begin) + ;; Algorithm (first matching rule wins): + ;; - current line is latex code if previous non-empty line was + ;; latex code or was \begin{code} and current line is not + ;; \end{code} + ;; - current line is bird code if it starts with > + ;; - else literate comment + (let ((previous-line-latex-code + (catch 'return + (save-excursion + (when (= (forward-line -1) 0) + (while (looking-at-p "^[\t ]*$") + (unless (= (forward-line -1) 0) + (throw 'return nil))) + (or + (and + (not (equal (string-to-syntax "<") (syntax-after (point)))) + (not (looking-at-p "^>"))) + (looking-at-p "^\\\\begin{code}[\t ]*$"))))))) + (while (< (point) end) + (unless (looking-at-p "^[\t ]*$") + (if previous-line-latex-code + (if (looking-at-p "^\\\\end{code}[\t ]*$") + (progn + (put-text-property (point) (1+ (point)) 'syntax-table (string-to-syntax "<")) + (setq previous-line-latex-code nil)) + ;; continue latex-code + ) + (if (looking-at-p "^>") + ;; this is a whitespace + (put-text-property (point) (1+ (point)) 'syntax-table (string-to-syntax "-")) + ;; this is a literate comment + (progn + (put-text-property (point) (1+ (point)) 'syntax-table (string-to-syntax "<")) + (when (looking-at-p "^\\\\begin{code}[\t ]*$") + (setq previous-line-latex-code t)))))) + (forward-line 1)))) + + (goto-char begin) + (let ((ppss (syntax-ppss))) + (when (nth 8 ppss) + ;; go to the beginning of a comment or string + (goto-char (nth 8 ppss)) + (when (equal "|" (nth 3 ppss)) + ;; if this is a quasi quote we need to backtrack even more + ;; to the opening bracket + (skip-chars-backward "^[") + (goto-char (1- (point))))) + + (while (< (point) end) + (let + ((token-kind (haskell-lexeme-looking-at-token))) + + (cond + ((equal token-kind 'qsymid) + (when (member + (haskell-lexeme-classify-by-first-char (char-after (match-beginning 1))) + '(varsym consym)) + ;; we have to neutralize potential comments here + (put-text-property (match-beginning 1) (match-end 1) 'syntax-table (string-to-syntax ".")))) + ((equal token-kind 'number) + (put-text-property (match-beginning 0) (match-end 0) 'syntax-table (string-to-syntax "w"))) + ((equal token-kind 'char) + (put-text-property (match-beginning 0) (1+ (match-beginning 0)) 'syntax-table (string-to-syntax "\"")) + (put-text-property (1- (match-end 0)) (match-end 0) 'syntax-table (string-to-syntax "\""))) + ((equal token-kind 'string) + (save-excursion + (goto-char (match-beginning 2)) + (let ((limit (match-end 2))) + (save-match-data + (while (re-search-forward "\"" limit t) + (put-text-property (match-beginning 0) (match-end 0) 'syntax-table (string-to-syntax "."))))) + ;; Place a generic string delimeter only when an open + ;; quote is closed by end-of-line Emacs acts strangely + ;; when a generic delimiter is not closed so in case + ;; string ends at the end of the buffer we will use + ;; plain string + (when (and (equal (match-beginning 3) (match-end 3)) + (not (equal (match-beginning 3) (point-max)))) + (put-text-property (match-beginning 1) (match-end 1) 'syntax-table (string-to-syntax "|")) + (put-text-property (match-beginning 3) (1+ (match-end 3)) 'syntax-table (string-to-syntax "|"))))) + ((equal token-kind 'template-haskell-quasi-quote) + (put-text-property (match-beginning 2) (match-end 2) 'syntax-table (string-to-syntax "\"")) + (put-text-property (match-beginning 4) (match-end 4) 'syntax-table (string-to-syntax "\"")))) + (if token-kind + (goto-char (match-end 0)) + (goto-char end))))))) + (defun haskell-ident-at-point () "Return the identifier under point, or nil if none found. May return a qualified name." @@ -659,6 +750,7 @@ Minor modes that work well with `haskell-mode': (set (make-local-variable 'comment-end-skip) "[ \t]*\\(-}\\|\\s>\\)") (set (make-local-variable 'forward-sexp-function) #'haskell-forward-sexp) (set (make-local-variable 'parse-sexp-ignore-comments) nil) + (set (make-local-variable 'syntax-propertize-function) #'haskell-syntax-propertize) ;; Set things up for eldoc-mode. (set (make-local-variable 'eldoc-documentation-function) @@ -668,10 +760,8 @@ Minor modes that work well with `haskell-mode': 'haskell-ds-create-imenu-index) ;; Set things up for font-lock. (set (make-local-variable 'font-lock-defaults) - '(haskell-font-lock-choose-keywords - nil nil ((?\' . "w") (?_ . "w")) nil - (font-lock-syntactic-keywords - . haskell-font-lock-choose-syntactic-keywords) + '((haskell-font-lock-keywords) + nil nil nil nil (font-lock-syntactic-face-function . haskell-syntactic-face-function) ;; Get help from font-lock-syntactic-keywords. diff --git a/tests/haskell-font-lock-tests.el b/tests/haskell-font-lock-tests.el index 616596b9f..58b805bbb 100644 --- a/tests/haskell-font-lock-tests.el +++ b/tests/haskell-font-lock-tests.el @@ -50,7 +50,7 @@ after a test as this aids interactive debugging." (haskell-mode) ,@body))) -(defun check-properties (lines props &optional literate) +(defun check-properties (lines-or-contents props &optional literate) "Check if syntax properties and font-lock properties as set properly. LINES is a list of strings that will be inserted to a new @@ -62,9 +62,12 @@ if all of its characters have syntax and face. See (kill-buffer "*haskell-mode-buffer*")) (save-current-buffer (set-buffer (get-buffer-create "*haskell-mode-buffer*")) - (dolist (line lines) - (insert line) - (insert "\n")) + (if (consp lines-or-contents) + (dolist (line lines-or-contents) + (insert line) + (insert "\n")) + (insert lines-or-contents)) + (if literate (literate-haskell-mode) (haskell-mode)) @@ -117,7 +120,6 @@ if all of its characters have syntax and face. See (ert-deftest haskell-syntactic-test-7b () "Take quotes and double quotes under control." - :expected-result :failed (check-properties ;; do not get fooled '("\"\'\"\'\"\'\"\'\"\'\"\'\"\'\"\'\"\' Cons") @@ -136,11 +138,11 @@ if all of its characters have syntax and face. See (check-properties '("\"\\ \\\\\\ \\ " " \\\" Cons") - '(("\\" "\\" t) ; 1st is escape + '(("\\" "." t) ; 1st is escape ("\\" "." t) ; 2nd is punctuation - ("\\" "\\" t) ; 3rd is escape + ("\\" "." t) ; 3rd is escape ("\\" "." t) ; 4th is punctuation - ("\\" "\\" t) ; 5th is escape + ("\\" "." t) ; 5th is escape ("\\" "." t) ; 6th is punctuation ("Cons" "w" haskell-constructor-face)))) @@ -237,7 +239,6 @@ if all of its characters have syntax and face. See (ert-deftest haskell-syntactic-string-vs-comment-escape () "Check string escape vs comment escape" - :expected-result :failed (check-properties ;; "\"" \-- Cons '("\"\\\"\" \\-- Cons") @@ -309,7 +310,6 @@ if all of its characters have syntax and face. See "Syntax for haddock comments" ;; Note: all of these are prefixed with space so that ;; top-level definition detection does not kick in. - :expected-result :failed (check-properties '(" 'a''b'" ; ('a','b') " 12'c'" ; (12,'c') @@ -551,7 +551,6 @@ if all of its characters have syntax and face. See 'literate)) (ert-deftest haskell-literate-mixed-1 () - :expected-result :failed ;; Although Haskell Report does not advice mixing modes, it is a ;; perfectly valid construct that we should support in syntax ;; highlighting. @@ -618,3 +617,24 @@ if all of its characters have syntax and face. See '("foo role = 3") '(("foo" "w" haskell-definition-face) ("role" "w" nil)))) + +(ert-deftest haskell-unterminated-string-1 () + (check-properties + '("foo = \"zonk" + " Cons") + '(("\"" "|" font-lock-warning-face) + ("zonk" t font-lock-string-face) + ("Cons" "w" haskell-constructor-face)))) + +(ert-deftest haskell-unterminated-string-2 () + (check-properties + '"foo = \"zonk" + '(("\"" "\"" font-lock-warning-face) + ("zonk" t font-lock-string-face)))) + +(ert-deftest haskell-unterminated-string-3 () + (check-properties + '"foo = \"zonk\\" + '(("\"" "\"" font-lock-warning-face) + ("zonk" t font-lock-string-face) + ("\\" t font-lock-warning-face)))) diff --git a/tests/haskell-lexeme-tests.el b/tests/haskell-lexeme-tests.el index 0714bfadc..8654ea351 100644 --- a/tests/haskell-lexeme-tests.el +++ b/tests/haskell-lexeme-tests.el @@ -5,7 +5,7 @@ (require 'haskell-mode) (require 'haskell-font-lock) -(defun check-lexemes (lines lexemes) +(defun check-lexemes (lines-or-contents lexemes &optional literate) "Checks if tokenization works as expected. LINES is a list of strings that will be inserted to a new @@ -18,12 +18,17 @@ order." ;; Note that all of this should work both in haskell-mode and ;; outside of it. Currently we test only haskell-mode setup. - (haskell-mode) - (font-lock-fontify-buffer) + (if literate + (literate-haskell-mode) + (haskell-mode)) + + (if (consp lines-or-contents) + (dolist (line lines-or-contents) + (insert line) + (insert "\n")) + (insert lines-or-contents)) - (dolist (line lines) - (insert line) - (insert "\n")) + (font-lock-fontify-buffer) (goto-char (point-min)) (let (current-token @@ -81,6 +86,13 @@ order." (ert-deftest haskell-lexeme-unicode-ids-1 () "Unicode ids" + (check-lexemes + '("Żółw.head,Data.żółw,Артур.Артур ") + '("Żółw.head" "," "Data.żółw" "," "Артур.Артур"))) + +(ert-deftest haskell-lexeme-unicode-ids-2 () + "Unicode ids, unicode as last character in line" + :expected-result :failed (check-lexemes '("Żółw.head,Data.żółw,Артур.Артур") '("Żółw.head" "," "Data.żółw" "," "Артур.Артур"))) @@ -175,6 +187,13 @@ order." '("\"\\\\\"") '("\"\\\\\""))) +(ert-deftest haskell-lexeme-string-literal-8 () + (check-lexemes + '("foo = \"zonk" + " Cons") + '("foo" "=" "\"zonk" + "Cons"))) + (ert-deftest haskell-lexeme-line-comment-1 () (check-lexemes '(" -- x " @@ -217,13 +236,37 @@ order." '("[xml| |]" "|" "]"))) (ert-deftest haskell-lexeme-quasi-quote-3 () - :expected-result :failed (check-lexemes - '("[xml| |") + "[xml| |" '("[xml| |"))) (ert-deftest haskell-lexeme-quasi-quote-4 () - :expected-result :failed (check-lexemes - '("[xml| ") + "[xml| " '("[xml| "))) + +(ert-deftest haskell-lexeme-literate-1 () + (check-lexemes + '("no code" + "\\begin{code}" + "code code" + "\\end{code}" + "no code no code") + '("no code" + "\\begin{code}" + "code" + "code" + "\\end{code}" + "no code no code") + 'literate)) + +(ert-deftest haskell-lexeme-literate-2 () + (check-lexemes + '("no code" + "> code code" + "no code") + '("no code" + "code" + "code" + "no code") + 'literate))