branch: externals/parser-generator
commit 070276547b657d7ac98a036e2b4595659d737292
Author: Christian Johansson <[email protected]>
Commit: Christian Johansson <[email protected]>
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)
