mbutterick
/
br-parser-tools
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

drdr found a 'test suite' that didnt actually have expected results, so I added in expected results and fixed a few bugs that it uncovered

Browse Source 
svn: r16362

original commit: 2064861baa303b33fa49b92401d78fb2d363b9cc
tokens
Robby Findler 15 years ago
parent 9de497d854
commit 772b804fbd
2 changed files with 62 additions and 37 deletions
Show Stats Download Patch File Download Diff File

12
collects/parser-tools/lex.ss
Unescape Escape View File

@ -93,6 +93,8 @@
name)) name))
re-act-lst re-act-lst
name-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) (let-values (((trans start action-names no-look disappeared-uses)
(build-lexer re-actname-lst))) (build-lexer re-actname-lst)))
(when (vector-ref action-names start) ;; Start state is final (when (vector-ref action-names start) ;; Start state is final
@ -185,10 +187,16 @@
((_ name-form body-form) ((_ name-form body-form)
(let-values (((name body) (let-values (((name body)
(normalize-definition (syntax (define-syntax name-form body-form)) #'lambda))) (normalize-definition (syntax (define-syntax name-form body-form)) #'lambda)))
#`(define-syntax #,name #`(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) (make-lex-trans (lambda (stx)
(certifier (#,body stx) 'a))))))) (certifier (func stx) 'a)))))))
(_ (_
(raise-syntax-error (raise-syntax-error
#f #f

81
collects/parser-tools/private-lex/error-tests.ss
Unescape Escape View File

@ -1,35 +1,52 @@
(define-lex-abbrev) #lang scheme/base
(define-lex-abbrev a) (require (for-syntax scheme/base)
(define-lex-abbrev (a b) v) "../lex.ss"
(define-lex-abbrev 1 1) schemeunit)
(define-lex-abbrevs ())
(define-syntax (catch-syn-error stx)
(define-lex-trans) (syntax-case stx ()
(define-lex-trans (1 b) 1) [(_ arg)
(datum->syntax
(lexer) #'here
(lexer ("a" "b" "c")) (with-handlers ((exn:fail:syntax? exn-message))
(lexer ()) (syntax-local-expand-expression #'arg)
(lexer ("")) "not-an-error"))]))
(lexer (a 1)) (check-regexp-match #rx"lex-abbrev" (catch-syn-error (define-lex-abbrev)))
(lexer ((a) 1)) (check-regexp-match #rx"lex-abbrev" (catch-syn-error (define-lex-abbrev a)))
(let ((a 1)) (check-regexp-match #rx"lex-abbrev" (catch-syn-error (define-lex-abbrev (a b) v)))
(lexer ((a) 1))) (check-regexp-match #rx"lex-abbrev" (catch-syn-error (define-lex-abbrev 1 1)))
(let-syntax ((a 1)) (check-regexp-match #rx"lex-abbrevs" (catch-syn-error (define-lex-abbrevs ())))
(lexer ((a) 1)))
(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 () (let ()
(define-lex-trans a 1) (define-lex-trans a 1)
(let () (let ()
(lexer ((a) 1)))) (lexer ((a) 1))))))
(lexer (1 1)) (check-regexp-match #rx"regular-expression" (catch-syn-error (lexer (1 1))))
(lexer ((repetition) 1)) (check-regexp-match #rx"repetition" (catch-syn-error (lexer ((repetition) 1))))
(lexer ((repetition #\1 #\1 "3") 1)) (check-regexp-match #rx"repetition" (catch-syn-error (lexer ((repetition #\1 #\1 "3") 1))))
(lexer ((repetition 1 #\1 "3") 1)) (check-regexp-match #rx"repetition" (catch-syn-error (lexer ((repetition 1 #\1 "3") 1))))
(lexer ((repetition 1 0 "3") 1)) (check-regexp-match #rx"repetition" (catch-syn-error (lexer ((repetition 1 0 "3") 1))))
(lexer ((complement) 1)) (check-regexp-match #rx"complement" (catch-syn-error (lexer ((complement) 1))))
(lexer ((char-range) 1)) (check-regexp-match #rx"char-range" (catch-syn-error (lexer ((char-range) 1))))
(lexer ((char-range #\9 #\0) 1)) (check-regexp-match #rx"char-range" (catch-syn-error (lexer ((char-range #\9 #\0) 1))))
(lexer ((char-complement) 1)) (check-regexp-match #rx"char-complement" (catch-syn-error (lexer ((char-complement) 1))))
(lexer ((char-complement (concatenation "1" "2")) 1)) (check-regexp-match #rx"char-complement" (catch-syn-error (lexer ((char-complement (concatenation "1" "2")) 1))))

Write Preview
Loading…
Cancel
Save