Move tests from unstable.
This commit is contained in:
Vincent St-Amour
parent
db8d11d37c
commit
5fbd4c77d2
11
2d-test/LICENSE.txt
Normal file
11
2d-test/LICENSE.txt
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
2d-test
|
||||
Copyright (c) 2010-2015 PLT Design Inc.
|
||||
|
||||
This package is distributed under the GNU Lesser General Public
|
||||
License (LGPL). This means that you can link this package into proprietary
|
||||
applications, provided you follow the rules stated in the LGPL. You
|
||||
can also modify this package; if you distribute a modified version,
|
||||
you must distribute it under the terms of the LGPL, which in
|
||||
particular means that you must release the source code for the
|
||||
modified software. See http://www.gnu.org/copyleft/lesser.html
|
||||
for more information.
|
||||
8
2d-test/info.rkt
Normal file
8
2d-test/info.rkt
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
#lang info
|
||||
|
||||
(define collection "2d")
|
||||
(define version "1.0")
|
||||
(define deps '("base" "2d-lib"))
|
||||
(define build-deps '("rackunit-lib" "unstable-options-lib"))
|
||||
(define pkg-desc "tests for \"2d\"")
|
||||
(define pkg-authors '(robby))
|
||||
104
2d-test/tests/cond-test.rkt
Normal file
104
2d-test/tests/cond-test.rkt
Normal file
|
|
@ -0,0 +1,104 @@
|
|||
#lang 2d racket/base
|
||||
(require 2d/cond
|
||||
rackunit)
|
||||
|
||||
(define (basic a b c d)
|
||||
#2dcond
|
||||
╔═══╦═══╦═══╗
|
||||
║ ║ a ║ b ║
|
||||
╠═══╬═══╬═══╣
|
||||
║ c ║ 1 ║ 2 ║
|
||||
╠═══╬═══╬═══╣
|
||||
║ d ║ 3 ║ 4 ║
|
||||
╚═══╩═══╩═══╝)
|
||||
|
||||
(define ((matches reg) exn) (regexp-match? reg (exn-message exn)))
|
||||
|
||||
(check-equal? (basic #t #t #t #t) 1)
|
||||
(check-equal? (basic #t #f #t #f) 1)
|
||||
(check-equal? (basic #f #t #t #t) 2)
|
||||
(check-equal? (basic #f #t #t #f) 2)
|
||||
(check-equal? (basic #t #t #f #t) 3)
|
||||
(check-equal? (basic #t #f #f #t) 3)
|
||||
(check-equal? (basic #f #t #f #t) 4)
|
||||
(check-exn (matches #rx"x-direction questions")
|
||||
(λ () (basic #f #f #f #f)))
|
||||
(check-exn (matches #rx"y-direction questions.*x coordinate 1")
|
||||
(λ () (basic #t #f #f #f)))
|
||||
(check-exn (matches #rx"y-direction questions.*x coordinate 2")
|
||||
(λ () (basic #f #t #f #f)))
|
||||
|
||||
(define (bot-right-cell a b c d)
|
||||
#2dcond
|
||||
╔═══╦═══╦═══╗
|
||||
║ ║ a ║ b ║
|
||||
╠═══╬═══╩═══╣
|
||||
║ c ║ 1 ║
|
||||
╠═══╣ ╔═══╣
|
||||
║ d ║ ║ 2 ║
|
||||
╚═══╩═══╩═══╝)
|
||||
|
||||
(check-equal? (bot-right-cell #t #t #t #t) 1)
|
||||
(check-equal? (bot-right-cell #t #f #t #f) 1)
|
||||
(check-equal? (bot-right-cell #f #t #t #t) 1)
|
||||
(check-equal? (bot-right-cell #f #t #t #f) 1)
|
||||
(check-equal? (bot-right-cell #t #t #f #t) 1)
|
||||
(check-equal? (bot-right-cell #t #f #f #t) 1)
|
||||
(check-equal? (bot-right-cell #f #t #f #t) 2)
|
||||
|
||||
(define (top-left-cell a b c d)
|
||||
#2dcond
|
||||
╔═══╦═══╦═══╗
|
||||
║ ║ a ║ b ║
|
||||
╠═══╬═══╬═══╣
|
||||
║ c ║ 1 ║ ║
|
||||
╠═══╬═══╝ ║
|
||||
║ d ║ 2 ║
|
||||
╚═══╩═══════╝)
|
||||
|
||||
(check-equal? (top-left-cell #t #t #t #t) 1)
|
||||
(check-equal? (top-left-cell #t #f #t #f) 1)
|
||||
(check-equal? (top-left-cell #f #t #t #t) 2)
|
||||
(check-equal? (top-left-cell #f #t #t #f) 2)
|
||||
(check-equal? (top-left-cell #t #t #f #t) 2)
|
||||
(check-equal? (top-left-cell #t #f #f #t) 2)
|
||||
(check-equal? (top-left-cell #f #t #f #t) 2)
|
||||
|
||||
(let ([sp (open-output-string)])
|
||||
(define (f x) (printf "~a\n" x) #f)
|
||||
(parameterize ([current-output-port sp])
|
||||
#2dcond
|
||||
╔═════╦═══════╦═══════╦════╗
|
||||
║ ║ (f 1) ║ (f 2) ║ #t ║
|
||||
╠═════╬═══════╩═══════╩════╣
|
||||
║(f 3)║ ║
|
||||
╠═════╣ ║
|
||||
║(f 4)║ 222 ║
|
||||
╠═════╣ ║
|
||||
║ #t ║ ║
|
||||
╚═════╩════════════════════╝)
|
||||
(check-equal? (get-output-string sp)
|
||||
"1\n2\n3\n4\n"))
|
||||
|
||||
|
||||
(define (try-else a b c)
|
||||
#2dcond
|
||||
╔════╦════╦════╗
|
||||
║ ║ a ║else║
|
||||
╠════╬════╬════╣
|
||||
║ b ║ 1 ║ 2 ║
|
||||
╠════╬════╬════╣
|
||||
║ c ║ 3 ║ 4 ║
|
||||
╠════╬════╬════╣
|
||||
║else║ 5 ║ 6 ║
|
||||
╚════╩════╩════╝)
|
||||
|
||||
(require rackunit)
|
||||
(check-equal? (try-else #t #t #f) 1)
|
||||
(check-equal? (try-else #f #t #f) 2)
|
||||
(check-equal? (try-else #t #f #f) 5)
|
||||
(check-equal? (try-else #f #f #f) 6)
|
||||
|
||||
|
||||
|
||||
|
||||
3
2d-test/tests/info.rkt
Normal file
3
2d-test/tests/info.rkt
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
#lang info
|
||||
|
||||
(define test-responsibles '((all robby)))
|
||||
77
2d-test/tests/lexer-stress-test.rkt
Normal file
77
2d-test/tests/lexer-stress-test.rkt
Normal file
|
|
@ -0,0 +1,77 @@
|
|||
#lang racket/gui
|
||||
|
||||
(require framework/private/color-local-member-name
|
||||
syntax-color/racket-lexer
|
||||
2d/lexer
|
||||
framework)
|
||||
|
||||
(define f (new frame% [label ""] [width 400] [height 600]))
|
||||
(define t (new (class racket:text%
|
||||
(define/override (tokenizing-give-up-early)
|
||||
(when (zero? (random 2))
|
||||
(do-something))
|
||||
#t)
|
||||
(super-new))))
|
||||
(define ec (new editor-canvas% [parent f] [editor t]))
|
||||
|
||||
(define count 0)
|
||||
|
||||
(define (do-something)
|
||||
(queue-callback (λ ()
|
||||
(set! count (+ count 1))
|
||||
(cond
|
||||
[(< count 100)
|
||||
(cond
|
||||
[(send t find-string "-" 'forward 0)
|
||||
=>
|
||||
(λ (x)
|
||||
(send t delete x (+ x 1)))]
|
||||
[else
|
||||
;; these two numbers are dependent
|
||||
;; on the string constant below
|
||||
(define n (+ 36 (random 448)))
|
||||
(define howmany (+ 1 (random 2)))
|
||||
(for ([x (in-range howmany)])
|
||||
(send t insert "-" n n))])]
|
||||
[else
|
||||
(send tmr stop)
|
||||
(send f show #f)]))))
|
||||
|
||||
(define tmr (new timer% [notify-callback do-something] [interval 100]))
|
||||
|
||||
(send f show #t)
|
||||
|
||||
(send t insert
|
||||
#<<---
|
||||
#lang 2d racket/base
|
||||
|
||||
#2dx
|
||||
╔═══╦═══╦═══╦═══╗
|
||||
║ 1 ║ 2 ║ 3 ║ 4 ║
|
||||
╠═══╬═══╩═══╩═══╣
|
||||
║ 5 ║("abcdef") ║
|
||||
╠═══╣(|zz zzz|) ║
|
||||
║ 6 ║(31415926) ║
|
||||
╠═══╬═══╦═══╦═══╣
|
||||
║ 7 ║ 8 ║ 9 ║ 0 ║
|
||||
╠═══╬═══╬═══╬═══╣
|
||||
║ A ║ B ║ C ║ D ║
|
||||
╠═══╬═══╩═══╩═══╣
|
||||
║ E ║("ghijkl") ║
|
||||
╠═══╣(|xx xxx|) ║
|
||||
║ F ║(27182818) ║
|
||||
╠═══╬═══╦═══╦═══╣
|
||||
║ G ║ H ║ I ║ J ║
|
||||
╠═══╬═══╬═══╬═══╣
|
||||
║ K ║ L ║ M ║ N ║
|
||||
╠═══╬═══╩═══╩═══╣
|
||||
║ O ║("mnopqs") ║
|
||||
╠═══╣(|yy yyy|) ║
|
||||
║ P ║(whatever) ║
|
||||
╠═══╬═══╦═══╦═══╣
|
||||
║ Q ║ R ║ S ║ T ║
|
||||
╚═══╩═══╩═══╩═══╝
|
||||
|
||||
---
|
||||
)
|
||||
|
||||
369
2d-test/tests/lexer-test.rkt
Normal file
369
2d-test/tests/lexer-test.rkt
Normal file
|
|
@ -0,0 +1,369 @@
|
|||
#lang at-exp racket/base
|
||||
(require rackunit
|
||||
syntax-color/racket-lexer
|
||||
syntax-color/scribble-lexer
|
||||
syntax-color/lexer-contract
|
||||
unstable/options
|
||||
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)))
|
||||
|
||||
73
2d-test/tests/match-test.rkt
Normal file
73
2d-test/tests/match-test.rkt
Normal file
|
|
@ -0,0 +1,73 @@
|
|||
#lang 2d racket
|
||||
(require 2d/match
|
||||
rackunit)
|
||||
|
||||
(check-equal?
|
||||
#2dmatch
|
||||
╔═══════╦══════╦══════════╗
|
||||
║ 1 ║ 'x ║ x ║
|
||||
║ 2 ║ ║ ║
|
||||
╠═══════╬══════╬══════════╣
|
||||
║ y ║ #f ║(list x y)║
|
||||
╚═══════╩══════╩══════════╝
|
||||
(list 1 2))
|
||||
|
||||
(define (≤ t1 t2)
|
||||
#2dmatch
|
||||
╔══════════╦══════╦═══════╦══════════╦═════════════════╗
|
||||
║ t2 ║ 'Int ║ 'Real ║ 'Complex ║ `(-> ,t2d ║
|
||||
║ t1 ║ ║ ║ ║ ,t2r) ║
|
||||
╠══════════╬══════╩═══════╩══════════╬═════════════════╣
|
||||
║ 'Int ║ ║ ║
|
||||
╠══════════╬══════╗ #t ║ ║
|
||||
║ 'Real ║ ║ ║ #f ║
|
||||
╠══════════╣ ╚═══════╗ ║ ║
|
||||
║'Complex ║ ║ ║ ║
|
||||
╠══════════╣ ╚══════════╬═════════════════╣
|
||||
║`(-> ,t1d ║ #f ║(and (≤ t2d t1d) ║
|
||||
║ ,t1r)║ ║ (≤ t1r t2r))║
|
||||
╚══════════╩═════════════════════════╩═════════════════╝)
|
||||
|
||||
(check-equal? (≤ 'Int 'Int) #t)
|
||||
(check-equal? (≤ 'Int 'Real) #t)
|
||||
(check-equal? (≤ 'Real 'Int) #f)
|
||||
(check-equal? (≤ 'Complex 'Complex) #t)
|
||||
(check-equal? (≤ 'Complex 'Int) #f)
|
||||
(check-equal? (≤ '(-> Real Int) '(-> Int Real)) #t)
|
||||
(check-equal? (≤ '(-> Int Complex) '(-> Int Real)) #f)
|
||||
|
||||
(check-equal?
|
||||
#2dmatch
|
||||
╔════════╦═══╗
|
||||
║ 3 ║ x ║
|
||||
║ 1 ║ ║
|
||||
╠════════╬═══╣
|
||||
║ 2 ║ ║
|
||||
╠════════╣ x ║
|
||||
║ 1 ║ ║
|
||||
╚════════╩═══╝
|
||||
3)
|
||||
|
||||
(check-equal?
|
||||
#2dmatch
|
||||
╔════════╦═══╗
|
||||
║ 3 ║ x ║
|
||||
║ 1 ║ ║
|
||||
╠════════╬═══╣
|
||||
║ z ║ ║
|
||||
╠════════╣ x ║
|
||||
║ q ║ ║
|
||||
╚════════╩═══╝
|
||||
3)
|
||||
|
||||
(check-equal?
|
||||
#2dmatch
|
||||
╔════════╦═══════╗
|
||||
║ 3 ║ x ║
|
||||
║ 1 ║ ║
|
||||
╠════════╬═══════╣
|
||||
║ y ║ ║
|
||||
╠════════╣(+ x y)║
|
||||
║ y ║ ║
|
||||
╚════════╩═══════╝
|
||||
4)
|
||||
718
2d-test/tests/readtable-test.rkt
Normal file
718
2d-test/tests/readtable-test.rkt
Normal file
|
|
@ -0,0 +1,718 @@
|
|||
#lang racket/base
|
||||
|
||||
(require rackunit
|
||||
2d/private/read-util
|
||||
2d/private/readtable
|
||||
racket/set)
|
||||
|
||||
(define touched-lines-table (make-hash))
|
||||
|
||||
(check-equal? (chars->desc '(#\a) "or")
|
||||
"a")
|
||||
(check-equal? (chars->desc '(#\a #\b) "or")
|
||||
"a or b")
|
||||
(check-equal? (chars->desc '(#\a #\b #\c) "or")
|
||||
"a, b, or c")
|
||||
(check-equal? (chars->desc '(#\a #\b #\c #\d) "or")
|
||||
"a, b, c, or d")
|
||||
(check-equal? (chars->desc '(#\a #\b #\c #\d #\e) "or")
|
||||
"a, b, c, d, or e")
|
||||
|
||||
(check-equal? (read (open-input-string "#2(x)"))
|
||||
(parameterize ([current-readtable (make-2d-readtable)])
|
||||
(read (open-input-string "#2(x)"))))
|
||||
(check-equal? (with-handlers ((exn:fail? exn-message))
|
||||
(read (open-input-string "#2x(x)")))
|
||||
(with-handlers ((exn:fail? exn-message))
|
||||
(parameterize ([current-readtable (make-2d-readtable)])
|
||||
(read (open-input-string "#2x(x)")))))
|
||||
(check-true (syntax? (read-syntax 'hi (open-input-string "#2(x)"))))
|
||||
(check-equal? (read (open-input-string "#2(x)"))
|
||||
(parameterize ([current-readtable (make-2d-readtable)])
|
||||
(syntax->datum (read-syntax 'hi (open-input-string "#2(x)")))))
|
||||
|
||||
(parameterize ([current-readtable (make-2d-readtable)])
|
||||
(define sp (open-input-string
|
||||
(string-append "#2d\n"
|
||||
"╔══╦══╗\n"
|
||||
"║1 ║2 ║\n"
|
||||
"╠══╬══╣\n"
|
||||
"║4 ║3 ║\n"
|
||||
"╚══╩══╝\n")))
|
||||
(define wp
|
||||
(make-input-port 'name sp sp void #f #f
|
||||
(λ () (values #f #f #f))
|
||||
void))
|
||||
(port-count-lines! wp)
|
||||
;; make sure that if there is no source location information,
|
||||
;; we still get some result back.
|
||||
(check-true (pair? (read wp))))
|
||||
|
||||
(parameterize ([current-readtable (make-2d-readtable)])
|
||||
(define sp (open-input-string
|
||||
(string-append "#2d\n"
|
||||
"╔══╦══╗\n"
|
||||
"║1 ║2 ║\n"
|
||||
"╠══╬══╣\n"
|
||||
"║4 ║3 ║\n"
|
||||
"╚══╩══╝\n")))
|
||||
(port-count-lines! sp)
|
||||
;; make sure that if there is no source location information,
|
||||
;; we still get some result back.
|
||||
(define stx (read-syntax "the source" sp))
|
||||
(define initial-keyword (car (syntax-e stx)))
|
||||
(check-not-false (syntax-source initial-keyword))
|
||||
(check-not-false (syntax-line initial-keyword))
|
||||
(check-not-false (syntax-column initial-keyword))
|
||||
(check-not-false (syntax-position initial-keyword))
|
||||
(check-not-false (syntax-span initial-keyword))
|
||||
(check-not-false (syntax-original? initial-keyword))
|
||||
(check-not-equal? (syntax-position stx)
|
||||
(syntax-position initial-keyword)))
|
||||
|
||||
(define (get-err-locs inputs)
|
||||
(with-handlers ([exn:fail:read? exn:fail:read-srclocs])
|
||||
(define p (open-input-string (apply string-append inputs)))
|
||||
(port-count-lines! p)
|
||||
(parameterize ([current-readtable (make-2d-readtable)])
|
||||
(read-syntax #f p))
|
||||
#f))
|
||||
|
||||
(define (get-something inputs i)
|
||||
(define p (open-input-string (apply string-append inputs)))
|
||||
(port-count-lines! p)
|
||||
;; account for the "#2d" that was read from the first line
|
||||
(call-with-values (λ () (parse-2dcond p "source" 1 0 1 2))
|
||||
(λ x (list-ref x i))))
|
||||
|
||||
(define (get-graph inputs) (get-something inputs 0))
|
||||
(define (get-all-lines inputs) (get-something inputs 1))
|
||||
(define (get-table-column-breaks inputs) (get-something inputs 2))
|
||||
(define (get-initial-space-count inputs) (get-something inputs 3))
|
||||
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
"╔══╦══╗\n"
|
||||
"║1 ║2 ║\n"
|
||||
"╠══╬══╣\n"
|
||||
"║4 ║3 ║\n"
|
||||
"╚══╩══╝\n"))
|
||||
#f)
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
"╔══╦══╗\n"
|
||||
"║λ ║2 ║\n"
|
||||
"╠══╬══╣\n"
|
||||
"║1 ║黃 ║\n"
|
||||
"╚══╩══╝\n"))
|
||||
#f)
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╗\n"
|
||||
" ║1 ║4 ║\n"
|
||||
" ╠══╬══╣\n"
|
||||
" ║2 ║3 ║\n"
|
||||
" ╚══╩══╝\n"))
|
||||
#f)
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╦══╗\n"
|
||||
" ║1 ║2 ║3 ║\n"
|
||||
" ╠══╬══╬══╣\n"
|
||||
" ║6 ║5 ║4 ║\n"
|
||||
" ╠══╬══╬══╣\n"
|
||||
" ║7 ║8 ║9 ║\n"
|
||||
" ╚══╩══╩══╝\n"))
|
||||
#f)
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╦══╗\n"
|
||||
" ║ 1║ 2║ 3║\n"
|
||||
" ╠══╬══╩══╣\n"
|
||||
" ║ 4║ ║\n"
|
||||
" ╠══╣ 6 ║\n"
|
||||
" ║ 5║ ║\n"
|
||||
" ╚══╩═════╝\n"))
|
||||
#f)
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╦══╗\n"
|
||||
" ║ 1║ 2║ 3║\n"
|
||||
" ╠══╬══╩══╣\n"
|
||||
" ║ 4║5 ║\n"
|
||||
" ╠══╬═════╣\n"
|
||||
" ║ 6║7 ║\n"
|
||||
" ╚══╩═════╝\n"))
|
||||
#f)
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╦══╦══╗\n"
|
||||
" ║ 1║ 2║ 3║ 4║\n"
|
||||
" ╠══╬══╬══╩══╣\n"
|
||||
" ║ 4║ 5║ 6 ║\n"
|
||||
" ╚══╩══╩═════╝\n"))
|
||||
#f)
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╦══╗\n"
|
||||
" ║1 ║2 ║3 ║\n"
|
||||
" ╠══╬══╬══╣\n"
|
||||
" ║4 ║ ║ ║\n"
|
||||
" ╠══╣ ║ ║\n"
|
||||
" ║5 ║6 ║7 ║\n"
|
||||
" ╚══╩══╩══╝\n"))
|
||||
#f)
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╗\n"
|
||||
" ║1 ║4 ║ ;; comment\n"
|
||||
" ╠══╬══╣ ;; comment \n"
|
||||
" ║2 ║3 ║\n"
|
||||
" ╚══╩══╝\n"))
|
||||
#f)
|
||||
|
||||
(define lines-table (hash-copy all-line-of-interest))
|
||||
|
||||
(parameterize ([current-lines lines-table])
|
||||
(check-regexp-match #rx"expected a newline"
|
||||
(with-handlers ((exn:fail? exn-message))
|
||||
(parameterize ([current-readtable (make-2d-readtable)])
|
||||
(read (open-input-string "#2d")))))
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╗\n"
|
||||
" ║ ║\n"
|
||||
" ╠══╬══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╚══╩══╝\n"))
|
||||
(list (srcloc #f 3 2 17 1)
|
||||
(srcloc #f 2 2 7 1)))
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╗\n"
|
||||
" ║ ═║ ║\n"
|
||||
" ╠══╬══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╚══╩══╝\n"))
|
||||
(list (srcloc #f 3 4 19 1)))
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╗\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╠══╬══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╚══╩══╝\n"))
|
||||
(list (srcloc #f 3 1 16 1)))
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╗\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╠══╬══\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╚══╩══╝\n"))
|
||||
(list (srcloc #f 4 8 33 1)))
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╗\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╠═\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╚══╩══╝\n"))
|
||||
(list (srcloc #f 4 4 29 1)))
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" +----+\n"
|
||||
" | |\n"
|
||||
" +----+\n"))
|
||||
(list (srcloc #f 2 2 7 1)))
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" \n"))
|
||||
(list (srcloc #f 2 0 5 3)))
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══\n"))
|
||||
(list (srcloc #f 2 8 13 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╬══╩═══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╠══╣ ═ ║\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╚══╩══════╝\n"))
|
||||
(list (srcloc #f 6 8 69 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╬══╩═══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╠══╬══╝═══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╚══╩══════╝\n"))
|
||||
(list (srcloc #f 6 8 69 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦═══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╬═══╬═══╣\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╣ ═ ╠═══╣\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╚══╩═══╩═══╝\n"))
|
||||
(list (srcloc #f 6 7 72 1)
|
||||
(srcloc #f 6 5 70 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦═══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╬═══╬═══╣\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╬═ ═╬═══╣\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╚══╩═══╩═══╝\n"))
|
||||
(list (srcloc #f 6 7 72 1)
|
||||
(srcloc #f 6 5 70 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦═══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╬═══╬═══╣\n"
|
||||
" ║ ║ ║ \n"
|
||||
" ╠══╬═══╬═══╣\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╚══╩═══╩═══╝\n"))
|
||||
(list (srcloc #f 5 13 63 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦═══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╩═══╬═══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ║ ║\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╠══╦═══╬═══╣\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╚══╩═══╩═══╝\n"))
|
||||
(list (srcloc #f 6 9 74 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦═══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╩═══╬═══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ║ ╩ ║ ║\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╠══╦═══╬═══╣\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╚══╩═══╩═══╝\n"))
|
||||
(list (srcloc #f 6 5 70 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦═══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╩═══╬═══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ║ \n"
|
||||
" ║ ║ ║\n"
|
||||
" ╠══╦═══╬═══╣\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╚══╩═══╩═══╝\n"))
|
||||
(list (srcloc #f 6 6 71 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦═══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╩═══╬═══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╚══════╩═\n"))
|
||||
(list (srcloc #f 6 11 76 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦═══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╩═══╬═══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╚══════\n"))
|
||||
(list (srcloc #f 6 9 74 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦═══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╩═══╬═══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╚══════╩═══X\n"))
|
||||
(list (srcloc #f 6 13 78 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦═══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╩═══╬═══╣\n"
|
||||
" ║ ║ ║\n"
|
||||
" ╚══════╩══X╝\n"))
|
||||
(list (srcloc #f 6 12 77 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
" ╔══╦═══╦═══╗\n"
|
||||
" ║ ║ ║ ║\n"
|
||||
" ╠══╩═══╬═══╣\n"
|
||||
" ║ ║ ║ NOT WHITESPACE\n"
|
||||
" ╚══════╩═══╝\n"))
|
||||
(list (srcloc #f 5 19 69 1)))
|
||||
|
||||
(check-equal? (get-err-locs
|
||||
'("#2d\n"
|
||||
"╔══╦-══╗\n"
|
||||
"║ ║ ║\n"
|
||||
"╠══╬-══╣\n"
|
||||
"║ ║ ║\n"
|
||||
"╚══╩-══╝\n"))
|
||||
(list (srcloc #f 2 4 9 1))))
|
||||
|
||||
(let ([lines (hash-map lines-table (λ (x y) x))])
|
||||
(unless (null? lines)
|
||||
(eprintf "no test case for errors on lines: ~s\n"
|
||||
(sort lines <))))
|
||||
|
||||
|
||||
(check-equal? (get-graph
|
||||
'(" ╔══╦══╦══╗\n"
|
||||
" ║ 1║ 2║ 3║\n"
|
||||
" ╠══╬══╩══╣\n"
|
||||
" ║ 4║ ║\n"
|
||||
" ╠══╣ 6 ║\n"
|
||||
" ║ 5║ ║\n"
|
||||
" ╚══╩═════╝\n"))
|
||||
(make-hash
|
||||
(list (cons (list 0 0) (set))
|
||||
(cons (list 0 1) (set))
|
||||
(cons (list 0 2) (set))
|
||||
(cons (list 1 0) (set))
|
||||
(cons (list 2 0) (set))
|
||||
|
||||
(cons (list 1 1) (set (list 1 2) (list 2 1)))
|
||||
(cons (list 2 1) (set (list 1 1) (list 2 2)))
|
||||
(cons (list 1 2) (set (list 1 1) (list 2 2)))
|
||||
(cons (list 2 2) (set (list 1 2) (list 2 1))))))
|
||||
|
||||
(check-equal? (get-graph
|
||||
'(" ╔══╦══╦══╗\n"
|
||||
" ║1 ║2 ║3 ║\n"
|
||||
" ╠══╬══╬══╣\n"
|
||||
" ║6 ║5 ║4 ║\n"
|
||||
" ╠══╬══╬══╣\n"
|
||||
" ║7 ║8 ║9 ║\n"
|
||||
" ╚══╩══╩══╝\n"))
|
||||
(make-hash
|
||||
(list (cons (list 0 0) (set))
|
||||
(cons (list 0 1) (set))
|
||||
(cons (list 0 2) (set))
|
||||
(cons (list 1 0) (set))
|
||||
(cons (list 1 1) (set))
|
||||
(cons (list 1 2) (set))
|
||||
(cons (list 2 0) (set))
|
||||
(cons (list 2 1) (set))
|
||||
(cons (list 2 2) (set)))))
|
||||
|
||||
(check-equal? (get-graph
|
||||
'(" ╔══╦══╦══╦══╗\n"
|
||||
" ║1 ║2 ║3 ║4 ║\n"
|
||||
" ╠══╬══╩══╩══╣\n"
|
||||
" ║6 ║5 ║\n"
|
||||
" ╠══╣ ╔══╗ ║\n"
|
||||
" ║7 ║ ║10║ ║\n"
|
||||
" ╠══╣ ╚══╝ ║\n"
|
||||
" ║7 ║ ║\n"
|
||||
" ╚══╩════════╝\n"))
|
||||
(make-hash
|
||||
(list (cons (list 0 0) (set))
|
||||
(cons (list 0 1) (set))
|
||||
(cons (list 0 2) (set))
|
||||
(cons (list 0 3) (set))
|
||||
|
||||
(cons (list 1 0) (set))
|
||||
(cons (list 1 1) (set (list 1 2) (list 2 1)))
|
||||
(cons (list 1 2) (set (list 1 1) (list 1 3)))
|
||||
(cons (list 1 3) (set (list 1 2) (list 2 3)))
|
||||
|
||||
(cons (list 2 0) (set))
|
||||
(cons (list 2 1) (set (list 1 1) (list 3 1)))
|
||||
(cons (list 2 2) (set))
|
||||
(cons (list 2 3) (set (list 1 3) (list 3 3)))
|
||||
|
||||
(cons (list 3 0) (set))
|
||||
(cons (list 3 1) (set (list 2 1) (list 3 2)))
|
||||
(cons (list 3 2) (set (list 3 1) (list 3 3)))
|
||||
(cons (list 3 3) (set (list 3 2) (list 2 3))))))
|
||||
|
||||
(check-equal? (get-all-lines '(" ╔══╦══╗\n"
|
||||
" ║1 ║ ║\r"
|
||||
" ╠══╬══╣\r\n"
|
||||
" ║2 ║ ║\r"
|
||||
" ╠══╬══╣\n"
|
||||
" ║3 ║ ║\n"
|
||||
" ╚══╩══╝\n"))
|
||||
'#((" ╔══╦══╗\n" " ║1 ║ ║\r")
|
||||
(" ╠══╬══╣\r\n" " ║2 ║ ║\r")
|
||||
(" ╠══╬══╣\n" " ║3 ║ ║\n")))
|
||||
|
||||
(check-equal? (get-table-column-breaks '(" ╔══╦══╗\n"
|
||||
" ║1 ║ ║\n"
|
||||
" ╠══╬══╣\n"
|
||||
" ║2 ║ ║\n"
|
||||
" ╠══╬══╣\n"
|
||||
" ║3 ║ ║\n"
|
||||
" ╚══╩══╝\n"))
|
||||
(list 2 2))
|
||||
(check-equal? (get-initial-space-count '(" ╔══╦══╗\n"
|
||||
" ║1 ║ ║\n"
|
||||
" ╠══╬══╣\n"
|
||||
" ║2 ║ ║\n"
|
||||
" ╠══╬══╣\n"
|
||||
" ║3 ║ ║\n"
|
||||
" ╚══╩══╝\n"))
|
||||
2)
|
||||
|
||||
(check-equal? (close-cell-graph (make-hash) 2 2)
|
||||
(set (set (list 0 0))
|
||||
(set (list 0 1))
|
||||
(set (list 1 0))
|
||||
(set (list 1 1))))
|
||||
|
||||
(check-equal? (close-cell-graph (make-hash
|
||||
(list
|
||||
(cons (list 0 0) (set (list 0 1)))))
|
||||
2 2)
|
||||
(set (set (list 0 0) (list 0 1))
|
||||
(set (list 1 0))
|
||||
(set (list 1 1))))
|
||||
|
||||
|
||||
(check-equal? (close-cell-graph (make-hash
|
||||
(list
|
||||
(cons (list 0 0) (set (list 0 1)))
|
||||
(cons (list 0 1) (set (list 1 1)))))
|
||||
2 2)
|
||||
(set (set (list 0 0) (list 0 1) (list 1 1))
|
||||
(set (list 1 0))))
|
||||
(check-equal? (close-cell-graph (make-hash
|
||||
(list
|
||||
(cons (list 0 0) (set (list 0 1)))
|
||||
(cons (list 0 1) (set (list 1 1)))
|
||||
(cons (list 1 1) (set (list 1 0)))))
|
||||
2 2)
|
||||
(set (set (list 0 0) (list 0 1) (list 1 1) (list 1 0))))
|
||||
|
||||
(check-true (compare/xy (list 0 0) (list 1 1)))
|
||||
(check-false (compare/xy (list 1 1) (list 0 0)))
|
||||
(check-true (compare/xy (list 1 0) (list 1 1)))
|
||||
(check-false (compare/xy (list 1 1) (list 1 0)))
|
||||
(check-false (compare/xy (list 1 0) (list 1 0)))
|
||||
|
||||
(check-equal? (smallest-representative (set (list 0 0) (list 1 0) (list 0 1) (list 1 1)))
|
||||
(list 0 0))
|
||||
(check-equal? (smallest-representative (set (list 1 1) (list 0 1) (list 1 0) (list 0 0)))
|
||||
(list 0 0))
|
||||
|
||||
(let ()
|
||||
(define scratch (string-copy " "))
|
||||
(fill-scratch-string (set '(0 0))
|
||||
#(("╔══╦══╗\n" "║12║34║\n") ("╠══╬══╣\n" "║56║78║\n"))
|
||||
scratch
|
||||
'(2 2)
|
||||
0)
|
||||
(check-equal? scratch
|
||||
" \n 12 \n \n \n"))
|
||||
|
||||
(let ()
|
||||
(define scratch (string-copy " "))
|
||||
(fill-scratch-string (set '(1 0))
|
||||
#(("╔══╦══╗\n" "║12║34║\n") ("╠══╬══╣\n" "║56║78║\n"))
|
||||
scratch
|
||||
'(2 2)
|
||||
0)
|
||||
(check-equal? scratch
|
||||
" \n 34 \n \n \n"))
|
||||
|
||||
(let ()
|
||||
(define scratch (string-copy " "))
|
||||
(fill-scratch-string (set '(0 1))
|
||||
#(("╔══╦══╗\n" "║12║34║\n") ("╠══╬══╣\n" "║56║78║\n"))
|
||||
scratch
|
||||
'(2 2)
|
||||
0)
|
||||
(check-equal? scratch
|
||||
" \n \n \n 56 \n"))
|
||||
|
||||
(let ()
|
||||
(define scratch (string-copy " "))
|
||||
(fill-scratch-string (set '(1 1))
|
||||
#(("╔══╦══╗\n" "║12║34║\n") ("╠══╬══╣\n" "║56║78║\n"))
|
||||
scratch
|
||||
'(2 2)
|
||||
0)
|
||||
(check-equal? scratch
|
||||
" \n \n \n 78 \n"))
|
||||
|
||||
(let ()
|
||||
(define scratch (string-copy " \n 34 \n \n \n"))
|
||||
(fill-scratch-string (set '(1 0) '(1 1))
|
||||
#(("╔══╦══╗\n" "║12║34║\n") ("╠══╣56║\n" "║78║90║\n"))
|
||||
scratch
|
||||
'(2 2)
|
||||
0)
|
||||
(check-equal? scratch
|
||||
" \n 34 \n 56 \n 90 \n"))
|
||||
|
||||
(let ()
|
||||
(define scratch (string-copy " \n 34 \n \n \n"))
|
||||
(fill-scratch-string (set '(0 1) '(1 1))
|
||||
#(("╔══╦══╗\n" "║12║34║\n") ("╠══╩══╣\n" "║56789║\n"))
|
||||
scratch
|
||||
'(2 2)
|
||||
0)
|
||||
(check-equal? scratch
|
||||
" \n \n \n 56789 \n"))
|
||||
|
||||
(let ()
|
||||
(define scratch (string-copy " \n 34 \n \n \n"))
|
||||
(fill-scratch-string (set '(0 1) '(1 0) '(1 1))
|
||||
#(("╔══╦══╗\n" "║12║34║\n") ("╠══╝56║\n" "║7890A║\n"))
|
||||
scratch
|
||||
'(2 2)
|
||||
0)
|
||||
(check-equal? scratch
|
||||
" \n 34 \n 56 \n 7890A \n"))
|
||||
|
||||
(let ()
|
||||
(define scratch (string-copy " "))
|
||||
(fill-scratch-string (set '(0 0))
|
||||
#(("╔═════╗\n" "║12345║\n" "║67890║\n" "║ABCDE║\n"))
|
||||
scratch
|
||||
'(5)
|
||||
0)
|
||||
|
||||
(check-equal? scratch
|
||||
" \n 12345 \n 67890 \n ABCDE \n"))
|
||||
|
||||
(let ()
|
||||
(define scratch (make-string 66 #\space))
|
||||
(fill-scratch-string (set '(1 2) '(1 1) '(2 2) '(2 1))
|
||||
#(("╔══╦══╦══╗\n" "║12║34║56║\n")
|
||||
("╠══╬══╩══╣\n" "║78║90ABC║\n")
|
||||
("╠══╣DEFGH║\n" "║IJ║KLMNO║\n"))
|
||||
scratch
|
||||
'(2 2 2)
|
||||
0)
|
||||
|
||||
(check-equal? scratch
|
||||
" \n \n \n 90ABC \n DEFGH \n KLMNO \n"))
|
||||
|
||||
(let ()
|
||||
(define scratch (make-string 120 #\space))
|
||||
(fill-scratch-string
|
||||
(set '(1 2) '(1 3) '(2 3))
|
||||
#(("╔═╦════╦═════╗\n" "║1║2345║67890║\n")
|
||||
("╠═╬════╩═════╣\n" "║a║bcdefghijk║\n")
|
||||
("╠═╬════╗lmnop║\n" "║q║rstu║vwxyz║\n")
|
||||
("╠═╣ABCD╚═════╣\n" "║E║FGHIJKLMNO║\n"))
|
||||
scratch
|
||||
'(1 4 5)
|
||||
0)
|
||||
(check-equal? (string-append
|
||||
" \n"
|
||||
" \n"
|
||||
" \n"
|
||||
" \n"
|
||||
" \n"
|
||||
" rstu \n"
|
||||
" ABCD \n"
|
||||
" FGHIJKLMNO \n")
|
||||
scratch))
|
||||
|
||||
(let ()
|
||||
(define scratch (make-string 495 #\space))
|
||||
(fill-scratch-string
|
||||
(set '(1 2) '(1 3) '(1 4) '(2 3) '(2 4) '(3 4))
|
||||
#(("╔════════╦════╦═════╦════════╦═════════════╗\n"
|
||||
"║ ║'Int║'Real║'Complex║ `(-> ,c ,d) ║\n")
|
||||
("╠════════╬════╩═════╩════════╬═════════════╣\n"
|
||||
"║'Int ║ ║ ║\n")
|
||||
("╠════════╬════╗ #t ║ ║\n"
|
||||
"║'Real ║ ║ ║ #f ║\n")
|
||||
("╠════════╣ ╚═════╗ ║ ║\n"
|
||||
"║'Complex║ ║ ║ ║\n")
|
||||
("╠════════╣ ╚════════╬═════════════╣\n"
|
||||
"║`(-> ,a ║ #f ║(and (≤ c a) ║\n"
|
||||
"║ ,b)║ ║ (≤ b d))║\n"))
|
||||
scratch
|
||||
'(8 4 5 8 13)
|
||||
0)
|
||||
;; just make sure there are no border characters in there.
|
||||
(check-regexp-match #rx"^[\n#f ]*$" scratch))
|
||||
|
||||
(let ()
|
||||
(define str (make-string 84 #\space))
|
||||
(fill-scratch-string (set '(1 2) '(1 1) '(2 1))
|
||||
'#(("╔═══╦═══╦═══╗\n"
|
||||
"║ ║ a ║ b ║\n")
|
||||
("╠═══╬═══╩═══╣\n"
|
||||
"║ c ║ 1 ║\n")
|
||||
("╠═══╣ ╔═══╣\n"
|
||||
"║ d ║ ║ 2 ║\n"))
|
||||
str
|
||||
'(3 3 3)
|
||||
0)
|
||||
(check-equal? str
|
||||
" \n \n \n 1 \n \n \n"))
|
||||
|
||||
(let ()
|
||||
(define scratch (string-copy " "))
|
||||
(check-equal? (fill-scratch-string (set '(0 0))
|
||||
#(("╔══╦══╗\n" "║12║34║\n") ("╠══╬══╣\n" "║56║78║\n"))
|
||||
scratch
|
||||
'(2 2)
|
||||
0
|
||||
#t)
|
||||
'((10 . 12))))
|
||||
|
||||
(let ()
|
||||
(define sp (open-input-string
|
||||
(string-append "#(#2d\n"
|
||||
" ╔══╦══╗\n"
|
||||
" ║1 ║2 ║\n"
|
||||
" ╠══╬══╣\n"
|
||||
" ║4 ║3 ║\n"
|
||||
" ╚══╩══╝)1\n")))
|
||||
(parameterize ([current-readtable (make-2d-readtable)])
|
||||
(check-true (vector? (read sp)))
|
||||
(check-equal? (read sp) 1)))
|
||||
|
||||
|
||||
(let ()
|
||||
(define sp (open-input-string "#2dwhatever\n"))
|
||||
(port-count-lines! sp)
|
||||
(define exn
|
||||
(with-handlers ((exn:fail:read:eof? values))
|
||||
(parameterize ([current-readtable (make-2d-readtable)])
|
||||
(read sp))))
|
||||
(check-regexp-match #rx"expected eof" (exn-message exn))
|
||||
(check-equal? (exn:fail:read-srclocs exn)
|
||||
(list (srcloc #f 1 0 1 12))))
|
||||
Loading…
Reference in New Issue
Block a user