branch: externals/parser-generator commit c1d37073efd1ff1cb997763a6826bedb96a44580 Author: Christian Johansson <christ...@cvj.se> Commit: Christian Johansson <christ...@cvj.se>
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 ()