244 lines
8.1 KiB
Racket
244 lines
8.1 KiB
Racket
#lang scheme
|
|
(require syntax-color/scribble-lexer)
|
|
|
|
(define in (open-input-string "@|x #|10|#| @me[1 2 #| comment |# ]{10}"))
|
|
|
|
(define (color str)
|
|
(let ([in (open-input-string str)])
|
|
(let loop ([mode #f])
|
|
(let-values ([(lexeme type paren start end backup mode) (scribble-inside-lexer in 0 mode)])
|
|
(if (eq? type 'eof)
|
|
null
|
|
(cons (list start end type backup)
|
|
(loop mode)))))))
|
|
|
|
(define (test* str len-val line)
|
|
(let ([v (color str)]
|
|
[val (let loop ([pos 1][l len-val])
|
|
(if (null? l)
|
|
null
|
|
(cons (list pos (+ pos (caar l)) (cadar l)
|
|
(if (null? (cddar l))
|
|
0
|
|
(caddar l)))
|
|
(loop (+ (+ pos (caar l))) (cdr l)))))])
|
|
(unless (equal? v val)
|
|
(printf "FAILED, line ~s\n" line)
|
|
(printf " result\n")
|
|
(pretty-print v)
|
|
(printf " is not expected\n")
|
|
(pretty-print val)
|
|
(printf "\n"))))
|
|
|
|
(define-syntax-rule (test str len-val)
|
|
(test* str len-val (syntax-line #'str)))
|
|
|
|
(test "x" '((1 string)))
|
|
(test "x{}" '((3 string)))
|
|
(test "@x" '((1 parenthesis)
|
|
(1 symbol)))
|
|
|
|
(test "@x str" '((1 parenthesis)
|
|
(1 symbol)
|
|
(4 string)))
|
|
|
|
(test "@x[] str" '((1 parenthesis)
|
|
(1 symbol)
|
|
(1 parenthesis)
|
|
(1 parenthesis)
|
|
(4 string)))
|
|
|
|
(test "@x[z] str" '((1 parenthesis)
|
|
(1 symbol)
|
|
(1 parenthesis)
|
|
(1 symbol)
|
|
(1 parenthesis)
|
|
(4 string)))
|
|
|
|
(test "@x[z +1.5] str" '((1 parenthesis)
|
|
(1 symbol)
|
|
(1 parenthesis)
|
|
(1 symbol)
|
|
(1 white-space)
|
|
(4 constant)
|
|
(1 parenthesis)
|
|
(4 string)))
|
|
|
|
(test "@x[z @w{10}] str" '((1 parenthesis)
|
|
(1 symbol) ; x
|
|
(1 parenthesis)
|
|
(1 symbol) ; z
|
|
(1 white-space)
|
|
(1 parenthesis)
|
|
(1 symbol) ; w
|
|
(1 parenthesis)
|
|
(2 string)
|
|
(1 parenthesis)
|
|
(1 parenthesis)
|
|
(4 string)))
|
|
|
|
(test "@x[a@b]{a}{b}" '((1 parenthesis)
|
|
(1 symbol)
|
|
(1 parenthesis)
|
|
(3 symbol)
|
|
(1 parenthesis)
|
|
(1 parenthesis)
|
|
(1 string)
|
|
(1 parenthesis)
|
|
(3 string)))
|
|
(test "@x{{}}" '((1 parenthesis)
|
|
(1 symbol)
|
|
(1 parenthesis)
|
|
(1 parenthesis) ; {
|
|
(1 parenthesis) ; }
|
|
(1 parenthesis)))
|
|
|
|
(test "@|x|str" '((2 parenthesis)
|
|
(1 symbol 2)
|
|
(1 parenthesis 3)
|
|
(3 string)))
|
|
(test "@|x #|ok|#|str" '((2 parenthesis)
|
|
(1 symbol 2)
|
|
(1 white-space 3)
|
|
(6 comment)
|
|
(1 parenthesis)
|
|
(3 string)))
|
|
(test "@| x ; c\n| str" '((2 parenthesis)
|
|
(1 white-space 2)
|
|
(1 symbol)
|
|
(1 white-space)
|
|
(3 comment)
|
|
(2 parenthesis)
|
|
(4 string)))
|
|
(test "@|(a|b|)|str" '((2 parenthesis)
|
|
(1 parenthesis 2)
|
|
(4 symbol 3)
|
|
(1 parenthesis 7)
|
|
(1 parenthesis 8)
|
|
(3 string)))
|
|
|
|
(test "@#|bad|#x str" '((1 parenthesis)
|
|
(7 error)
|
|
(1 symbol)
|
|
(4 string)))
|
|
(test "@@x" '((1 parenthesis)
|
|
(1 parenthesis)
|
|
(1 symbol)))
|
|
(test "@|@x|z" '((2 parenthesis)
|
|
(1 parenthesis 2)
|
|
(1 symbol)
|
|
(1 parenthesis)
|
|
(1 string)))
|
|
(test "@@x[1 2][3]" '((1 parenthesis)
|
|
(1 parenthesis)
|
|
(1 symbol)
|
|
(1 parenthesis)
|
|
(1 constant)
|
|
(1 white-space)
|
|
(1 constant)
|
|
(1 parenthesis)
|
|
(1 parenthesis)
|
|
(1 constant)
|
|
(1 parenthesis)))
|
|
|
|
(test "@{1 2}" '((2 parenthesis)
|
|
(3 string)
|
|
(1 parenthesis)))
|
|
(test "@|=={1 2}==|" '((5 parenthesis)
|
|
(3 string)
|
|
(4 parenthesis)))
|
|
(test "@'{1 2}" '((1 parenthesis)
|
|
(1 constant)
|
|
(1 parenthesis)
|
|
(3 string)
|
|
(1 parenthesis)))
|
|
(test "@',#,#`|>>{1 2}<<|" '((1 parenthesis)
|
|
(1 constant) ; ,
|
|
(1 other) ; ,
|
|
(2 other) ; #,
|
|
(2 constant) ; #`
|
|
(4 parenthesis)
|
|
(3 string)
|
|
(4 parenthesis)))
|
|
|
|
(test "@x|{10}|" '((1 parenthesis)
|
|
(1 symbol)
|
|
(2 parenthesis)
|
|
(2 string)
|
|
(2 parenthesis)))
|
|
(test "@x|{@q}|" '((1 parenthesis)
|
|
(1 symbol)
|
|
(2 parenthesis)
|
|
(2 string)
|
|
(2 parenthesis)))
|
|
(test "@x|!!{@q}!!|" '((1 parenthesis)
|
|
(1 symbol)
|
|
(4 parenthesis)
|
|
(2 string)
|
|
(4 parenthesis)))
|
|
(test "@x|(({@q}))|" '((1 parenthesis)
|
|
(1 symbol)
|
|
(4 parenthesis)
|
|
(2 string)
|
|
(4 parenthesis)))
|
|
(test "@x|<<{a|<<@a[10]}>>|" '((1 parenthesis)
|
|
(1 symbol)
|
|
(4 parenthesis)
|
|
(1 string)
|
|
(4 parenthesis)
|
|
(1 symbol)
|
|
(1 parenthesis)
|
|
(2 constant)
|
|
(1 parenthesis)
|
|
(4 parenthesis)))
|
|
(test "@x|{ |{ } }|}|" '((1 parenthesis)
|
|
(1 symbol)
|
|
(2 parenthesis)
|
|
(1 string)
|
|
(2 parenthesis) ; |{
|
|
(3 string)
|
|
(2 parenthesis) ; }|
|
|
(2 parenthesis)))
|
|
|
|
(test "@`',@foo{blah}" '((1 parenthesis)
|
|
(1 constant) ; `
|
|
(1 constant) ; '
|
|
(2 other) ; ,@
|
|
(3 symbol)
|
|
(1 parenthesis)
|
|
(4 string)
|
|
(1 parenthesis)))
|
|
|
|
(test "@; 1" '((4 comment)))
|
|
(test "@; 1\nv" '((4 comment)
|
|
(1 white-space)
|
|
(1 string)))
|
|
(test "@;{1}v" '((2 comment)
|
|
(1 parenthesis)
|
|
(1 string)
|
|
(1 parenthesis)
|
|
(1 string)))
|
|
(test "@;|{1 }} }|v" '((2 comment)
|
|
(2 parenthesis)
|
|
(5 string)
|
|
(2 parenthesis)
|
|
(1 string)))
|
|
|
|
(test "a\n b" '((1 string)
|
|
(3 white-space)
|
|
(1 string)))
|
|
(test "@item{A\nB}" '((1 parenthesis)
|
|
(4 symbol)
|
|
(1 parenthesis)
|
|
(1 string)
|
|
(1 white-space)
|
|
(1 string)
|
|
(1 parenthesis)))
|
|
|
|
(test "@|()|})|" '((2 parenthesis)
|
|
(1 parenthesis 2)
|
|
(1 parenthesis 3)
|
|
(1 parenthesis 4)
|
|
(3 string)))
|
|
|