reader: repair readtable re-mapping of # comment forms

Thanks to @LiberalArtist for the bug report and examples.

pkgs/racket-doc/scribblings/reference/readtables.scrbl

@@ -115,7 +115,9 @@ The possible combinations for @racket[key], @racket[mode], and
  @item{@racket[(code:line _char _like-char _readtable)] --- causes
  @racket[_char] to be parsed in the same way that @racket[_like-char]
  is parsed in @racket[_readtable], where @racket[_readtable] can be
- @racket[#f] to indicate the default readtable. Mapping a character to
+ @racket[#f] to indicate the default readtable. (The mapping of
+ @racket[_char] does not apply after @litchar{#}, which is configured
+ separately via @racket['dispatch-macro].) Mapping a character to
  the same actions as @litchar{|} in the default reader means that the
  character starts quoting for symbols, and the same character
  terminates the quote; in contrast, mapping a character to the same

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

@@ -387,7 +387,58 @@
   (try #\( #\) #\[ #\])
   (try #\[ #\] #\( #\))
   (try #\{ #\} #\[ #\]))
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check that comment forms can be redirecteed by a readtable
+
+(let ([readstr (lambda (s)
+                 (read (open-input-string s)))])
+  (define readtable
+    (make-readtable #f
+                    #\$ #\; #f
+                    #\* #\| #f
+                    #\? #\! #f))
+
+  (parameterize ([current-readtable readtable])
+    (test 'x readstr "$this\nx")
+    ;; char mapping doesn't affect `#...`
+    (err/rt-test (readstr "#$datum x") exn:fail:read?)
+    (err/rt-test (readstr "#* ??? *# x") exn:fail:read?)
+    (err/rt-test (readstr "#?/other\nx") exn:fail:read?)))
+
+(let ([readstr (lambda (s)
+                 (read (open-input-string s)))])
+  (define saw #f)
   
+  (define ((comment->x msg) ch in src line col pos)
+    (test #f equal? saw msg) ; only once
+    (set! saw msg)
+    'x)
+
+  (define readtable0
+    (make-readtable #f
+                    #\; 'terminating-macro (comment->x "line")
+                    #\; 'dispatch-macro (comment->x "s-exp")
+                    #\| 'dispatch-macro (comment->x "block")
+                    #\! 'dispatch-macro (comment->x "unix")))
+
+  (define readtable
+    (make-readtable readtable0
+                    #\$ #\; readtable0
+                    #\* #\| readtable0
+                    #\? #\! readtable0))
+
+  (parameterize ([current-readtable readtable])
+    (for ([str  '(";this" "$this" "#;datum" "#$datum" "#|a block|#" "#* x *#" "#!/usr/bin/env racket" "#?/other")]
+          [kind '("line"  "line"  "s-exp"   error     "block"       error     "unix"                  error)])
+      (cond
+        [(eq? kind 'error)
+         (err/rt-test (readstr str) exn:fail:read?)]
+        [else
+         (set! saw #f)
+         (test 'x readstr str)
+         (test kind values saw)]))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

racket/src/expander/read/readtable.rkt

@@ -13,6 +13,7 @@
          readtable-mapping
          current-readtable
          readtable-effective-char
+         readtable-effective-char/#
          effective-char
          readtable-handler
          readtable-dispatch-handler
@@ -136,6 +137,13 @@
    [(char? target) target]
    [else #\x])) ; return some non-special character
 
+;; Similar to `readtable-effective-char`, but for a character after
+;; `#` to detect whether it has the usual meaning
+(define (readtable-effective-char/# rt c)
+  (cond
+    [(and rt (hash-ref (readtable-dispatch-ht rt) c #f)) #f]
+    [else c]))
+
 (define (effective-char c config)
   (readtable-effective-char (read-config-readtable config) c))
 

racket/src/expander/read/whitespace.rkt

@@ -43,13 +43,13 @@
           (result-special-comment)
           (skip-loop #f))]
      [(and (char=? #\# ec)
-           (eqv? #\| (peek-char/special in config 0 source)))
+           (eqv? #\| (readtable-effective-char/# rt (peek-char/special in config 0 source))))
       (skip-pipe-comment! c in config)
       (if (read-config-keep-comment? config)
           (result-special-comment)
           (skip-loop #f))]
      [(and (char=? #\# ec)
-           (eqv? #\! (peek-char/special in config 0 source))
+           (eqv? #\! (readtable-effective-char/# rt (peek-char/special in config 0 source)))
            (let ([c3 (peek-char/special in config 1 source)])
              (or (eqv? #\space c3)
                  (eqv? #\/ c3))))
@@ -58,7 +58,7 @@
           (result-special-comment)
           (skip-loop #f))]
      [(and (char=? #\# ec)
-           (eqv? #\; (peek-char/special in config 0 source)))
+           (eqv? #\; (readtable-effective-char/# rt (peek-char/special in config 0 source))))
       (consume-char in #\;)
       (define v (read-one #f in config))
       (when (eof-object? v)

racket/src/racket/src/startup.inc

@@ -52860,6 +52860,10 @@ static const char *startup_source =
 "(let-values(((target_0)(hash-ref(readtable-char-ht rt_0) c_0 #f)))"
 "(if(not target_0)(let-values() c_0)(if(char? target_0)(let-values() target_0)(let-values() '#\\x)))))))"
 "(define-values"
+"(readtable-effective-char/#)"
+"(lambda(rt_0 c_0)"
+"(begin(if(if rt_0(hash-ref(readtable-dispatch-ht rt_0) c_0 #f) #f)(let-values() #f)(let-values() c_0)))))"
+"(define-values"
 "(effective-char)"
 "(lambda(c_0 config_0)"
 "(begin"
@@ -53152,6 +53156,8 @@ static const char *startup_source =
 "(if(if(char=? '#\\# ec_0)"
 "(eqv?"
 " '#\\|"
+"(readtable-effective-char/#"
+" rt_0"
 "(let-values(((in_1) in_0)((skip-count_0) 0)((source_1) source_0))"
 "(let-values(((c_1)"
 "(peek-char-or-special"
@@ -53159,7 +53165,7 @@ static const char *startup_source =
 " skip-count_0"
 " 'special"
 " source_1)))"
-"(if(eq? c_1 'special)(special1.1 'special) c_1))))"
+"(if(eq? c_1 'special)(special1.1 'special) c_1)))))"
 " #f)"
 "(let-values()"
 "(begin"
@@ -53170,6 +53176,8 @@ static const char *startup_source =
 "(if(if(char=? '#\\# ec_0)"
 "(if(eqv?"
 " '#\\!"
+"(readtable-effective-char/#"
+" rt_0"
 "(let-values(((in_1) in_0)"
 "((skip-count_0) 0)"
 "((source_1) source_0))"
@@ -53179,7 +53187,7 @@ static const char *startup_source =
 " skip-count_0"
 " 'special"
 " source_1)))"
-"(if(eq? c_1 'special)(special1.1 'special) c_1))))"
+"(if(eq? c_1 'special)(special1.1 'special) c_1)))))"
 "(let-values(((c3_0)"
 "(let-values(((in_1) in_0)"
 "((skip-count_0) 1)"
@@ -53206,6 +53214,8 @@ static const char *startup_source =
 "(if(if(char=? '#\\# ec_0)"
 "(eqv?"
 " '#\\;"
+"(readtable-effective-char/#"
+" rt_0"
 "(let-values(((in_1) in_0)"
 "((skip-count_0) 0)"
 "((source_1) source_0))"
@@ -53215,7 +53225,7 @@ static const char *startup_source =
 " skip-count_0"
 " 'special"
 " source_1)))"
-"(if(eq? c_1 'special)(special1.1 'special) c_1))))"
+"(if(eq? c_1 'special)(special1.1 'special) c_1)))))"
 " #f)"
 "(let-values()"
 "(let-values((()(begin(consume-char in_0 '#\\;)(values))))"