[elpa] externals/parser-generator 0702765 293/434: Added incremental unit test for exported parser/translator

[ELPA Syncer]

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

    Added incremental unit test for exported parser/translator
---
 test/parser-generator-lr-export-test.el | 173 ++++++++++++++++++++++++++++++--
 1 file changed, 167 insertions(+), 6 deletions(-)

diff --git a/test/parser-generator-lr-export-test.el 
b/test/parser-generator-lr-export-test.el
index 0b81d8a..487c4e8 100644
--- a/test/parser-generator-lr-export-test.el
+++ b/test/parser-generator-lr-export-test.el
@@ -10,9 +10,111 @@
 (require 'parser-generator-lr-export)
 (require 'ert)
 
-(defun parser-generator-lr-export-test-to-elisp ()
-  "Test `parser-generator-lr-export'."
-  (message "Started tests for (parser-generator-lr-export-to-elisp)")
+(defun parser-generator-lr-export-test-incremental ()
+  "Test incremental parse and translate."
+  (message "Started incremental tests")
+
+  (let ((buffer (generate-new-buffer "*a*")))
+    (switch-to-buffer buffer)
+    (insert "aabb")
+
+    (parser-generator-set-grammar '((Sp S) ("a" "b") ((Sp S) (S (S "a" S "b" 
(lambda(args) (let ((list "")) (dolist (item args) (when item (setq list 
(format "%s%s" item list)))) list)))) (S e)) Sp))
+    (parser-generator-set-look-ahead-number 1)
+    (parser-generator-process-grammar)
+    (parser-generator-lr-generate-parser-tables)
+
+    (setq
+     parser-generator-lex-analyzer--function
+     (lambda (index)
+       (with-current-buffer "*a*"
+         (when (<= (+ index 1) (point-max))
+           (let ((start index)
+                 (end (+ index 1)))
+             (let ((token (buffer-substring-no-properties start end)))
+               `(,token ,start . ,end)))))))
+
+    (setq
+     parser-generator-lex-analyzer--get-function
+     (lambda (token)
+       (with-current-buffer "*a*"
+         (let ((start (car (cdr token)))
+               (end (cdr (cdr token))))
+           (when (<= end (point-max))
+             (buffer-substring-no-properties start end))))))
+
+    (should
+     (equal
+      "bbaaba"
+      (parser-generator-lr-translate)))
+
+    ;; Export parser
+    (let ((export (parser-generator-lr-export-to-elisp "fa")))
+      (with-temp-buffer
+        (insert export)
+        (eval-buffer)
+        (should
+         (equal
+          t
+          (fboundp 'fa-translate))))
+
+      (when (fboundp 'fa-translate)
+        (should
+         (equal
+          "bbaaba"
+          (fa-translate))))))
+
+  (should
+   (equal
+    t
+    (fboundp 'fa--parse)))
+
+  (when (fboundp 'fa--parse)
+    (let ((regular-parse (fa--parse)))
+      ;; (message "regular-parse: %s" regular-parse)
+      (let ((regular-parse-history (nth 3 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 (nth 2 history))
+                  (translation (nth 3 history))
+                  (translation-symbol-table (nth 4 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
+                     (fa--parse
+                      input-tape-index
+                      pushdown-list
+                      output
+                      translation
+                      translation-symbol-table
+                      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))))))))
+
+  (message "Passed incremental tests"))
+
+(defun parser-generator-lr-export-test-parse ()
+  "Test exported parser."
+  (message "Started parse tests")
 
   ;; Generate parser
   (parser-generator-set-grammar
@@ -100,7 +202,6 @@
 
     ;; Export parser
     (let ((export (parser-generator-lr-export-to-elisp "fa")))
-      (message "export:\n%s\n" export)
       (with-temp-buffer
         (insert export)
         (eval-buffer)
@@ -118,11 +219,71 @@
           (fa-translate))))
       (message "Passed translate for exported parser")))
 
-  (message "Passed tests for (parser-generator-lr-export-to-elisp)"))
+  (message "Passed parse tests"))
+
+(defun parser-generator-lr-export-test-translate ()
+  "Test exported translater."
+  (message "Started translate tests")
+
+  (let ((buffer (generate-new-buffer "*a*")))
+    (switch-to-buffer buffer)
+    (insert "aabb")
+
+    (parser-generator-set-grammar '((Sp S) ("a" "b") ((Sp S) (S (S "a" S "b" 
(lambda(args) (let ((list "")) (dolist (item args) (when item (setq list 
(format "%s%s" item list)))) list)))) (S e)) Sp))
+    (parser-generator-set-look-ahead-number 1)
+    (parser-generator-process-grammar)
+    (parser-generator-lr-generate-parser-tables)
+
+    (setq
+     parser-generator-lex-analyzer--function
+     (lambda (index)
+       (with-current-buffer "*a*"
+         (when (<= (+ index 1) (point-max))
+           (let ((start index)
+                 (end (+ index 1)))
+             (let ((token (buffer-substring-no-properties start end)))
+               `(,token ,start . ,end)))))))
+
+    (setq
+     parser-generator-lex-analyzer--get-function
+     (lambda (token)
+       (with-current-buffer "*a*"
+         (let ((start (car (cdr token)))
+               (end (cdr (cdr token))))
+           (when (<= end (point-max))
+             (buffer-substring-no-properties start end))))))
+
+    (should
+     (equal
+      "bbaaba"
+      (parser-generator-lr-translate)))
+
+    (message "Passed translate before export")
+
+    ;; Export parser
+    (let ((export (parser-generator-lr-export-to-elisp "fa")))
+      (with-temp-buffer
+        (insert export)
+        (eval-buffer)
+        (should
+         (equal
+          t
+          (fboundp 'fa-translate))))
+
+      (when (fboundp 'fa-translate)
+        (should
+         (equal
+          "bbaaba"
+          (fa-translate))))
+      (message "Passed translate for exported parser")))
+
+  (message "Passed translate tests"))
 
 (defun parser-generator-lr-export-test ()
   "Run test."
-  (parser-generator-lr-export-test-to-elisp))
+  (parser-generator-lr-export-test-parse)
+  (parser-generator-lr-export-test-translate)
+  (parser-generator-lr-export-test-incremental))
 
 
 (provide 'parser-generator-lr-export-test)