[nongnu] elpa/haskell-tng-mode 8e1a225 068/385: sexp tests

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit 8e1a2256074fe4ce4085bcf24e95e7d37a4617fb
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@gmail.com>

    sexp tests
---
 haskell-tng-smie.el             |  3 ++
 test/haskell-tng-layout-test.el | 17 ++++---
 test/haskell-tng-sexp-test.el   | 99 +++++++++++++++++++++++++++++++++++++++++
 test/haskell-tng-smie-test.el   | 23 ----------
 test/haskell-tng-testutils.el   |  3 +-
 test/src/layout.hs.sexps        | 20 +++++++++
 6 files changed, 134 insertions(+), 31 deletions(-)

diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 45a2089..3fb7183 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -45,6 +45,9 @@
 
 ;; TODO indentation rules
 ;; 
https://www.gnu.org/software/emacs/manual/html_mono/elisp.html#SMIE-Indentation
+;;
+;; ideas for an indentation tester
+;; 
https://github.com/elixir-editors/emacs-elixir/blob/master/test/test-helper.el#L52-L63
 (defvar haskell-tng-smie:rules nil)
 
 (defun haskell-tng-smie:setup ()
diff --git a/test/haskell-tng-layout-test.el b/test/haskell-tng-layout-test.el
index 38f601f..16f0588 100644
--- a/test/haskell-tng-layout-test.el
+++ b/test/haskell-tng-layout-test.el
@@ -11,6 +11,16 @@
 (require 'haskell-tng-testutils
          "test/haskell-tng-testutils.el")
 
+(ert-deftest haskell-tng-layout-file-tests ()
+  ;; the Haskell2010 test case
+  (should (have-expected-layout (testdata "src/layout.hs")))
+
+  (should (have-expected-layout (testdata "src/medley.hs")))
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Testing utilities
+
 (defun haskell-tng-layout-test:parse-to-string ()
   (goto-char 0)
   (let (tokens exit)
@@ -30,13 +40,6 @@
    #'haskell-tng-layout-test:parse-to-string
    "layout"))
 
-(ert-deftest haskell-tng-layout-file-tests ()
-  ;; the Haskell2010 test case
-  (should (have-expected-layout (testdata "src/layout.hs")))
-
-  (should (have-expected-layout (testdata "src/medley.hs")))
-  )
-
 (ert-deftest haskell-tng-layout-cache-invalidation-tests ()
   (with-temp-buffer
     (insert-file-contents (testdata "src/layout.hs"))
diff --git a/test/haskell-tng-sexp-test.el b/test/haskell-tng-sexp-test.el
new file mode 100644
index 0000000..a496606
--- /dev/null
+++ b/test/haskell-tng-sexp-test.el
@@ -0,0 +1,99 @@
+;;; haskell-tng-sexp-test.el --- Tests for sexp navigation -*- 
lexical-binding: t -*-
+
+;; Copyright (C) 2018-2019 Tseen She
+;; License: GPL 3 or any later version
+
+(require 'ert)
+(require 's)
+
+(require 'haskell-tng-mode)
+
+(require 'haskell-tng-testutils
+         "test/haskell-tng-testutils.el")
+
+;; This test was originally going to use
+;; `thing-at-point-bounds-of-list-at-point' to generate all the bounds for a
+;; file. But `scan-lists' (and many other sexp / list commands) are not SMIE
+;; aware.
+;;
+;; Therefore we calculate the s-expression bounds at every point in the file.
+;; However, this fails to find all bounds because there is ambiguity at virtual
+;; tokens.
+
+(ert-deftest haskell-tng-sexp-file-tests ()
+  (should (have-expected-sexps (testdata "src/layout.hs")))
+
+  ;; TODO enable when layout.hs gives better results...
+  ;;(should (have-expected-sexps (testdata "src/medley.hs")))
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SMIE testing utilities
+
+;; `thing-at-point--beginning-of-sexp' and `thing-at-point--end-of-sexp' cannot
+;; be trusted because they assume the language is a lisp. This finds the 
nearest
+;; forward/backward sexps at the current point (which is not necessarilly
+;; beginning / end of current sexp), using only the primitives `forward-sexp'
+;; and `backward-sexp', provided by SMIE.
+(defun haskell-tng-sexp-test:sexps-at-point (p)
+  "Return a list of cons cells (start . end)"
+  (let* (sexps
+         (forward-backward
+          (ignore-errors
+            (save-excursion
+              (goto-char p)
+              (forward-sexp)
+              (let ((forward (point)))
+                (backward-sexp)
+                (cons (point) forward)))))
+         (backward-forward
+          (ignore-errors
+            (save-excursion
+              (goto-char p)
+              (backward-sexp)
+              (let ((backward (point)))
+                (forward-sexp)
+                (cons backward (point)))))))
+    (when forward-backward
+      (push forward-backward sexps))
+    (when backward-forward
+      (push backward-forward sexps))
+    sexps))
+
+(defun haskell-tng-sexp-test:sexps ()
+  "All the unique sexp bounds for the current buffer."
+  (goto-char (point-min))
+  (let (sexps)
+    (while (not (eobp))
+      (unless (nth 8 (syntax-ppss)) ;; don't query in comments/strings
+        (let ((here (haskell-tng-sexp-test:sexps-at-point (point))))
+          (setq sexps (append here sexps))))
+      (forward-char))
+    (delete-dups sexps)))
+
+(defun haskell-tng-sexp-test:sexps-to-string (sexps)
+  "Renders the current buffer, marked up by sexps."
+  (let (chars exit)
+    (goto-char (point-min))
+    (while (not exit)
+      (--each sexps
+        (cond
+         ((= (point) (car it)) (push "(" chars))
+         ((= (point) (cdr it)) (push ")" chars))
+         (t nil)))
+      (if (eobp)
+          (setq exit 't)
+        (push (string (char-after)) chars)
+        (forward-char)))
+    (s-join "" (reverse chars))))
+
+(defun have-expected-sexps (file)
+  (haskell-tng-testutils:assert-file-contents
+   file
+   #'haskell-tng-mode
+   (lambda ()
+     (haskell-tng-sexp-test:sexps-to-string
+      (haskell-tng-sexp-test:sexps)))
+   "sexps"))
+
+;;; haskell-tng-sexp-test.el ends here
diff --git a/test/haskell-tng-smie-test.el b/test/haskell-tng-smie-test.el
deleted file mode 100644
index 51f4752..0000000
--- a/test/haskell-tng-smie-test.el
+++ /dev/null
@@ -1,23 +0,0 @@
-;;; haskell-tng-lexer-test.el --- Tests for navigation and indentation -*- 
lexical-binding: t -*-
-
-;; Copyright (C) 2018-2019 Tseen She
-;; License: GPL 3 or any later version
-
-(require 'ert)
-(require 's)
-
-(require 'haskell-tng-mode)
-
-(require 'haskell-tng-testutils
-         "test/haskell-tng-testutils.el")
-
-(ert-deftest haskell-tng-smie-file-tests ()
-  ;; FIXME tests for s-expressions
-  ;; (should (have-expected-forward-lex (testdata "src/medley.hs")))
-  ;; (should (have-expected-forward-lex (testdata "src/layout.hs")))
-  )
-
-;; ideas for an indentation tester
-;; 
https://github.com/elixir-editors/emacs-elixir/blob/master/test/test-helper.el#L52-L63
-
-;;; haskell-tng-lexer-test.el ends here
diff --git a/test/haskell-tng-testutils.el b/test/haskell-tng-testutils.el
index a4491b8..32713f1 100644
--- a/test/haskell-tng-testutils.el
+++ b/test/haskell-tng-testutils.el
@@ -22,7 +22,8 @@
 Will fail and write out the expected version to FILE.SUFFIX."
   (let* ((golden (concat file "." suffix))
          (expected (with-temp-buffer
-                     (insert-file-contents golden)
+                     (when (file-exists-p golden)
+                       (insert-file-contents golden))
                      (buffer-string)))
          (got (with-temp-buffer
                 (insert-file-contents file)
diff --git a/test/src/layout.hs.sexps b/test/src/layout.hs.sexps
new file mode 100644
index 0000000..a507d5b
--- /dev/null
+++ b/test/src/layout.hs.sexps
@@ -0,0 +1,20 @@
+((--) Figure 2.1 from the Haskell2010 report
+(module)) (AStack()( (Stack), (push), (pop), (top), (size) )) (where)
+((data) (Stack) (a) = (Empty)
+             (|) (MkStack) (a) (((Stack) (a)))
+
+((push) (::) (a) (->) (Stack) (a) (->) (Stack) (a))
+((push) (x) (s) = (MkStack) (x) (s))
+
+((size) (::) (Stack) (a) (->) (Int))
+((size) (s) = (length) (((stkToLst) (s)))  (where)
+           ((stkToLst)  (Empty)         = ([])
+           ((stkToLst) (((MkStack) (x) (s)))  = (x:xs) (where) ((xs) = 
(stkToLst) (s)
+
+())))pop) (::) (Stack) (a) (->) (((a), (Stack) (a)))
+((pop) (((MkStack) (x) (s)))
+  = (((x), (case) (s) (of) (r (->) (i) (r) (where) (i (x) = x))))) ((--) (pop 
Empty) is an error
+
+((top) (::) (Stack) (a) (->) (a)))
+((top) (((MkStack) (x) (s))) = (x))                     (--) (top Empty) is an 
error
+)
\ No newline at end of file