reader: fix locations on various kinds of errors

pkgs/racket-test-core/tests/racket/read.rktl

@@ -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") (make-exn:fail:read:eof?/span 1 1))
-(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\\") 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 "'") (make-exn:fail:read:eof?/span 1 1))
-(err/rt-test (readstr "`") exn:fail:read:eof?)
+(err/rt-test (readstr "' ") (make-exn:fail:read:eof?/span 1 1))
-(err/rt-test (readstr ",@") exn:fail:read:eof?)
+(err/rt-test (readstr "`") (make-exn:fail:read:eof?/span 1 1))
-(err/rt-test (readstr ",") exn:fail:read:eof?)
+(err/rt-test (readstr "` ") (make-exn:fail:read:eof?/span 1 1))
-(err/rt-test (readstr "#'") exn:fail:read:eof?)
+(err/rt-test (readstr ",@") (make-exn:fail:read:eof?/span 1 2))
-(err/rt-test (readstr "#&") exn:fail:read:eof?)
+(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?)

racket/src/expander/read/box.rkt

@@ -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))

racket/src/expander/read/config.rkt

@@ -95,8 +95,12 @@
                         (read-config-state #f #f)
                         (read-config-st config))]))
 
-(define (port+config->srcloc in config)
+(define (port+config->srcloc in config
-  (define-values (end-line end-col end-pos) (port-next-location in))
+                             #: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")

racket/src/expander/read/error.rkt

@@ -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]

racket/src/expander/read/hash.rkt

@@ -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)
+           [(check-parameter read-square-bracket-as-paren config)
-           (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))
-           (values (read-unwrapped-sequence read-one-key+value c #\[ #\] in config
+            (define read-one-key+value (make-read-one-key+value read-one c #\] open-end-pos))
-                                            #:elem-config config
+            (values (read-unwrapped-sequence read-one-key+value c #\[ #\] in config
-                                            #:dot-mode #f)
+                                             #:elem-config config
-                   ec
+                                             #:dot-mode #f)
-                   mode)]
+                    ec
-          [else
+                    mode)]
-           (reader-error in config "illegal use of `~a`" c)])]
+           [else
+            (reader-error in config "illegal use of `~a`" c)])]
         [(#\{)
          (cond
-          [(check-parameter read-curly-brace-as-paren config)
+           [(check-parameter read-curly-brace-as-paren config)
-           (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))
-           (values (read-unwrapped-sequence read-one-key+value c #\{ #\} in config
+            (define read-one-key+value (make-read-one-key+value read-one c #\} open-end-pos))
-                                            #:elem-config config
+            (values (read-unwrapped-sequence read-one-key+value c #\{ #\} in config
-                                            #:dot-mode #f)
+                                             #:elem-config config
-                   ec
+                                             #:dot-mode #f)
-                   mode)]
+                    ec
-          [else
+                    mode)]
-           (reader-error in config "illegal use of `~a`" c)])]
+           [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)
+      (reader-error in config
-                    #:due-to c
+                    #: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"

racket/src/expander/read/location.rkt

@@ -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)]

racket/src/expander/read/main.rkt

@@ -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
+                            #:due-to c2
-                                 (accum-string-get! accum-str config))])]
+                            (accum-string-get! accum-str config))])]
       [(#\p)
        ;; Maybe pregexp
        (define accum-str (accum-string-init! config))

racket/src/expander/read/quote.rkt

@@ -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))

racket/src/expander/read/sequence.rkt

@@ -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

racket/src/expander/read/string.rkt

@@ -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))