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

more test cases ...

Browse Source
This commit is contained in:
Robby Findler 2013-01-16 21:32:14 -06:00
parent 7df363c523
commit ded6cb1da1
1 changed files with 56 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
collects/unstable/2d/reader.rkt
View File

@ -120,37 +120,13 @@
(set! initial-space-count pos)] (set! initial-space-count pos)]
[else [else
(line-of-interest) (line-of-interest)
(readerr "expected the first character in the table to be ╔" (readerr "expected the first non-whitespace character in the table to be ╔"
pos)])] pos)])]
[else [else
(line-of-interest) (line-of-interest)
(readerr "expected some non-whitespace characters in the first line of the table" (readerr "expected some non-whitespace characters in the first line of the table"
0 0
pos)])) pos)]))
(let loop ([pos (+ initial-space-count 1)]
[current-column-width 0]
[column 0])
(cond
[(< pos (string-length current-line))
(case (string-ref current-line pos)
[(#\╦)
(add-node column 0)
(cons current-column-width (loop (+ pos 1) 0 (+ column 1)))]
[(#\═) (loop (+ pos 1) (+ current-column-width 1) column)]
[(#\╗)
(add-node column 0)
(let loop ([pos (+ pos 1)])
(when (< pos (string-length current-line))
(cond
[(char-whitespace? (string-ref current-line pos))
(loop (+ pos 1))]
[else
(line-of-interest)
(readerr "expected only whitespace to follow ╗ (on the same line)" pos)]))
(list current-column-width))])]
[else
(line-of-interest)
(readerr "expected ╗ to terminate the first line" pos)]))
(let loop ([pos (+ initial-space-count 1)] (let loop ([pos (+ initial-space-count 1)]
[current-column-width 0] [current-column-width 0]
[column 0] [column 0]
@ -575,7 +551,10 @@
#f) #f)
(define lines-table (hash-copy all-line-of-interest)) (define lines-table (hash-copy all-line-of-interest))
(parameterize ([current-lines lines-table]) (parameterize ([current-lines lines-table])
(check-equal? (get-err-locs '("#2d "))
(list (srcloc #f 1 0 1 2)))
(check-equal? (get-err-locs (check-equal? (get-err-locs
'("#2d\n" '("#2d\n"
" ╔══╦══╗\n" " ╔══╦══╗\n"
@ -592,8 +571,50 @@
" ╠══╬══╣\n" " ╠══╬══╣\n"
" ║ ║ ║\n" " ║ ║ ║\n"
" ╚══╩══╝\n")) " ╚══╩══╝\n"))
(list (srcloc #f 3 4 19 1) (list (srcloc #f 3 4 19 1)))
(srcloc #f 2 4 9 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"))
(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)))
)
(let ([lines (hash-map lines-table (λ (x y) x))]) (let ([lines (hash-map lines-table (λ (x y) x))])
(unless (null? lines) (unless (null? lines)
(eprintf "no test case for errors on lines: ~s\n" (eprintf "no test case for errors on lines: ~s\n"
@ -701,15 +722,17 @@
(module+ main (module+ main
(define s (string-append (define s (string-append
"#2d\n" "#2d\n"
" ╔══╦══╗\n" " ╔══╦══╦═══╗\n"
" ║ ║\n" " ║ ║ ║ ║\n"
" ╠══╬══╣\n" " ╠══╬══╩═══╣\n"
" ║ ║ ║\n" " ║ ║ ║\n"
" ╚══╩══╝\n")) " ╠══╣ ═ ║\n"
" ║ ║ ║\n"
" ╚══╩══════╝\n"))
(define p (open-input-string s)) (define p (open-input-string s))
(port-count-lines! p) (port-count-lines! p)
(with-handlers ((exn:fail:read? exn:fail:read-srclocs)) (with-handlers (#;(exn:fail:read? exn:fail:read-srclocs))
(parameterize ([current-readtable rt]) (parameterize ([current-readtable rt])
(read p))) (read p)))
;; account for the "#2d" that was read from the first line ;; account for the "#2d" that was read from the first line