From 61607c4da1bd66f18f785a6c5c14e63051a2c585 Mon Sep 17 00:00:00 2001 From: Casey Klein Date: Fri, 14 Jan 2011 05:55:04 -0600 Subject: [PATCH] Adds a check to the define/extend language parser --- collects/redex/private/reduction-semantics.rkt | 12 +++++++++++- collects/redex/tests/tl-test.rkt | 6 ++++++ 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/collects/redex/private/reduction-semantics.rkt b/collects/redex/private/reduction-semantics.rkt index 8bc1302571..cef9780a27 100644 --- a/collects/redex/private/reduction-semantics.rkt +++ b/collects/redex/private/reduction-semantics.rkt @@ -1743,7 +1743,17 @@ stx (or delim (car left)))) (check-each prods delim? "expected production") (cons names prods)) - (map parse-non-terminal (syntax->list nt-defs))) + (define parsed (map parse-non-terminal (syntax->list nt-defs))) + (define defs (make-hash)) + (for ([p parsed]) + (define ns (car p)) + (for ([n ns]) + (define m (hash-ref defs (syntax-e n) #f)) + (if m + (raise-syntax-error #f "same non-terminal defined twice" + stx n (list m)) + (hash-set! defs (syntax-e n) n)))) + parsed) (define-syntax (define-language stx) (syntax-case stx () diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt index 4b44b5897c..439affdfa0 100644 --- a/collects/redex/tests/tl-test.rkt +++ b/collects/redex/tests/tl-test.rkt @@ -1468,6 +1468,12 @@ (define-language good-lang (a 1 2)) (define-extended-language bad-lang5 good-lang (a) (b 2))) #rx"at least one production") + (test-syn-err (define-language bad-lang5 (x 1) (x 2)) #rx"same non-terminal" 2) + (test-syn-err (define-language bad-lang6 ((x x) 1)) #rx"same non-terminal" 2) + (test-syn-err (let () + (define-language good-lang) + (define-extended-language bad-lang7 good-lang ((x x) 1))) + #rx"same non-terminal" 2) (test-syn-err (redex-match grammar m_1) #rx"before underscore") (test-syn-err (redex-match grammar (variable-except a 2 c)) #rx"expected an identifier")