diff --git a/collects/tests/unstable/2d/readtable-test.rkt b/collects/tests/unstable/2d/readtable-test.rkt index db7b9bd106..a2308e65c2 100644 --- a/collects/tests/unstable/2d/readtable-test.rkt +++ b/collects/tests/unstable/2d/readtable-test.rkt @@ -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)))) \ No newline at end of file + (list (srcloc #f 1 0 1 12)))) diff --git a/collects/unstable/2d/private/readtable.rkt b/collects/unstable/2d/private/readtable.rkt index b822a4629d..9fe4806deb 100644 --- a/collects/unstable/2d/private/readtable.rkt +++ b/collects/unstable/2d/private/readtable.rkt @@ -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