[nongnu] elpa/parseclj 185ce6367b 090/185: Add :discard support for :lexical-preservation t, and show that it's broken

[ELPA Syncer]

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

    Add :discard support for :lexical-preservation t, and show that it's broken
    
    Discard nodes were currently not being preserved, this changes handles
    reductions of type :discard, but also adds a test case that demonstrates 
this
    breaks down in the face of whitespace (or other discard nodes).
    
    The reason is that the parser only considers the top two elements on the 
stack,
    but in the case of :lexical-preservation, there could be several 
:whitespace and
    :comment nodes that need to be taken into account as well.
    
    We'll have the same problem when dealing with metadata.
---
 parseclj-ast.el       | 20 +++++++++++---------
 test/parseclj-test.el | 52 +++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 63 insertions(+), 9 deletions(-)

diff --git a/parseclj-ast.el b/parseclj-ast.el
index 88d6654820..2b53cf3ec8 100644
--- a/parseclj-ast.el
+++ b/parseclj-ast.el
@@ -94,15 +94,17 @@ Other ATTRIBUTES can be given as a flat list of key-value 
pairs. "
           (parseclj-ast-node type pos :children children)
           stack)))))
 
-(defun parseclj-ast--reduce-branch-with-lexical-preservation (&rest args)
-  (let* ((stack (apply #'parseclj-ast--reduce-branch args))
-         (top (car stack)))
-    (if (parseclj-ast-node? top)
-        (cons (cl-list* (car top) ;; make sure :node-type remains the first 
element in the list
-                        '(:lexical-preservation . t)
-                        (cdr top))
-              (cdr stack))
-      stack)))
+(defun parseclj-ast--reduce-branch-with-lexical-preservation (stack 
opening-token children)
+  (if (eq :discard (parseclj-lex-token-type opening-token))
+      (cons (parseclj-ast-node :discard (a-get opening-token :pos) :children 
children) stack)
+    (let* ((stack (funcall #'parseclj-ast--reduce-branch stack opening-token 
children))
+           (top (car stack)))
+      (if (parseclj-ast-node? top)
+          (cons (cl-list* (car top) ;; make sure :node-type remains the first 
element in the list
+                          '(:lexical-preservation . t)
+                          (cdr top))
+                (cdr stack))
+        stack))))
 
 (provide 'parseclj-ast)
 
diff --git a/test/parseclj-test.el b/test/parseclj-test.el
index ee9eb51b66..a2773157df 100644
--- a/test/parseclj-test.el
+++ b/test/parseclj-test.el
@@ -144,6 +144,58 @@
   ;; TODO: uneven map forms
   )
 
+(ert-deftest parseclj-parse-clojure-lexical-preservation ()
+  (should (equal
+           (parseclj-parse-clojure "#_ (1 2 3) true")
+           '((:node-type . :root) (:position . 1) (:children ((:node-type . 
:true) (:position . 12) (:form . "true") (:value . t))))))
+  (should (equal
+           (parseclj-parse-clojure "#_(1 2 3) true" :lexical-preservation t)
+           '((:node-type . :root)
+             (:lexical-preservation . t)
+             (:position . 1)
+             (:children ((:node-type . :discard)
+                         (:position . 1)
+                         (:children ((:node-type . :list)
+                                     (:lexical-preservation . t)
+                                     (:position . 3)
+                                     (:children ((:node-type . :number) 
(:position . 4) (:form . "1") (:value . 1))
+                                                ((:node-type . :whitespace) 
(:position . 5) (:form . " "))
+                                                ((:node-type . :number) 
(:position . 6) (:form . "2") (:value . 2))
+                                                ((:node-type . :whitespace) 
(:position . 7) (:form . " "))
+                                                ((:node-type . :number) 
(:position . 8) (:form . "3") (:value . 3))))))
+                        ((:node-type . :whitespace)
+                         (:position . 10)
+                         (:form . " "))
+                        ((:node-type . :true)
+                         (:position . 11)
+                         (:form . "true")
+                         (:value . t))))))
+
+  (should (equal
+           (parseclj-parse-clojure "#_ (1 2 3) true" :lexical-preservation t)
+           '((:node-type . :root)
+             (:lexical-preservation . t)
+             (:position . 1)
+             (:children ((:node-type . :discard)
+                         (:position . 1)
+                         (:children
+                          ((:node-type . :whitespace) (:position . 3) (:form . 
" "))
+                          ((:node-type . :list)
+                           (:lexical-preservation . t)
+                           (:position . 4)
+                           (:children ((:node-type . :number) (:position . 5) 
(:form . "1") (:value . 1))
+                                      ((:node-type . :whitespace) (:position . 
6) (:form . " "))
+                                      ((:node-type . :number) (:position . 7) 
(:form . "2") (:value . 2))
+                                      ((:node-type . :whitespace) (:position . 
8) (:form . " "))
+                                      ((:node-type . :number) (:position . 9) 
(:form . "3") (:value . 3))))))
+                        ((:node-type . :whitespace)
+                         (:position . 11)
+                         (:form . " "))
+                        ((:node-type . :true)
+                         (:position . 12)
+                         (:form . "true")
+                         (:value . t)))))))
+
 (provide 'parseclj-test)
 
 ;;; parseclj-test.el ends here