suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjust scribble-lexer test to handle errors

Browse Source
This commit is contained in:
Robby Findler 2013-02-26 09:16:37 -06:00
parent 3c295d14d0
commit bc479b41c5
1 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/tests/syntax-color/scribble-lexer.rkt
View File

@ -4,13 +4,15 @@
(define in (open-input-string "@|x #|10|#| @me[1 2 #| comment |# ]{10}")) (define in (open-input-string "@|x #|10|#| @me[1 2 #| comment |# ]{10}"))
(define (color str) (define (color str)
(let ([in (open-input-string str)]) (with-handlers ((exn:fail? exn-message))
(let loop ([mode #f]) (let ([in (open-input-string str)])
(let-values ([(lexeme type paren start end backup mode) (scribble-inside-lexer in 0 mode)]) (port-count-lines! in)
(if (eq? type 'eof) (let loop ([mode #f])
null (let-values ([(lexeme type paren start end backup mode) (scribble-inside-lexer in 0 mode)])
(cons (list start end type backup) (if (eq? type 'eof)
(loop mode))))))) null
(cons (list start end type backup)
(loop mode))))))))
(define (test* str len-val line) (define (test* str len-val line)
(let ([v (color str)] (let ([v (color str)]
@ -24,9 +26,12 @@
(loop (+ (+ pos (caar l))) (cdr l)))))]) (loop (+ (+ pos (caar l))) (cdr l)))))])
(unless (equal? v val) (unless (equal? v val)
(eprintf "FAILED, line ~s\n" line) (eprintf "FAILED, line ~s\n" line)
(eprintf " result\n") (cond [(string? v)
(pretty-print v (current-error-port)) (eprintf "~a\nexpected\n" v)]
(eprintf " is not expected\n") [else
(eprintf " result\n")
(pretty-print v (current-error-port))
(eprintf " is not expected\n")])
(pretty-print val (current-error-port)) (pretty-print val (current-error-port))
(eprintf "\n")))) (eprintf "\n"))))
@ -240,4 +245,3 @@
(1 parenthesis 3) (1 parenthesis 3)
(1 parenthesis 4) (1 parenthesis 4)
(3 string))) (3 string)))