adjust 2d reader so the keyword has its own source location
and is syntax-original?
This commit is contained in:
parent
a1437e71f7
commit
d652d69d14
|
@ -48,6 +48,28 @@
|
|||
;; 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)))
|
||||
|
@ -693,4 +715,4 @@
|
|||
(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))))
|
||||
(list (srcloc #f 1 0 1 12))))
|
||||
|
|
|
@ -84,7 +84,13 @@ example uses:
|
|||
(for/list ([line (in-vector lines)])
|
||||
(length line)))
|
||||
|
||||
`(,(string->symbol (string-append "2d" (apply string kwd-chars)))
|
||||
(define kwd-str (string-append "2d" (apply string kwd-chars)))
|
||||
(define kwd-port (open-input-string kwd-str))
|
||||
(port-count-lines! kwd-port)
|
||||
(set-port-next-location! kwd-port _line (and _col (+ _col 1)) (and _pos (+ _pos 1)))
|
||||
(define kwd-stx (read-syntax source kwd-port))
|
||||
|
||||
`(,kwd-stx
|
||||
|
||||
,table-column-breaks
|
||||
,heights
|
||||
|
|
Loading…
Reference in New Issue
Block a user