[elpa] externals/parser-generator 668e738 164/434: More work on tests for incremental parse

[ELPA Syncer]

branch: externals/parser-generator
commit 668e738e8912555f278c6dc4f8e19ca0953c85d3
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@cvj.se>

    More work on tests for incremental parse
---
 parser-generator-lr.el           | 21 +++++++-----
 test/parser-generator-lr-test.el | 71 +++++++++++++++++++++++++---------------
 2 files changed, 57 insertions(+), 35 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 91d0aab..5046295 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -517,13 +517,13 @@
                history)
   "Perform a LR-parse via lex-analyzer, optionally at INPUT-TAPE-INDEX with 
PUSHDOWN-LIST, OUTPUT, TRANSLATION and HISTORY."
   (unless input-tape-index
-    (setq input-tape-index 0))
+    (setq input-tape-index 1))
   (unless pushdown-list
     (push 0 pushdown-list))
 
   (if (and
        input-tape-index
-       (> input-tape-index 0))
+       (> input-tape-index 1))
       (setq parser-generator-lex-analyzer--index input-tape-index)
     (parser-generator-lex-analyzer--reset))
 
@@ -535,8 +535,9 @@
 
   (let ((accept)
         (pre-index 0))
-    (while (and
-            (not accept))
+    (while (not accept)
+
+      (message "output: %s, index: %s" output 
parser-generator-lex-analyzer--index)
 
       ;; Save history when index has changed
       (when
@@ -544,7 +545,10 @@
            parser-generator-lex-analyzer--index
            pre-index)
         (push
-         `(,parser-generator-lex-analyzer--index ,pushdown-list ,output 
,translation)
+         `(,parser-generator-lex-analyzer--index
+           ,pushdown-list
+           ,output
+           ,translation)
          history)
         (setq pre-index
               parser-generator-lex-analyzer--index))
@@ -723,13 +727,14 @@
 
                (t (error (format "Invalid action-match: %s!" 
action-match)))))))))
     (unless accept
-      (error "Parsed entire string without getting accepting! Output: %s" 
(nreverse output)))
+      (error "Parsed entire string without getting accepting! Output: %s"
+             (reverse output)))
     (when translation
       (setq translation (nreverse translation)))
     (list
-     (nreverse output)
+     (reverse output)
      translation
-     (nreverse history))))
+     (reverse history))))
 
 (provide 'parser-generator-lr)
 
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 3f31e40..56eeae8 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -10,6 +10,47 @@
 (require 'parser-generator-lr)
 (require 'ert)
 
+(defun parser-generator-lr-test--parse-incremental-vs-regular ()
+  "Verify that regular and incremental parse results in same data."
+  (let ((regular-parse (parser-generator-lr--parse)))
+    (message "regular-parse: %s" regular-parse)
+    (let ((regular-parse-history (nth 2 regular-parse)))
+      (message "regular-parse-history: %s" regular-parse-history)
+      (let ((history-length (length regular-parse-history))
+            (history-index 0)
+            (history)
+            (iterated-history))
+        (while (< history-index history-length)
+          (setq history (nth history-index regular-parse-history))
+          (let ((input-tape-index (nth 0 history))
+                (pushdown-list (nth 1 history))
+                (output (nreverse (nth 2 history)))
+                (translation (nth 3 history))
+                (history-list iterated-history))
+
+            (message "input-tape-index: %s" input-tape-index)
+            (message "pushdown-list: %s" pushdown-list)
+            (message "output: %s" output)
+            (message "translation: %s" translation)
+            (message "history-list: %s" history-list)
+
+            (let ((incremental-parse
+                   (parser-generator-lr--parse
+                    input-tape-index
+                    pushdown-list
+                    output
+                    translation
+                    history-list)))
+              (message "incremental-parse: %s" incremental-parse)
+              (should
+               (equal
+                regular-parse
+                incremental-parse))
+              (message "Passed incremental parse test %s" (1+ history-index)))
+
+            (push history iterated-history)
+            (setq history-index (1+ history-index))))))))
+
 (defun parser-generator-lr-test--generate-action-tables ()
   "Test `parser-generator-lr--generate-action-tables'."
   (message "Starting tests for (parser-generator-lr--generate-action-tables)")
@@ -319,8 +360,6 @@
 
   (message "Passed test with terminals as string, invalid syntax")
 
-  ;; TODO Add incremental parse here
-
   (setq
    parser-generator-lex-analyzer--function
    (lambda (index)
@@ -335,31 +374,9 @@
          (setq index (1+ index)))
        (nreverse tokens))))
 
-  (let ((history (nth 2 (parser-generator-lr--parse))))
-    (message "History: %s" history)
-
-    (let ((history-state 2))
-      (let ((input-tape-index (nth 0 (nth history-state history)))
-            (pushdown-list (nth 1 (nth history-state history)))
-            (output (nreverse (nth 2 (nth history-state history))))
-            (translation (nth 3 (nth history-state history)))
-            (history-list))
-        (while (< (car (car history)) input-tape-index)
-          (push (car history) history-list)
-          (pop history))
-        ;; (setq history (nreverse history))
-        (message "input-tape-index: %s" input-tape-index)
-        (message "pushdown-list: %s" pushdown-list)
-        (message "output: %s" output)
-        (message "translation: %s" translation)
-        (message "history-list: %s" history-list)
-        (let ((parse (parser-generator-lr--parse
-                      input-tape-index
-                      pushdown-list
-                      output
-                      translation
-                      history-list)))
-          (message "parse: %s" parse)))))
+  (parser-generator-lr-test--parse-incremental-vs-regular)
+
+  (message "Passed incremental-test with terminals as string")
 
   (message "Passed tests for (parser-generator-lr--parse)"))