cs: fix problems exposed by "read.rktl" tests

racket/src/cs/regexp.sls

@@ -15,4 +15,9 @@
   (include "include.ss")
   (include-generated "regexp.scm")
 
-  (set-intern-regexp?! 1/regexp?))
+  (define (any-regexp? v)
+    (or (1/regexp? v)
+        (1/byte-regexp? v)))
+
+  (set-intern-regexp?! any-regexp?)
+  (set-printable-regexp?! any-regexp?))

racket/src/cs/rumble/graph.ss

@@ -132,8 +132,8 @@
                 (let ([new-key (loop key)]
                       [new-val (loop val)])
                   (hloop (if mutable?
-                             (hash-set! orig-p key val)
+                             (hash-set! orig-p new-key new-val)
-                             (hash-set p key val))
+                             (hash-set p new-key new-val))
                          (hash-iterate-next v i)
                          (or diff? (not (and (eq? key new-key) (eq? val new-val)))))))])))]
        [(hash-placeholder? v)

racket/src/io/Makefile

@@ -21,6 +21,7 @@ GLOBALS = --no-global \
           ++global-ok installed-read-accept-lang \
           ++global-ok maybe-raise-missing-module \
           ++global-ok "string->number?" \
+          ++global-ok "printable-regexp?" \
           ++global-ok do-global-print \
           ++global-ok exec-file \
           ++global-ok run-file \

racket/src/io/format/printf.rkt

@@ -95,10 +95,11 @@
               (do-global-print who (car args) o)
               (next i (cdr args))]
              [(#\e #\E)
-              (write-string ((error-value->string-handler)
+              (parameterize ([print-unreadable #t])
-                             (car args)
+                (write-string ((error-value->string-handler)
-                             (error-print-width))
+                               (car args)
-                            o)
+                               (error-print-width))
+                              o))
               (next i (cdr args))]
              [(#\.)
               (let ([i (add1 i)])

racket/src/io/port/special-input.rkt

@@ -80,7 +80,10 @@
        [else
         (define special
           (cond
-            [(not source-name)
+            [#f
+             ;; There doesn't seem to be a case anymore
+             ;; where the old Racket implementation uses
+             ;; the 0-arity and/or no-position protocol
              (cond
                [(procedure-arity-includes? v 0)
                 (v)]

racket/src/io/print/main.rkt

@@ -22,6 +22,7 @@
          "mode.rkt"
          "graph.rkt"
          "config.rkt"
+         "regexp.rkt"
          "recur-handler.rkt")
 
 (provide display
@@ -38,6 +39,8 @@
          custom-print-quotable?
          custom-print-quotable-accessor
 
+         set-printable-regexp?!
+
          (all-from-out "parameter.rkt"))
 
 (module+ internal
@@ -243,6 +246,17 @@
               (not (hash-weak? v)))
          (print-hash v o max-length p who mode graph config)
          (write-string/max "#<hash>" o max-length))]
+    [(and (eq? mode WRITE-MODE)
+          (not (config-get config print-unreadable))
+          ;; Regexps are a special case: custom writers that produce readable input
+          (not (printable-regexp? v)))
+     (raise (exn:fail
+             (string-append (symbol->string who)
+                            ": printing disabled for unreadable value"
+                            "\n  value: "
+                            (parameterize ([print-unreadable #t])
+                              ((error-value->string-handler) v (error-print-width))))
+             (current-continuation-marks)))]
     [(mpair? v)
      (print-mlist p who v mode o max-length graph config)]
     [(custom-write? v)

racket/src/io/print/regexp.rkt

@@ -0,0 +1,7 @@
+#lang racket/base
+
+(provide printable-regexp?
+         set-printable-regexp?!)
+
+(define printable-regexp? (lambda (v) #f))
+(define (set-printable-regexp?! proc) (set! printable-regexp? proc))