[elpa] externals/parser-generator fdbdff7 157/434: Added unit test for SDT in LR-parser

[ELPA Syncer]

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

    Added unit test for SDT in LR-parser
---
 parser-generator-lr.el           | 11 ++++----
 test/parser-generator-lr-test.el | 57 ++++++++++++++++++++++++----------------
 2 files changed, 40 insertions(+), 28 deletions(-)

diff --git a/parser-generator-lr.el b/parser-generator-lr.el
index 9692d47..688af25 100644
--- a/parser-generator-lr.el
+++ b/parser-generator-lr.el
@@ -476,7 +476,6 @@
 
 ;; Algorithm 5.7, p. 375
 ;; TODO Test incremental usage of this function
-;; TODO Add support for Syntax-directed-translations and semantic-actions
 ;; TODO Consider case with 2 character look-ahead
 (defun parser-generator-lr--parse (&optional input-tape-index pushdown-list 
output translation)
   "Perform a LR-parse via lex-analyzer, optionally at INPUT-TAPE-INDEX with 
PUSHDOWN-LIST, OUTPUT and TRANSLATION."
@@ -630,17 +629,17 @@
                           (setq
                            popped-items-meta-contents
                            (nreverse popped-items-meta-contents))
-                          (message "Popped-items: %s" popped-items-contents)
-                          (message "Popped-items-meta-contents: %s" 
popped-items-meta-contents)
 
                           (let ((partial-translation
                                  (funcall
                                   
(parser-generator--get-grammar-translation-by-number
                                    production-number)
                                   popped-items-meta-contents)))
-                            (message "Partial-translation: %s" 
partial-translation)
                             (when partial-translation
-                              (push partial-translation translation)))))
+                              (unless (listp partial-translation)
+                                (setq partial-translation (list 
partial-translation)))
+                              (dolist (part-translation partial-translation)
+                                (push part-translation translation))))))
 
                       (let ((new-table-index (car pushdown-list)))
                         (let ((goto-table (gethash new-table-index 
parser-generator-lr--goto-tables)))
@@ -676,6 +675,8 @@
                (t (error (format "Invalid action-match: %s!" 
action-match)))))))))
     (unless accept
       (error "Parsed entire string without getting accepting! Output: %s" 
(nreverse output)))
+    (when translation
+      (setq translation (nreverse translation)))
     (list (nreverse output) translation)))
 
 (provide 'parser-generator-lr)
diff --git a/test/parser-generator-lr-test.el b/test/parser-generator-lr-test.el
index 5c18c97..8c21eea 100644
--- a/test/parser-generator-lr-test.el
+++ b/test/parser-generator-lr-test.el
@@ -319,31 +319,42 @@
 
   (message "Passed test with terminals as string, invalid syntax")
 
-  ;; TODO Test translation with terminals as strings here
+  ;; Test translation with terminals as strings here
+
+  (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) (nreverse args)))) (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 buffer
+         (when (<= (+ index 2) (point-max))
+           (let ((start (+ index 1))
+                 (end (+ index 2)))
+             (let ((token (buffer-substring-no-properties start end)))
+               `(,token ,start . ,end)))))))
+
+    (setq
+     parser-generator-lex-analyzer--get-function
+     (lambda (token)
+       (with-current-buffer buffer
+         (let ((start (car (cdr token)))
+               (end (cdr (cdr token))))
+           (when (<= end (point-max))
+             (buffer-substring-no-properties start end))))))
 
-  (parser-generator-set-grammar '((Sp S) ("a" "b") ((Sp S) (S (S "a" S "b" 
(lambda(args) (nreverse args)))) (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)
-     (let* ((string '(("a" 1 . 2) ("a" 2 . 3) ("b" 3 . 4) ("b" 4 . 5)))
-            (string-length (length string))
-            (max-index (1+ index))
-            (tokens))
-       (while (and
-               (< index string-length)
-               (< index max-index))
-         (push (nth index string) tokens)
-         (setq index (1+ index)))
-       (nreverse tokens))))
+    (should
+     (equal
+      '((2 2 2 1 1) ("b" "a" "b" "a"))
+      (parser-generator-lr--parse)))
 
-  (should
-   (equal
-    '((2 2 2 1 1) nil)
-    (parser-generator-lr--parse)))
+    (kill-buffer buffer))
 
   (message "Passed tests for (parser-generator-lr--parse)"))