branch: elpa/haskell-tng-mode
commit 61f4c09420527298dc8a00ee7df027125f286ebf
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
[ci skip] unify the testing approach
---
haskell-tng-layout.el | 3 ++-
haskell-tng-util.el | 6 -----
test/haskell-tng-font-lock-test.el | 28 +++++++++++++-------
test/haskell-tng-layout-test.el | 47 +++++++++++++--------------------
test/haskell-tng-smie-test.el | 54 +++++++++++++-------------------------
test/haskell-tng-testutils.el | 42 +++++++++++++++++++++++++++++
test/src/layout.hs.faceup | 20 ++++++++++++++
test/src/layout.hs.layout | 1 +
test/src/medley.hs.layout | 1 +
9 files changed, 120 insertions(+), 82 deletions(-)
diff --git a/haskell-tng-layout.el b/haskell-tng-layout.el
index 121abd8..f1f9672 100644
--- a/haskell-tng-layout.el
+++ b/haskell-tng-layout.el
@@ -105,7 +105,8 @@ WLDO that is using the offside rule."
(while (not (eobp))
(forward-line)
(forward-comment (point-max))
- (when (= (current-column) level)
+ (when (and (= (current-column) level)
+ (not (eobp)))
(push (point) seps))
(when (< limit (point))
(throw 'closed limit))
diff --git a/haskell-tng-util.el b/haskell-tng-util.el
index 6b32759..6c1e27e 100644
--- a/haskell-tng-util.el
+++ b/haskell-tng-util.el
@@ -11,12 +11,6 @@
(require 'subr-x)
-(defmacro haskell-tng:this-lisp-directory ()
- (expand-file-name
- (if load-file-name
- (file-name-directory load-file-name)
- default-directory)))
-
(defun haskell-tng:paren-close (&optional pos)
"The next `)', if it closes `POS's paren depth."
(save-excursion
diff --git a/test/haskell-tng-font-lock-test.el
b/test/haskell-tng-font-lock-test.el
index 39d0e48..059fbd6 100644
--- a/test/haskell-tng-font-lock-test.el
+++ b/test/haskell-tng-font-lock-test.el
@@ -3,22 +3,30 @@
;; Copyright (C) 2018-2019 Tseen She
;; License: GPL 3 or any later version
-(require 'haskell-tng-mode)
-
(require 'ert)
(require 'faceup)
-;; FIXME: write over the file on failure
+(require 'haskell-tng-mode)
+(require 'haskell-tng-testutils
+ "test/haskell-tng-testutils.el")
+
+;; Not using `faceup-defexplainer' because it doesn't write over files.
+(defun haskell-tng-font-lock-test:parse-to-string ()
+ (font-lock-fontify-region (point-min) (point-max))
+ (faceup-markup-buffer))
+
(defun have-expected-faces (file)
- (faceup-test-font-lock-file
- 'haskell-tng-mode
- (expand-file-name
- file
- (eval-when-compile (faceup-this-file-directory)))))
-(faceup-defexplainer have-expected-faces)
+ (haskell-tng-testutils:assert-file-contents
+ file
+ #'haskell-tng-mode
+ #'haskell-tng-font-lock-test:parse-to-string
+ "faceup"))
;; to generate .faceup files, use faceup-view-buffer
(ert-deftest haskell-tng-font-lock-file-tests ()
- (should (have-expected-faces "src/medley.hs")))
+ (should (have-expected-faces "src/medley.hs"))
+
+ (should (have-expected-faces "src/layout.hs"))
+ )
;;; haskell-tng-font-lock-test.el ends here
diff --git a/test/haskell-tng-layout-test.el b/test/haskell-tng-layout-test.el
index a4db333..2217e1f 100644
--- a/test/haskell-tng-layout-test.el
+++ b/test/haskell-tng-layout-test.el
@@ -3,43 +3,32 @@
;; Copyright (C) 2018-2019 Tseen She
;; License: GPL 3 or any later version
-(require 'haskell-tng-mode)
-
-(require 'dash)
(require 'ert)
(require 's)
+(require 'haskell-tng-mode)
+
+(require 'haskell-tng-testutils
+ "test/haskell-tng-testutils.el")
+
(defun haskell-tng-layout-test:parse-to-string ()
(goto-char 0)
- (let (tokens)
- (while (not (eobp))
- (when-let (virtuals (haskell-tng-layout:virtuals-at-point))
- (push (s-join "" virtuals) tokens))
- (push (string (char-after)) tokens)
- (forward-char))
+ (let (tokens exit)
+ (while (not exit)
+ (when-let (virtuals (haskell-tng-layout:virtuals-at-point))
+ (push (s-join "" virtuals) tokens))
+ (if (eobp)
+ (setq exit t)
+ (push (string (char-after)) tokens)
+ (forward-char)))
(s-join "" (reverse tokens))))
-;; TODO share principle with SMIE (and maybe faceup) tests
(defun have-expected-layout (file)
- (let* ((backup-inhibited t)
- (filename (expand-file-name
- file
- (haskell-tng:this-lisp-directory)))
- (golden (concat filename ".layout"))
- (expected (with-temp-buffer
- (insert-file-contents golden)
- (buffer-string)))
- (got (with-temp-buffer
- (insert-file-contents filename)
- ;; TODO mode should be a parameter
- (haskell-tng-mode)
- (haskell-tng-layout-test:parse-to-string))))
- (or (equal got expected)
- ;; TODO make this a setting
- ;; writes out the new version on failure
- (progn
- (write-region got nil golden)
- nil))))
+ (haskell-tng-testutils:assert-file-contents
+ file
+ #'haskell-tng-mode
+ #'haskell-tng-layout-test:parse-to-string
+ "layout"))
(ert-deftest haskell-tng-layout-file-tests ()
;; the Haskell2010 test case
diff --git a/test/haskell-tng-smie-test.el b/test/haskell-tng-smie-test.el
index 350da9f..59a537d 100644
--- a/test/haskell-tng-smie-test.el
+++ b/test/haskell-tng-smie-test.el
@@ -3,15 +3,17 @@
;; Copyright (C) 2018-2019 Tseen She
;; License: GPL 3 or any later version
-(require 'haskell-tng-mode)
-
-(require 'dash)
(require 'ert)
(require 's)
+(require 'haskell-tng-mode)
+
+(require 'haskell-tng-testutils
+ "test/haskell-tng-testutils.el")
+
;; copy/pasta of `smie-indent-forward-token' but rendering lexed tokens in a
way
;; more ammenable to regression testing (e.g. syntax table usage)
-(defun haskell-tng-smie:indent-forward-token ()
+(defun haskell-tng-smie-test:indent-forward-token ()
(let ((tok (funcall smie-forward-token-function)))
(cond
((< 0 (length tok)) tok)
@@ -26,58 +28,38 @@
((eobp) nil)
(t (error "Bumped into unknown token")))))
-(defun haskell-tng-smie:forward-tokens (&optional display)
+(defun haskell-tng-smie-test:forward-tokens ()
"Forward lex the current buffer using SMIE lexer and return the list of
lines,
where each line is a list of tokens.
When called interactively, shows the tokens in a buffer."
- (interactive '(t))
(defvar smie-forward-token-function)
(let* ((lines '(())))
(goto-char (point-min))
(while (not (eobp))
(let* ((start (point))
- (token (haskell-tng-smie:indent-forward-token)))
+ (token (haskell-tng-smie-test:indent-forward-token)))
(let ((line-diff (- (line-number-at-pos (point))
(line-number-at-pos start))))
(unless (<= line-diff 0)
(setq lines (append (-repeat line-diff nil) lines))))
(unless (s-blank? token)
(push token (car lines)))))
- (let ((ordered (reverse (--map (reverse it) lines))))
- (if display
- (haskell-tng-smie:display-tokens ordered)
- ordered))))
+ (reverse (--map (reverse it) lines))))
-(defun haskell-tng-smie:tokens-to-string (lines)
+(defun haskell-tng-smie-test:tokens-to-string (lines)
(concat (s-join "\n" (--map (s-join " " it) lines)) "\n"))
-(defun haskell-tng-smie:display-tokens (lines)
- (with-current-buffer (get-buffer-create "*Haskell-TNG-SMIE-test*")
- (insert (haskell-tng-smie:tokens-to-string lines))
- (pop-to-buffer (current-buffer))))
+(defun haskell-tng-smie-test:parse-to-string ()
+ (haskell-tng-smie-test:tokens-to-string
+ (haskell-tng-smie-test:forward-tokens)))
(defun have-expected-forward-lex (file)
- (let* ((backup-inhibited t)
- (filename (expand-file-name
- file
- (haskell-tng:this-lisp-directory)))
- (golden (concat filename ".lexer"))
- (expected (with-temp-buffer
- (insert-file-contents golden)
- (buffer-string)))
- (lexed (with-temp-buffer
- (insert-file-contents filename)
- ;; TODO load this buffer correctly, to id the mode
- (haskell-tng-mode)
- (haskell-tng-smie:forward-tokens)))
- (got (haskell-tng-smie:tokens-to-string lexed)))
- (or (equal got expected)
- ;; TODO make this a setting
- ;; writes out the new version on failure
- (progn
- (write-region got nil golden)
- nil))))
+ (haskell-tng-testutils:assert-file-contents
+ file
+ #'haskell-tng-mode
+ #'haskell-tng-smie-test:parse-to-string
+ "lexer"))
;; TODO the backwards test should simply assert consistency
diff --git a/test/haskell-tng-testutils.el b/test/haskell-tng-testutils.el
new file mode 100644
index 0000000..cacf54f
--- /dev/null
+++ b/test/haskell-tng-testutils.el
@@ -0,0 +1,42 @@
+;;; haskell-tng-testutils.el --- Test Utilities -*- lexical-binding: t -*-
+
+;; Copyright (C) 2019 Tseen She
+;; License: GPL 3 or any later version
+
+;;; Commentary:
+;;
+;; Miscellaneous testing utilities that are not required by the application.
+;;
+;;; Code:
+
+(defmacro haskell-tng-testutils:this-lisp-directory ()
+ (expand-file-name
+ (if load-file-name
+ (file-name-directory load-file-name)
+ default-directory)))
+
+(defun haskell-tng-testutils:assert-file-contents
+ (file mode to-string suffix)
+ "For FILE, enable MODE and run TO-STRING and compare with the golden data in
FILE.SUFFIX.
+
+Will fail and write out the expected version to FILE.SUFFIX."
+ (let* ((backup-inhibited t)
+ (filename (expand-file-name
+ file
+ (haskell-tng-testutils:this-lisp-directory)))
+ (golden (concat filename "." suffix))
+ (expected (with-temp-buffer
+ (insert-file-contents golden)
+ (buffer-string)))
+ (got (with-temp-buffer
+ (insert-file-contents filename)
+ (funcall mode)
+ (funcall to-string))))
+ (or (equal got expected)
+ ;; writes out the new version on failure
+ (progn
+ (write-region got nil golden)
+ nil))))
+
+(provide 'haskell-tng-testutils)
+;;; haskell-tng-testutils.el ends here
diff --git a/test/src/layout.hs.faceup b/test/src/layout.hs.faceup
new file mode 100644
index 0000000..3485048
--- /dev/null
+++ b/test/src/layout.hs.faceup
@@ -0,0 +1,20 @@
+«x:-- Figure 2.1 from the Haskell2010 report
+»«:haskell-tng:keyword:module»
«:haskell-tng:module:AStack»«:haskell-tng:keyword:(»«:haskell-tng:constructor:
Stack»«:haskell-tng:keyword:,»«:haskell-tng:constructor:
push»«:haskell-tng:keyword:,»«:haskell-tng:constructor:
pop»«:haskell-tng:keyword:,»«:haskell-tng:constructor:
top»«:haskell-tng:keyword:,»«:haskell-tng:constructor: size
»«:haskell-tng:keyword:)» «:haskell-tng:keyword:where»
+«:haskell-tng:keyword:data»«:haskell-tng:type: Stack a
»«:haskell-tng:keyword:=» «:haskell-tng:constructor:Empty»
+ «:haskell-tng:keyword:|» «:haskell-tng:constructor:MkStack» a
«:haskell-tng:keyword:(»«:haskell-tng:constructor:Stack»
a«:haskell-tng:keyword:)»
+
+«:haskell-tng:toplevel:push» «:haskell-tng:keyword:::»«:haskell-tng:type: a
»«:haskell-tng:keyword:->»«:haskell-tng:type: Stack a
»«:haskell-tng:keyword:->»«:haskell-tng:type: Stack a
+»«:haskell-tng:toplevel:push» x s «:haskell-tng:keyword:=»
«:haskell-tng:constructor:MkStack» x s
+
+«:haskell-tng:toplevel:size» «:haskell-tng:keyword:::»«:haskell-tng:type:
Stack a »«:haskell-tng:keyword:->»«:haskell-tng:type: Int
+»«:haskell-tng:toplevel:size» s «:haskell-tng:keyword:=» length
«:haskell-tng:keyword:(»stkToLst s«:haskell-tng:keyword:)»
«:haskell-tng:keyword:where»
+ stkToLst «:haskell-tng:constructor:Empty»
«:haskell-tng:keyword:=» «:haskell-tng:keyword:[]»
+ stkToLst «:haskell-tng:keyword:(»«:haskell-tng:constructor:MkStack»
x s«:haskell-tng:keyword:)» «:haskell-tng:keyword:=» x:xs
«:haskell-tng:keyword:where» xs «:haskell-tng:keyword:=» stkToLst s
+
+«:haskell-tng:toplevel:pop» «:haskell-tng:keyword:::»«:haskell-tng:type: Stack
a »«:haskell-tng:keyword:->»«:haskell-tng:type:
»«:haskell-tng:keyword:(»«:haskell-tng:type:a»«:haskell-tng:keyword:,»«:haskell-tng:type:
Stack a»«:haskell-tng:keyword:)»«:haskell-tng:type:
+»«:haskell-tng:toplevel:pop»
«:haskell-tng:keyword:(»«:haskell-tng:constructor:MkStack» x
s«:haskell-tng:keyword:)»
+ «:haskell-tng:keyword:=» «:haskell-tng:keyword:(»x«:haskell-tng:keyword:,»
«:haskell-tng:keyword:case» s «:haskell-tng:keyword:of» r
«:haskell-tng:keyword:->» i r «:haskell-tng:keyword:where» i x
«:haskell-tng:keyword:=» x«:haskell-tng:keyword:)» «x:-- (pop Empty) is an error
+»
+«:haskell-tng:toplevel:top» «:haskell-tng:keyword:::»«:haskell-tng:type: Stack
a »«:haskell-tng:keyword:->»«:haskell-tng:type: a
+»«:haskell-tng:toplevel:top»
«:haskell-tng:keyword:(»«:haskell-tng:constructor:MkStack» x
s«:haskell-tng:keyword:)» «:haskell-tng:keyword:=» x «x:--
(top Empty) is an error
+»
\ No newline at end of file
diff --git a/test/src/layout.hs.layout b/test/src/layout.hs.layout
index 1115f57..f859ec4 100644
--- a/test/src/layout.hs.layout
+++ b/test/src/layout.hs.layout
@@ -17,3 +17,4 @@ module AStack( Stack, push, pop, top, size ) where
;top :: Stack a -> a
;top (MkStack x s) = x -- (top Empty) is an error
+}
\ No newline at end of file
diff --git a/test/src/medley.hs.layout b/test/src/medley.hs.layout
index 0731662..a87eddb 100644
--- a/test/src/medley.hs.layout
+++ b/test/src/medley.hs.layout
@@ -131,3 +131,4 @@ module Foo.Bar.Main
-- checking that comments are ignored in layout
-- and that a starting syntax entry is ok
;(+) = _
+}}
\ No newline at end of file
