diff --git a/collects/parser-tools/lex.ss b/collects/parser-tools/lex.ss index 7613ecc..c6ec59a 100644 --- a/collects/parser-tools/lex.ss +++ b/collects/parser-tools/lex.ss @@ -93,6 +93,8 @@ name)) re-act-lst name-lst))) + (when (null? spec/re-act-lst) + (raise-syntax-error (if src-pos? 'lexer/src-pos 'lexer) "expected at least one action" stx)) (let-values (((trans start action-names no-look disappeared-uses) (build-lexer re-actname-lst))) (when (vector-ref action-names start) ;; Start state is final @@ -185,10 +187,16 @@ ((_ name-form body-form) (let-values (((name body) (normalize-definition (syntax (define-syntax name-form body-form)) #'lambda))) + #`(define-syntax #,name - (let ((certifier (syntax-local-certifier))) + (let ((certifier (syntax-local-certifier)) + (func #,body)) + (unless (procedure? func) + (raise-syntax-error 'define-lex-trans "expected a procedure as the transformer, got ~e" func)) + (unless (procedure-arity-includes? func 1) + (raise-syntax-error 'define-lex-trans "expected a procedure that accepts 1 argument as the transformer, got ~e" func)) (make-lex-trans (lambda (stx) - (certifier (#,body stx) 'a))))))) + (certifier (func stx) 'a))))))) (_ (raise-syntax-error #f diff --git a/collects/parser-tools/private-lex/error-tests.ss b/collects/parser-tools/private-lex/error-tests.ss index 6129622..337e41e 100644 --- a/collects/parser-tools/private-lex/error-tests.ss +++ b/collects/parser-tools/private-lex/error-tests.ss @@ -1,35 +1,52 @@ -(define-lex-abbrev) -(define-lex-abbrev a) -(define-lex-abbrev (a b) v) -(define-lex-abbrev 1 1) -(define-lex-abbrevs ()) - -(define-lex-trans) -(define-lex-trans (1 b) 1) - -(lexer) -(lexer ("a" "b" "c")) -(lexer ()) -(lexer ("")) - -(lexer (a 1)) -(lexer ((a) 1)) -(let ((a 1)) - (lexer ((a) 1))) -(let-syntax ((a 1)) - (lexer ((a) 1))) -(let () - (define-lex-trans a 1) - (let () - (lexer ((a) 1)))) - -(lexer (1 1)) -(lexer ((repetition) 1)) -(lexer ((repetition #\1 #\1 "3") 1)) -(lexer ((repetition 1 #\1 "3") 1)) -(lexer ((repetition 1 0 "3") 1)) -(lexer ((complement) 1)) -(lexer ((char-range) 1)) -(lexer ((char-range #\9 #\0) 1)) -(lexer ((char-complement) 1)) -(lexer ((char-complement (concatenation "1" "2")) 1)) +#lang scheme/base +(require (for-syntax scheme/base) + "../lex.ss" + schemeunit) + +(define-syntax (catch-syn-error stx) + (syntax-case stx () + [(_ arg) + (datum->syntax + #'here + (with-handlers ((exn:fail:syntax? exn-message)) + (syntax-local-expand-expression #'arg) + "not-an-error"))])) + +(check-regexp-match #rx"lex-abbrev" (catch-syn-error (define-lex-abbrev))) +(check-regexp-match #rx"lex-abbrev" (catch-syn-error (define-lex-abbrev a))) +(check-regexp-match #rx"lex-abbrev" (catch-syn-error (define-lex-abbrev (a b) v))) +(check-regexp-match #rx"lex-abbrev" (catch-syn-error (define-lex-abbrev 1 1))) +(check-regexp-match #rx"lex-abbrevs" (catch-syn-error (define-lex-abbrevs ()))) + +(check-regexp-match #rx"lex-trans" (catch-syn-error (define-lex-trans))) + +(check-regexp-match #rx"lexer" (catch-syn-error (lexer))) +(check-regexp-match #rx"lexer" (catch-syn-error (lexer ("a" "b" "c")))) +(check-regexp-match #rx"lexer" (catch-syn-error (lexer ()))) +(check-regexp-match #rx"lexer" (catch-syn-error (lexer ("")))) + +(check-regexp-match #rx"regular-expression" (catch-syn-error (lexer (a 1)))) +(check-regexp-match #rx"regular-expression" (catch-syn-error (lexer ((a) 1)))) +(check-regexp-match #rx"regular-expression" (catch-syn-error (let ((a 1)) (lexer ((a) 1))))) + +(check-regexp-match #rx"regular-expression" + (catch-syn-error (let-syntax ((a 1)) + (lexer ((a) 1))))) + +(check-regexp-match #rx"define-lex-trans" + (catch-syn-error + (let () + (define-lex-trans a 1) + (let () + (lexer ((a) 1)))))) + +(check-regexp-match #rx"regular-expression" (catch-syn-error (lexer (1 1)))) +(check-regexp-match #rx"repetition" (catch-syn-error (lexer ((repetition) 1)))) +(check-regexp-match #rx"repetition" (catch-syn-error (lexer ((repetition #\1 #\1 "3") 1)))) +(check-regexp-match #rx"repetition" (catch-syn-error (lexer ((repetition 1 #\1 "3") 1)))) +(check-regexp-match #rx"repetition" (catch-syn-error (lexer ((repetition 1 0 "3") 1)))) +(check-regexp-match #rx"complement" (catch-syn-error (lexer ((complement) 1)))) +(check-regexp-match #rx"char-range" (catch-syn-error (lexer ((char-range) 1)))) +(check-regexp-match #rx"char-range" (catch-syn-error (lexer ((char-range #\9 #\0) 1)))) +(check-regexp-match #rx"char-complement" (catch-syn-error (lexer ((char-complement) 1)))) +(check-regexp-match #rx"char-complement" (catch-syn-error (lexer ((char-complement (concatenation "1" "2")) 1))))