[nongnu] elpa/parseclj 5fbe901cba 071/185: Parse/unparse :tag, rountrip AST

[ELPA Syncer]

branch: elpa/parseclj
commit 5fbe901cba644cc2724fa778ca504f4dc292f47d
Author: Arne Brasseur <arne@arnebrasseur.net>
Commit: Arne Brasseur <arne@arnebrasseur.net>

    Parse/unparse :tag, rountrip AST
    
    - fix parsing of tag: :children should be a list of nodes
    - unparse :tag
    - add rountrip for ast unparse/parse
---
 clj-ast.el                                         | 17 +++++++++----
 test/clj-ast-test.el                               | 19 ++++++++++++++
 ...clj-unparse-test.el => clj-ast-unparse-test.el} |  7 ++++--
 test/clj-edn-el-parity-test.el                     |  8 +++---
 test/clj-lex-test.el                               |  2 +-
 test/clj-parse-test-data.el                        | 18 +++++++-------
 test/clj-parse-test.el                             | 29 ++--------------------
 7 files changed, 52 insertions(+), 48 deletions(-)

diff --git a/clj-ast.el b/clj-ast.el
index 8f97a7f400..c295d316e6 100644
--- a/clj-ast.el
+++ b/clj-ast.el
@@ -53,10 +53,10 @@
     (cl-case type
       (:root (clj-parse--make-node :root 0 :children children))
       (:discard stack)
-      (:tag (clj-parse--make-node :tag
-                                  pos
-                                  :tag (intern (substring (a-get opener-token 
'form) 1))
-                                  :children children))
+      (:tag (list (clj-parse--make-node :tag
+                                        pos
+                                        :tag (intern (substring (a-get 
opener-token 'form) 1))
+                                        :children children)))
       (t (cons
           (clj-parse--make-node type pos :children children)
           stack)))))
@@ -87,6 +87,13 @@ position of (point)."
     (clj-ast-unparse node))
   (insert rd))
 
+(defun clj-ast-unparse-tag (node)
+  (progn
+    (insert "#")
+    (insert (symbol-name (a-get node :tag)))
+    (insert " ")
+    (clj-ast-unparse (car (a-get node :children)))))
+
 (defun clj-ast-unparse (node)
   (if (clj-parse--is-leaf? node)
       (insert (alist-get ':form node))
@@ -97,7 +104,7 @@ position of (point)."
         (:vector (clj-ast-unparse-collection subnodes "[" "]"))
         (:set (clj-ast-unparse-collection subnodes "#{" "}"))
         (:map (clj-ast-unparse-collection subnodes "{" "}"))
-        (:tag )))))
+        (:tag (clj-ast-unparse-tag node))))))
 
 (defun clj-ast-unparse-str (data)
   (with-temp-buffer
diff --git a/test/clj-ast-test.el b/test/clj-ast-test.el
index da12f26cd1..5b383da516 100644
--- a/test/clj-ast-test.el
+++ b/test/clj-ast-test.el
@@ -27,6 +27,11 @@
 
 ;;; Code
 
+(require 'ert)
+(require 'clj-ast)
+
+(load "test/clj-parse-test-data.el")
+
 (defmacro define-clj-ast-parse-tests ()
   `(progn
      ,@(mapcar
@@ -43,7 +48,21 @@
                        (should (a-equal (clj-ast-parse) ',(a-get data 
:ast)))))))))
         clj-parse-test-data)))
 
+(defmacro define-clj-ast-roundtrip-tests ()
+  `(progn
+     ,@(mapcar
+        (lambda (pair)
+          (let ((name (car pair))
+                (data (cdr pair)))
+            (if (and (a-get data :ast) (a-get data :source))
+                (let ((test-name (intern (concat "clj-ast-rountrip:" name))))
+                  `(ert-deftest ,test-name ()
+                     :tags '(clj-ast-rountrip)
+                     (should (a-equal (clj-ast-parse-str (clj-ast-unparse-str 
',(a-get data :ast))) ',(a-get data :ast))))))))
+        clj-parse-test-data)))
+
 
+(define-clj-ast-roundtrip-tests)
 (define-clj-ast-parse-tests)
 
 ;;; clj-ast-test.el ends here
diff --git a/test/clj-unparse-test.el b/test/clj-ast-unparse-test.el
similarity index 98%
rename from test/clj-unparse-test.el
rename to test/clj-ast-unparse-test.el
index 47b0cf1225..798aba4f32 100644
--- a/test/clj-unparse-test.el
+++ b/test/clj-ast-unparse-test.el
@@ -1,4 +1,4 @@
-;;; clj-unparse-test.el --- Print Clojure AST back to code - tests
+;;; clj-ast-unparse-test.el --- Print Clojure AST back to code - tests
 
 ;; Copyright (C) 2017  Arne Brasseur
 
@@ -27,6 +27,9 @@
 
 ;;; Code:
 
+(require 'ert)
+(require 'clj-ast)
+
 ;;; Printer modes
 ;; ----------------------------------------------------------------------------
 
@@ -160,4 +163,4 @@
 
 (provide 'clj-unparse-test)
 
-;;; clj-unparse-test.el ends here
+;;; clj-ast-unparse-test.el ends here
diff --git a/test/clj-edn-el-parity-test.el b/test/clj-edn-el-parity-test.el
index a7f9446d97..bae4d41609 100644
--- a/test/clj-edn-el-parity-test.el
+++ b/test/clj-edn-el-parity-test.el
@@ -29,8 +29,8 @@
 
 ;;; Code:
 
-(require 'clj-parse)
 (require 'ert)
+(require 'clj-parse)
 (eval-when-compile (require 'subr-x)) ;; for things like hash-table-keys
 
 (ert-deftest whitespace ()
@@ -212,7 +212,8 @@
   :tags '(edn tags)
   (should-error (clj-edn-read-str "#my/type value" 
clj-edn-test-extra-handlers))
   (should (= 1 (clj-edn-read-str "#my/type (1 2)" 
clj-edn-test-extra-handlers)))
-  (should (= 2 (clj-edn-read-str "#my/other-type {:foo :bar}" 
clj-edn-test-extra-handlers))))
+  (should (= 2 (clj-edn-read-str "#my/other-type {:foo :bar}" 
clj-edn-test-extra-handlers)))
+  (should-error (clj-edn-read-str "#myapp/Person {:first \"Fred\" :last 
\"Mertz\"}")))
 
 (ert-deftest roundtrip ()
   :tags '(edn roundtrip)
@@ -221,8 +222,7 @@
     (should (map-equal (make-seeded-hash-table :foo :bar)
                        (clj-edn-read-str (clj-edn-print-str 
(make-seeded-hash-table :foo :bar)))))
     (should (equal '(edn-set (1 2 3 [3 1.11]))
-                   (clj-edn-read-str (clj-edn-print-str '(edn-set (1 2 3 [3 
1.11]))))))
-    (should-error (clj-edn-read-str "#myapp/Person {:first \"Fred\" :last 
\"Mertz\"}"))))
+                   (clj-edn-read-str (clj-edn-print-str '(edn-set (1 2 3 [3 
1.11]))))))))
 
 (ert-deftest inst ()
   :tags '(edn inst)
diff --git a/test/clj-lex-test.el b/test/clj-lex-test.el
index 72bb734d63..ae8325b741 100644
--- a/test/clj-lex-test.el
+++ b/test/clj-lex-test.el
@@ -27,8 +27,8 @@
 
 ;;; Code
 
-(require 'clj-lex)
 (require 'ert)
+(require 'clj-lex)
 
 (ert-deftest clj-lex-test-next ()
   (with-temp-buffer
diff --git a/test/clj-parse-test-data.el b/test/clj-parse-test-data.el
index 7dff657f5a..4049514caf 100644
--- a/test/clj-parse-test-data.el
+++ b/test/clj-parse-test-data.el
@@ -280,14 +280,14 @@
     :source "#foo/bar [1]"
     :ast '((:node-type . :root)
            (:position . 0)
-           (:children . ((:node-type . :tag)
-                         (:position . 1)
-                         (:tag . foo/bar)
-                         (:children . (((:node-type . :vector)
-                                        (:position . 10)
-                                        (:children . (((:node-type . :number)
-                                                       (:position . 11)
-                                                       (:form . "1")
-                                                       (:value . 1)))))))))))))
+           (:children . (((:node-type . :tag)
+                          (:position . 1)
+                          (:tag . foo/bar)
+                          (:children . (((:node-type . :vector)
+                                         (:position . 10)
+                                         (:children . (((:node-type . :number)
+                                                        (:position . 11)
+                                                        (:form . "1")
+                                                        (:value . 
1))))))))))))))
 
 ;;; clj-parse-test-data.el ends here
diff --git a/test/clj-parse-test.el b/test/clj-parse-test.el
index ea3bd9b4ac..172664cfb1 100644
--- a/test/clj-parse-test.el
+++ b/test/clj-parse-test.el
@@ -30,33 +30,8 @@
 (require 'ert)
 (require 'clj-parse)
 
-(defun clj-parse--deftest-mode (mode test-name test-string expected)
-  (let* ((parse-fn (if (equal mode "edn")
-                       #'clj-edn-read
-                     #'clj-ast-parse))
-         (test-name (intern (concat (symbol-name parse-fn) "-" (symbol-name 
test-name)))))
-    `(ert-deftest ,test-name ()
-       (with-temp-buffer
-         (insert ,test-string)
-         (goto-char 1)
-         (should (a-equal (,parse-fn) (backquote ,expected)))))))
-
-(defmacro clj-parse-deftest (test-name test-string mode-vs-expected-alist)
-  (declare (indent defun))
-  `(progn
-     ,@(let ((edn (a-get mode-vs-expected-alist "edn")))
-         (when (eq (length edn) 1)
-           `((ert-deftest ,(intern (concat "edn-print-" (symbol-name 
test-name))) ()
-               (should (equal (clj-edn-print-str (backquote ,(car edn))) 
,test-string))))))
-     ,@(mapcar (lambda (vs) (clj-parse--deftest-mode (car vs)
-                                                     test-name
-                                                     test-string
-                                                     (cdr vs)))
-               mode-vs-expected-alist)))
-
-
-;;; Parser modes
-;; ----------------------------------------------------------------------------
+;; needs testing of individual functions. all testing now is at the top level
+;; through parse/unparse
 
 (provide 'clj-parse-test)