branch: externals/parser-generator
commit c1d37073efd1ff1cb997763a6826bedb96a44580
Author: Christian Johansson <[email protected]>
Commit: Christian Johansson <[email protected]>
Passing test for including SDT in Produductions
---
parser-generator.el | 32 ++++++++++++++++++++++++++------
test/parser-generator-test.el | 16 ++++++++++++++++
2 files changed, 42 insertions(+), 6 deletions(-)
diff --git a/parser-generator.el b/parser-generator.el
index 6a37f3a..d06f568 100644
--- a/parser-generator.el
+++ b/parser-generator.el
@@ -475,12 +475,32 @@
(cond
((stringp rhs-element))
((symbolp rhs-element))
- ((listp rhs-element)
- (dolist (rhs-sub-element rhs-element)
- (unless (or
- (stringp rhs-sub-element)
- (symbolp rhs-sub-element))
- (setq is-valid nil))))
+ ((and (functionp rhs-element)
+ (= rhs-index (1- rhs-length))))
+ ((and
+ (listp rhs-element)
+ (not (functionp rhs-element)))
+ (let ((rhs-sub-index 0)
+ (rhs-sub-element)
+ (rhs-sub-length (length rhs-element)))
+ (while (and is-valid
+ (< rhs-sub-index rhs-sub-length))
+ (setq rhs-sub-element (nth rhs-sub-index rhs-element))
+ (cond
+ ((and
+ (listp rhs-sub-element)
+ (not (functionp rhs-sub-element)))
+ (unless (and
+ (or (stringp (car rhs-sub-element))
+ (symbolp (car rhs-sub-element)))
+ (functionp (car (cdr rhs-sub-element))))
+ (setq is-valid nil)))
+ ((and (functionp rhs-sub-element)
+ (= rhs-sub-index (1- rhs-sub-length))))
+ ((or (stringp rhs-sub-element)
+ (symbolp rhs-sub-element)))
+ (t (setq is-valid nil)))
+ (setq rhs-sub-index (1+ rhs-sub-index)))))
(t (setq is-valid nil)))
(setq rhs-index (1+ rhs-index)))))))
is-valid))
diff --git a/test/parser-generator-test.el b/test/parser-generator-test.el
index 2699ebc..d9c02d0 100644
--- a/test/parser-generator-test.el
+++ b/test/parser-generator-test.el
@@ -422,6 +422,10 @@
(parser-generator--valid-production-p '(A a))))
(should (equal
+ t
+ (parser-generator--valid-production-p '(A (a)))))
+
+ (should (equal
nil
(parser-generator--valid-production-p "A")))
@@ -429,6 +433,18 @@
nil
(parser-generator--valid-production-p '((A a)))))
+ (should (equal
+ t
+ (parser-generator--valid-production-p '(A a (lambda(a) (message
"Here 1 %s"))))))
+
+ (should (equal
+ t
+ (parser-generator--valid-production-p '(A (a (lambda(a) (message
"Here 2 %s")))))))
+
+ (should (equal
+ t
+ (parser-generator--valid-production-p '(A (a (lambda(a) (message
"Here 3 %s"))) b))))
+
(message "Passed tests for (parser-generator--valid-production-p)"))
(defun parser-generator-test--get-grammar-rhs ()
