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

reader: fix locations on various kinds of errors

Browse Source
This commit is contained in:
Matthew Flatt 2018-03-08 08:56:29 -07:00
parent 32d119dfe6
commit 83d792fca5
11 changed files with 3387 additions and 3066 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
pkgs/racket-test-core/tests/racket/read.rktl
View File

@ -271,6 +271,14 @@
(test #t string? (string->number (string-append "#d" s) 10 'read)))]))
(loop (cdr l))))
(define (make-exn:fail:read:eof?/span start span)
(lambda (exn)
(and (exn:fail:read:eof? exn)
(pair? (exn:fail:read-srclocs exn))
(let ([srcloc (car (exn:fail:read-srclocs exn))])
(and (equal? start (srcloc-position srcloc))
(equal? span (srcloc-span srcloc)))))))
(test 5 readstr "#| hi |# 5")
(test 5 readstr "#| #| #| #| hi |# |# |# |# 5")
(test '(5) readstr "(#| #| #| #| hi |# |# |# |# 5)")
@ -291,27 +299,33 @@
(err/rt-test (readstr "#\\bcase") exn:fail:read?)
(err/rt-test (readstr "#\\lcase") exn:fail:read?)
(err/rt-test (readstr "(hi") exn:fail:read:eof?)
(err/rt-test (readstr "\"hi") exn:fail:read:eof?)
(err/rt-test (readstr "(hi") (make-exn:fail:read:eof?/span 1 1))
(err/rt-test (readstr "\"hi") (make-exn:fail:read:eof?/span 1 1))
(err/rt-test (readstr "\"hi\\") exn:fail:read:eof?)
(err/rt-test (readstr "#(hi") exn:fail:read:eof?)
(err/rt-test (readstr "#(hi") (make-exn:fail:read:eof?/span 1 2))
(err/rt-test (readstr "#[hi") exn:fail:read:eof?)
(err/rt-test (readstr "#{hi") exn:fail:read:eof?)
(err/rt-test (readstr "#4(hi") exn:fail:read:eof?)
(err/rt-test (readstr "#4[hi") exn:fail:read:eof?)
(err/rt-test (readstr "#4{hi") exn:fail:read:eof?)
(err/rt-test (readstr "|hi") exn:fail:read:eof?)
(err/rt-test (readstr "|hi") (make-exn:fail:read:eof?/span 1 3))
(err/rt-test (readstr "hi\\") exn:fail:read:eof?)
(err/rt-test (readstr "#\\") exn:fail:read:eof?)
(err/rt-test (readstr "#\\") (make-exn:fail:read:eof?/span 1 2))
(err/rt-test (readstr "#\\12") exn:fail:read:eof?)
(err/rt-test (readstr "#| hi") exn:fail:read:eof?)
(err/rt-test (readstr "(1 #| hi") exn:fail:read:eof?)
(err/rt-test (readstr "'") exn:fail:read:eof?)
(err/rt-test (readstr "`") exn:fail:read:eof?)
(err/rt-test (readstr ",@") exn:fail:read:eof?)
(err/rt-test (readstr ",") exn:fail:read:eof?)
(err/rt-test (readstr "#'") exn:fail:read:eof?)
(err/rt-test (readstr "#&") exn:fail:read:eof?)
(err/rt-test (readstr "'") (make-exn:fail:read:eof?/span 1 1))
(err/rt-test (readstr "' ") (make-exn:fail:read:eof?/span 1 1))
(err/rt-test (readstr "`") (make-exn:fail:read:eof?/span 1 1))
(err/rt-test (readstr "` ") (make-exn:fail:read:eof?/span 1 1))
(err/rt-test (readstr ",@") (make-exn:fail:read:eof?/span 1 2))
(err/rt-test (readstr ",@ ") (make-exn:fail:read:eof?/span 1 2))
(err/rt-test (readstr ",") (make-exn:fail:read:eof?/span 1 1))
(err/rt-test (readstr ", ") (make-exn:fail:read:eof?/span 1 1))
(err/rt-test (readstr "#'") (make-exn:fail:read:eof?/span 1 2))
(err/rt-test (readstr "#' ") (make-exn:fail:read:eof?/span 1 2))
(err/rt-test (readstr "#&") (make-exn:fail:read:eof?/span 1 2))
(err/rt-test (readstr "#& ") (make-exn:fail:read:eof?/span 1 2))
(err/rt-test (readstr ".") exn:fail:read?)
(err/rt-test (readstr "a .") exn:fail:read?)
@ -373,7 +387,7 @@
(err/rt-test (readstr "#hashe") exn:fail:read:eof?)
(err/rt-test (readstr "#hasheq") exn:fail:read:eof?)
(err/rt-test (readstr "#hasheqv") exn:fail:read:eof?)
(err/rt-test (readstr "#hash(") exn:fail:read:eof?)
(err/rt-test (readstr "#hash(") (make-exn:fail:read:eof?/span 1 6))
(err/rt-test (readstr "#hash((1") exn:fail:read:eof?)
(err/rt-test (readstr "#hash((1 .") exn:fail:read:eof?)
(err/rt-test (readstr "#hash((1 . 2)") exn:fail:read:eof?)
@ -465,9 +479,10 @@
(test #t byte-pregexp? (readstr "#px#\".\""))
(test '(#"abc") regexp-match #px#"a.." "123abcdef")
(err/rt-test (readstr "#r") exn:fail:read:eof?)
(err/rt-test (readstr "#r") (make-exn:fail:read:eof?/span 1 2))
(err/rt-test (readstr "#rx") exn:fail:read:eof?)
(err/rt-test (readstr "#rx\"") exn:fail:read:eof?)
(err/rt-test (readstr "#rx\"") (make-exn:fail:read:eof?/span 1 4))
(err/rt-test (readstr "#rx\"x") (make-exn:fail:read:eof?/span 1 4))
(err/rt-test (readstr "#ra") exn:fail:read?)
(err/rt-test (readstr "#rxa") exn:fail:read?)
(err/rt-test (readstr "#rx\"?\"") exn:fail:read?)

3
racket/src/expander/read/box.rkt
View File

@ -11,9 +11,10 @@
(reader-error in config
"`~a&` forms not enabled"
dispatch-c))
(define-values (open-end-line open-end-col open-end-pos) (port-next-location in))
(define e (read-one #f in (next-readtable config)))
(when (eof-object? e)
(reader-error in config #:due-to e
(reader-error in config #:due-to e #:end-pos open-end-pos
"expected an element for `~a&` box, found end-of-file"
dispatch-c))
(wrap (box e) in config #f))

8
racket/src/expander/read/config.rkt
View File

@ -95,8 +95,12 @@
(read-config-state #f #f)
(read-config-st config))]))
(define (port+config->srcloc in config)
(define-values (end-line end-col end-pos) (port-next-location in))
(define (port+config->srcloc in config
#:end-pos [given-end-pos #f])
(define end-pos
(or given-end-pos
(let-values ([(end-line end-col end-pos) (port-next-location in)])
end-pos)))
(srcloc (or (read-config-source config)
(object-name in)
"UNKNOWN")

4
racket/src/expander/read/error.rkt
View File

@ -11,9 +11,11 @@
#:who [who (if (read-config-for-syntax? config)
'read-syntax
'read)]
#:end-pos [end-pos #f]
str . args)
(define msg (format "~a: ~a" who (apply format str args)))
(define srcloc (and in (port+config->srcloc in config)))
(define srcloc (and in (port+config->srcloc in config
#:end-pos end-pos)))
(raise
((cond
[(eof-object? due-to) exn:fail:read:eof]

51
racket/src/expander/read/hash.rkt
View File

@ -35,14 +35,15 @@
(get-next! #\a #\A)
(get-next! #\s #\S)
(get-next! #\h #\H)
(define-values (content opener mode)
(let loop ([mode 'equal])
(define c (read-char/special in config))
(define ec (effective-char c config))
(case ec
[(#\()
(define read-one-key+value (make-read-one-key+value read-one c #\)))
(define-values (open-end-line open-end-col open-end-pos) (port-next-location in))
(define read-one-key+value (make-read-one-key+value read-one c #\) open-end-pos))
(values (read-unwrapped-sequence read-one-key+value c #\( #\) in config
#:elem-config config
#:dot-mode #f)
@ -50,26 +51,28 @@
mode)]
[(#\[)
(cond
[(check-parameter read-square-bracket-as-paren config)
(define read-one-key+value (make-read-one-key+value read-one c #\]))
(values (read-unwrapped-sequence read-one-key+value c #\[ #\] in config
#:elem-config config
#:dot-mode #f)
ec
mode)]
[else
(reader-error in config "illegal use of `~a`" c)])]
[(check-parameter read-square-bracket-as-paren config)
(define-values (open-end-line open-end-col open-end-pos) (port-next-location in))
(define read-one-key+value (make-read-one-key+value read-one c #\] open-end-pos))
(values (read-unwrapped-sequence read-one-key+value c #\[ #\] in config
#:elem-config config
#:dot-mode #f)
ec
mode)]
[else
(reader-error in config "illegal use of `~a`" c)])]
[(#\{)
(cond
[(check-parameter read-curly-brace-as-paren config)
(define read-one-key+value (make-read-one-key+value read-one c #\}))
(values (read-unwrapped-sequence read-one-key+value c #\{ #\} in config
#:elem-config config
#:dot-mode #f)
ec
mode)]
[else
(reader-error in config "illegal use of `~a`" c)])]
[(check-parameter read-curly-brace-as-paren config)
(define-values (open-end-line open-end-col open-end-pos) (port-next-location in))
(define read-one-key+value (make-read-one-key+value read-one c #\} open-end-pos))
(values (read-unwrapped-sequence read-one-key+value c #\{ #\} in config
#:elem-config config
#:dot-mode #f)
ec
mode)]
[else
(reader-error in config "illegal use of `~a`" c)])]
[(#\e #\E)
(accum-string-add! accum-str c)
(get-next! #\q #\Q)
@ -111,7 +114,7 @@
;; ----------------------------------------
(define ((make-read-one-key+value read-one overall-opener-c overall-closer-ec) init-c in config)
(define ((make-read-one-key+value read-one overall-opener-c overall-closer-ec prefix-end-pos) init-c in config)
(define c (read-char/skip-whitespace-and-comments init-c read-one in config))
(define-values (open-line open-col open-pos) (port-next-location* in c))
(define ec (effective-char c config))
@ -130,8 +133,8 @@
[(not closer)
(cond
[(eof-object? c)
(reader-error in (reading-at config open-line open-col open-pos)
#:due-to c
(reader-error in config
#:due-to c #:end-pos prefix-end-pos
"expected ~a to close `~a`"
(closer-name overall-closer-ec config) overall-opener-c)]
[(char-closer? ec config)
@ -146,7 +149,7 @@
(cond
[(special-comment? v)
;; Try again
((make-read-one-key+value read-one overall-opener-c overall-closer-ec) #f in config)]
((make-read-one-key+value read-one overall-opener-c overall-closer-ec prefix-end-pos) #f in config)]
[else
(reader-error in (reading-at config open-line open-col open-pos)
"expected ~a to start a hash pair"

2
racket/src/expander/read/location.rkt
View File

@ -3,7 +3,7 @@
(provide port-next-location*)
(define (port-next-location* in init-c)
;; If weve already read `init-c`, then back up by one column and
;; If we've already read `init-c`, then back up by one column and
;; position; we assume that `init-c` is not a newline character
(cond
[(not init-c) (port-next-location in)]

4
racket/src/expander/read/main.rkt
View File

@ -365,8 +365,8 @@
[(#\e) (read-extension-reader read-one read-undotted dispatch-c in config)]
[else
(bad-syntax-error in config
#:due-to c2
(accum-string-get! accum-str config))])]
#:due-to c2
(accum-string-get! accum-str config))])]
[(#\p)
;; Maybe pregexp
(define accum-str (accum-string-init! config))

3
racket/src/expander/read/quote.rkt
View File

@ -6,9 +6,10 @@
(define (read-quote read-one sym desc c in config)
(define wrapped-sym (wrap sym in config c))
(define-values (end-line end-col end-pos) (port-next-location in))
(define e (read-one #f in config))
(when (eof-object? e)
(reader-error in config #:due-to e
(reader-error in config #:due-to e #:end-pos end-pos
"expected an element for ~a, found end-of-file"
desc))
(wrap (list wrapped-sym e) in config #f))

5
racket/src/expander/read/sequence.rkt
View File

@ -27,13 +27,14 @@
(define config (struct*-copy read-config elem-config
[indentations (cons indentation
(read-config-indentations seq-config))]))
(define-values (open-end-line open-end-col open-end-pos) (port-next-location in))
(define config/keep-comment (keep-comment config))
(define (read-one/not-eof init-c read-one config)
(define e (read-one init-c in config))
(when (eof-object? e)
(reader-error in config #:due-to e
(reader-error in seq-config #:due-to e #:end-pos open-end-pos
"expected a ~a to close `~a`~a"
(closer-name closer config)
opener-c

6
racket/src/expander/read/string.rkt
View File

@ -13,11 +13,12 @@
(define (read-string in config #:mode [mode 'string])
(define source (read-config-source config))
(define-values (open-end-line open-end-col open-end-pos) (port-next-location in))
(define accum-str (accum-string-init! config))
(define (bad-end c)
(cond
[(eof-object? c)
(reader-error in config #:due-to c "expected a closing `\"`")]
(reader-error in config #:due-to c #:end-pos open-end-pos "expected a closing `\"`")]
[else
(reader-error in config #:due-to c
"found non-character while reading a ~a"
@ -167,6 +168,7 @@
(define (read-here-string in config)
(define source (read-config-source config))
(define-values (open-end-line open-end-col open-end-pos) (port-next-location in))
(define accum-str (accum-string-init! config))
;; Parse terminator
@ -193,7 +195,7 @@
(cond
[(eof-object? c)
(unless (null? terminator)
(reader-error in config #:due-to c
(reader-error in config #:due-to c #:end-pos open-end-pos
"found end-of-file before terminating `~a`"
(list->string (cdr full-terminator))))]
[(not (char? c))

6324
racket/src/racket/src/startup.inc
View File

File diff suppressed because it is too large Load Diff