390 lines
13 KiB
Racket
390 lines
13 KiB
Racket
#lang at-exp racket/base
|
|
(require rackunit
|
|
syntax-color/racket-lexer
|
|
syntax-color/scribble-lexer
|
|
syntax-color/lexer-contract
|
|
racket/contract/option
|
|
2d/private/lexer
|
|
racket/port)
|
|
|
|
(check-equal? (cropped-regions 0 10 '()) '())
|
|
(check-equal? (cropped-regions 0 10 '((0 . 10))) '((0 . 10)))
|
|
(check-equal? (cropped-regions 0 10 '((0 . 5) (7 . 10))) '((7 . 10) (0 . 5)))
|
|
(check-equal? (cropped-regions 0 10 '((-1 . 4))) '((0 . 4)))
|
|
(check-equal? (cropped-regions 0 10 '((-4 . -3))) '())
|
|
(check-equal? (cropped-regions 0 10 '((20 . 30))) '())
|
|
(check-equal? (cropped-regions 0 10 '((1 . 4) (5 . 20))) '((5 . 10) (1 . 4)))
|
|
(check-equal? (cropped-regions 0 10 '((-5 . 10))) '((0 . 10)))
|
|
(check-equal? (cropped-regions 13 37 '((11 . 13))) '())
|
|
|
|
(define (run-lexer #:sub-lexer [sub-lexer/no-ex racket-lexer] . strs/specials)
|
|
(define sub-lexer (if (has-option? sub-lexer/no-ex)
|
|
(exercise-option sub-lexer/no-ex)
|
|
sub-lexer/no-ex))
|
|
(define-values (in out) (make-pipe-with-specials))
|
|
(thread
|
|
(λ ()
|
|
(let loop ([s strs/specials])
|
|
(cond
|
|
[(list? s)
|
|
(for ([s (in-list strs/specials)])
|
|
(loop s))]
|
|
[(string? s) (display s out)]
|
|
[else (write-special s out)]))
|
|
(close-output-port out)))
|
|
(port-count-lines! in)
|
|
(define the-lexer (exercise-option (2d-lexer sub-lexer)))
|
|
(let loop ([mode #f])
|
|
(define-values (val tok paren start end backup new-mode)
|
|
(the-lexer in 0 mode))
|
|
(cons (list val tok paren start end backup)
|
|
(cond
|
|
[(equal? tok 'eof) '()]
|
|
[else (loop (if (dont-stop? new-mode)
|
|
(dont-stop-val new-mode)
|
|
new-mode))]))))
|
|
|
|
(check-equal?
|
|
(run-lexer "1234\n#2d\n")
|
|
`(("1234" constant #f 1 5 0)
|
|
("\n" white-space #f 5 6 0)
|
|
("#2d\n" error #f 6 10 0)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
(run-lexer "#2dsomething")
|
|
`(("#2dsomething" error #f 1 13 0)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
(run-lexer "#2dsomething\n")
|
|
`(("#2dsomething\n" error #f 1 14 0)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
(run-lexer "#2dsomething\n╔═══╗\n║ ║")
|
|
`(("#2dsomething\n╔═══╗\n║ ║" error #f 1 25 0)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
(run-lexer "#2dsomething\n \n")
|
|
`(("#2dsomething" hash-colon-keyword #f 1 13 0)
|
|
("\n" white-space #f 13 14 13)
|
|
(" \n" error #f 14 17 14)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
@run-lexer{#2d
|
|
╔══╦═══╗
|
|
║+ ║"a"║
|
|
╠══╬═══╣
|
|
║34║"b"║
|
|
╚══╩═══╝}
|
|
`(("#2d" hash-colon-keyword #f 1 4 0)
|
|
("\n" white-space #f 4 5 4)
|
|
("╔══╦═══╗" parenthesis #f 5 13 5)
|
|
(" " white-space #f 13 14 13)
|
|
("║" parenthesis #f 14 15 14)
|
|
("+" symbol #f 15 16 15)
|
|
(" " white-space #f 16 17 16)
|
|
("║" parenthesis #f 17 18 17)
|
|
("\"a\"" string #f 18 21 18)
|
|
("║" parenthesis #f 21 22 21)
|
|
(" " white-space #f 22 23 22)
|
|
("╠══╬═══╣" parenthesis #f 23 31 23)
|
|
(" " white-space #f 31 32 31)
|
|
("║" parenthesis #f 32 33 32)
|
|
("34" constant #f 33 35 33)
|
|
("║" parenthesis #f 35 36 35)
|
|
("\"b\"" string #f 36 39 36)
|
|
("║" parenthesis #f 39 40 39)
|
|
(" " white-space #f 40 41 40)
|
|
("╚══╩═══╝" parenthesis #f 41 49 41)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
@run-lexer["#2d\r\n"]{╔══╦═══╗
|
|
║+ ║"a"║
|
|
╠══╬═══╣
|
|
║34║"b"║
|
|
╚══╩═══╝}
|
|
`(("#2d" hash-colon-keyword #f 1 4 0)
|
|
("\r\n" white-space #f 4 5 4)
|
|
("╔══╦═══╗" parenthesis #f 5 13 5)
|
|
(" " white-space #f 13 14 13)
|
|
("║" parenthesis #f 14 15 14)
|
|
("+" symbol #f 15 16 15)
|
|
(" " white-space #f 16 17 16)
|
|
("║" parenthesis #f 17 18 17)
|
|
("\"a\"" string #f 18 21 18)
|
|
("║" parenthesis #f 21 22 21)
|
|
(" " white-space #f 22 23 22)
|
|
("╠══╬═══╣" parenthesis #f 23 31 23)
|
|
(" " white-space #f 31 32 31)
|
|
("║" parenthesis #f 32 33 32)
|
|
("34" constant #f 33 35 33)
|
|
("║" parenthesis #f 35 36 35)
|
|
("\"b\"" string #f 36 39 36)
|
|
("║" parenthesis #f 39 40 39)
|
|
(" " white-space #f 40 41 40)
|
|
("╚══╩═══╝" parenthesis #f 41 49 41)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(printf "skipping the \\r\\n test: see the cracks-filled-in-tokens definition for where the bug lies\n")
|
|
#;
|
|
(check-equal?
|
|
(run-lexer "#2d\r\n"
|
|
"╔══╦═══╗\r\n"
|
|
"║+ ║abc║\r\n"
|
|
"╠══╬═══╣\r\n"
|
|
"║34║def║\r\n"
|
|
"╚══╩═══╝\r\n")
|
|
`(("#2d" hash-colon-keyword #f 1 4 0)
|
|
("\r\n" white-space #f 4 5 4)
|
|
("╔══╦═══╗" parenthesis #f 5 13 5)
|
|
(" " white-space #f 13 14 13)
|
|
("║" parenthesis #f 14 15 14)
|
|
("+" symbol #f 15 16 15)
|
|
(" " white-space #f 16 17 16)
|
|
("║" parenthesis #f 17 18 17)
|
|
("\"a\"" string #f 18 21 18)
|
|
("║" parenthesis #f 21 22 21)
|
|
(" " white-space #f 22 23 22)
|
|
("╠══╬═══╣" parenthesis #f 23 31 23)
|
|
(" " white-space #f 31 32 31)
|
|
("║" parenthesis #f 32 33 32)
|
|
("34" constant #f 33 35 33)
|
|
("║" parenthesis #f 35 36 35)
|
|
("\"b\"" string #f 36 39 36)
|
|
("║" parenthesis #f 39 40 39)
|
|
(" " white-space #f 40 41 40)
|
|
("╚══╩═══╝" parenthesis #f 41 49 41)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
;; test tokens that cross lines (and thus need cropping)
|
|
(check-equal?
|
|
@run-lexer{#2d
|
|
╔══╦═══╗
|
|
║+ ║"a ║
|
|
║+ ║ a"║
|
|
╠══╬═══╣
|
|
║34║"b"║
|
|
╚══╩═══╝}
|
|
`(("#2d" hash-colon-keyword #f 1 4 0)
|
|
("\n" white-space #f 4 5 4)
|
|
("╔══╦═══╗" parenthesis #f 5 13 5)
|
|
(" " white-space #f 13 14 13)
|
|
("║" parenthesis #f 14 15 14)
|
|
("+" symbol #f 15 16 15)
|
|
(" " white-space #f 16 17 16)
|
|
("║" parenthesis #f 17 18 17)
|
|
("\"a " string #f 18 21 18)
|
|
("║" parenthesis #f 21 22 21)
|
|
(" " white-space #f 22 23 22)
|
|
("║" parenthesis #f 23 24 23)
|
|
("+" symbol #f 24 25 24)
|
|
(" " white-space #f 25 26 25)
|
|
("║" parenthesis #f 26 27 26)
|
|
(" a\"" string #f 27 30 27)
|
|
("║" parenthesis #f 30 31 30)
|
|
(" " white-space #f 31 32 31)
|
|
("╠══╬═══╣" parenthesis #f 32 40 32)
|
|
(" " white-space #f 40 41 40)
|
|
("║" parenthesis #f 41 42 41)
|
|
("34" constant #f 42 44 42)
|
|
("║" parenthesis #f 44 45 44)
|
|
("\"b\"" string #f 45 48 45)
|
|
("║" parenthesis #f 48 49 48)
|
|
(" " white-space #f 49 50 49)
|
|
("╚══╩═══╝" parenthesis #f 50 58 50)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
@run-lexer{#2d
|
|
╔══╦═══╗
|
|
║+ ║ "a"║
|
|
╠══╬═══╣
|
|
║34║"b"║
|
|
╚══╩═══╝}
|
|
`(("#2d" hash-colon-keyword #f 1 4 0)
|
|
("\n" white-space #f 4 5 4)
|
|
("╔══╦═══╗\n║+ ║ \"a" no-color #f 5 21 5)
|
|
("\"║\n╠══╬═══╣\n║34║\"b\"║\n╚══╩═══╝" error #f 21 50 21)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
@run-lexer["#2d\r\n"]{╔══╦═══╗
|
|
║+ ║ "a"║
|
|
╠══╬═══╣
|
|
║34║"b"║
|
|
╚══╩═══╝}
|
|
`(("#2d" hash-colon-keyword #f 1 4 0)
|
|
("\r\n" white-space #f 4 5 4)
|
|
("╔══╦═══╗\n║+ ║ \"a" no-color #f 5 21 5)
|
|
("\"║\n╠══╬═══╣\n║34║\"b\"║\n╚══╩═══╝" error #f 21 50 21)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
(run-lexer " #2d\n"
|
|
" ╔═╦═╗\n"
|
|
" ║1║2║\n"
|
|
" ╠═╬═╣\n"
|
|
" ║3║4║\n"
|
|
" ╚═╩═╝\n")
|
|
`((" " white-space #f 1 4 0)
|
|
("#2d" hash-colon-keyword #f 4 7 0)
|
|
("\n" white-space #f 7 8 7)
|
|
(" " white-space #f 8 11 8)
|
|
("╔═╦═╗" parenthesis #f 11 16 11)
|
|
(" " white-space #f 16 20 16)
|
|
("║" parenthesis #f 20 21 20)
|
|
("1" constant #f 21 22 21)
|
|
("║" parenthesis #f 22 23 22)
|
|
("2" constant #f 23 24 23)
|
|
("║" parenthesis #f 24 25 24)
|
|
(" " white-space #f 25 29 25)
|
|
("╠═╬═╣" parenthesis #f 29 34 29)
|
|
(" " white-space #f 34 38 34)
|
|
("║" parenthesis #f 38 39 38)
|
|
("3" constant #f 39 40 39)
|
|
("║" parenthesis #f 40 41 40)
|
|
("4" constant #f 41 42 41)
|
|
("║" parenthesis #f 42 43 42)
|
|
(" " white-space #f 43 47 43) ("╚═╩═╝" parenthesis #f 47 52 47)
|
|
("\n" white-space #f 52 53 0)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(define-values (dont-care dont-care?)
|
|
(let ()
|
|
(struct dont-care ())
|
|
(values (dont-care) dont-care?)))
|
|
|
|
(define (equal?/dont-care x y)
|
|
(let loop ([x x][y y])
|
|
(cond
|
|
[(or (dont-care? x) (dont-care? y))
|
|
#t]
|
|
[(and (pair? x) (pair? y))
|
|
(and (loop (car x) (car y))
|
|
(loop (cdr x) (cdr y)))]
|
|
[else (equal? x y)])))
|
|
|
|
(check-pred
|
|
(λ (x)
|
|
(equal?/dont-care
|
|
x
|
|
`(("#2d" hash-colon-keyword #f 1 4 0)
|
|
("\n" white-space #f 4 5 4)
|
|
("╔═════╦═══════╗" parenthesis #f 5 20 5)
|
|
(" " white-space #f 20 21 20)
|
|
("║" parenthesis #f 21 22 21)
|
|
("@" parenthesis #f 22 23 22)
|
|
("f" symbol #f 23 24 23)
|
|
("{" parenthesis |{| 24 25 24)
|
|
(,dont-care text #f 25 26 25)
|
|
("}" parenthesis |}| 26 27 26)
|
|
("║" parenthesis #f 27 28 27)
|
|
(" " white-space #f 28 29 28)
|
|
("@" parenthesis #f 29 30 29)
|
|
("g" symbol #f 30 31 30)
|
|
("{" parenthesis |{| 31 32 31)
|
|
(,dont-care text #f 32 33 32)
|
|
("}" parenthesis |}| 33 34 33)
|
|
(" " white-space #f 34 35 34)
|
|
("║" parenthesis #f 35 36 35)
|
|
(" " white-space #f 36 37 36)
|
|
("╠═════╬═══════╣" parenthesis #f 37 52 37)
|
|
(" " white-space #f 52 53 52)
|
|
("║" parenthesis #f 53 54 53)
|
|
("@" parenthesis #f 54 55 54)
|
|
("h" symbol #f 55 56 55)
|
|
("{" parenthesis |{| 56 57 56)
|
|
(,dont-care text #f 57 58 57)
|
|
("}" parenthesis |}| 58 59 58)
|
|
("║" parenthesis #f 59 60 59)
|
|
(" " white-space #f 60 61 60)
|
|
("@" parenthesis #f 61 62 61)
|
|
("i" symbol #f 62 63 62)
|
|
("{" parenthesis |{| 63 64 63)
|
|
(,dont-care text #f 64 65 64)
|
|
("}" parenthesis |}| 65 66 65)
|
|
(" " white-space #f 66 67 66)
|
|
("║" parenthesis #f 67 68 67)
|
|
(" " white-space #f 68 69 68)
|
|
("╚═════╩═══════╝" parenthesis #f 69 84 69)
|
|
("\n" white-space #f 84 85 0)
|
|
(,eof eof #f 85 85 0))))
|
|
(run-lexer #:sub-lexer scribble-lexer
|
|
"#2d\n"
|
|
"╔═════╦═══════╗\n"
|
|
"║@f{x}║ @g{y} ║\n"
|
|
"╠═════╬═══════╣\n"
|
|
"║@h{z}║ @i{w} ║\n"
|
|
"╚═════╩═══════╝\n"))
|
|
|
|
(check-equal?
|
|
(run-lexer "#2" 'not-a-char)
|
|
`(("#2" error #f 1 3 0)
|
|
("" no-color #f 3 4 0)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
(run-lexer "#2d\n" 'not-a-char)
|
|
`(("#2d" hash-colon-keyword #f 1 4 0)
|
|
("\n" white-space #f 4 5 4)
|
|
(" " error #f 5 6 5)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
(run-lexer "#2d\n╔" 'not-a-char)
|
|
`(("#2d" hash-colon-keyword #f 1 4 0)
|
|
("\n" white-space #f 4 5 4)
|
|
("╔" no-color #f 5 6 5)
|
|
(" " error #f 6 7 6)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
|
|
(check-equal?
|
|
(run-lexer "#2dsomething\n"
|
|
"╔═══╗\n"
|
|
"║ " 'special " ║\n"
|
|
"╚═══╝")
|
|
`(("#2dsomething" hash-colon-keyword #f 1 13 0)
|
|
("\n" white-space #f 13 14 13)
|
|
("╔═══╗\n║ " no-color #f 14 22 14)
|
|
(" ║\n╚═══╝" error #f 22 31 22)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
(run-lexer "#2dsomething\n"
|
|
"╔═══╗\n"
|
|
'special
|
|
" ║\n"
|
|
"╚═══╝")
|
|
`(("#2dsomething" hash-colon-keyword #f 1 13 0)
|
|
("\n" white-space #f 13 14 13)
|
|
("╔═══╗\n" no-color #f 14 20 14)
|
|
(" ║\n╚═══╝" error #f 20 31 20)
|
|
(,eof eof #f #f #f 0)))
|
|
|
|
(check-equal?
|
|
(run-lexer "#2dwhatever\n"
|
|
"╔════╦════╗\n"
|
|
"║123;║5678║\n"
|
|
"╚════╩════╝\n")
|
|
`(("#2dwhatever" hash-colon-keyword #f 1 12 0)
|
|
("\n" white-space #f 12 13 12)
|
|
("╔════╦════╗" parenthesis #f 13 24 13)
|
|
(" " white-space #f 24 25 24)
|
|
("║" parenthesis #f 25 26 25)
|
|
("123" constant #f 26 29 26)
|
|
(" " comment #f 29 30 29)
|
|
("║" parenthesis #f 30 31 30)
|
|
("5678" constant #f 31 35 31)
|
|
("║" parenthesis #f 35 36 35)
|
|
(" " white-space #f 36 37 36)
|
|
("╚════╩════╝" parenthesis #f 37 48 37)
|
|
("\n" white-space #f 48 49 0)
|
|
(,eof eof #f #f #f 0)))
|
|
|