[nongnu] elpa/haskell-tng-mode 61f4c09 062/385: [ci skip] unify the testing approach

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit 61f4c09420527298dc8a00ee7df027125f286ebf
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@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