cs: fix printing on struct type with custom write

Don't try to use a struct type's custom-write procedure on the struct
type itself.

Relevant to #2926
This commit is contained in:
Matthew Flatt 2019-11-23 15:25:34 -05:00
parent cd048cb1d0
commit 7eb1ef9250
3 changed files with 9 additions and 3 deletions

View File

@ -867,6 +867,8 @@
(define-values (s:tuple make-tuple tuple? tuple-ref tuple-set!)
(make-struct-type 'tuple #f 1 0 #f
(list (cons prop:custom-write tuple-print))))
(test "#<struct-type:tuple>" values (format "~s" s:tuple)) ; shouldn't trigger custom write
(define (with-output-string thunk)
(let ([p (open-output-string)])

View File

@ -53,7 +53,8 @@
(and (not print-graph?)
(not (eq? mode PRINT-MODE/UNQUOTED))
(quick-no-graph? (mcdr v) (quick-no-graph? (mcar v) (sub1 fuel))))]
[(custom-write? v)
[(and (custom-write? v)
(not (struct-type? v)))
#f]
[(and (struct? v)
(config-get config print-struct))
@ -163,7 +164,8 @@
(build-graph (mcar v) mode)
(build-graph (mcdr v) mode)
(done! v (eq? mode PRINT-MODE/UNQUOTED))]
[(custom-write? v)
[(and (custom-write? v)
(not (struct-type? v)))
(define print-quotable (if (eq? mode PRINT-MODE/UNQUOTED)
(custom-print-quotable-accessor v 'self)
'self))

View File

@ -200,6 +200,7 @@
(hash? v)
(prefab-struct-key v)
(and (custom-write? v)
(not (struct-type? v))
(not (printable-regexp? v))
(not (eq? 'self (custom-print-quotable-accessor v 'self))))))
;; Since this value is not marked for constructor mode,
@ -292,7 +293,8 @@
(fail-unreadable who v)]
[(mpair? v)
(print-mlist p who v mode o max-length graph config)]
[(custom-write? v)
[(and (not (struct-type? v))
(custom-write? v))
(let ([o/m (make-output-port/max o max-length)])
(set-port-handlers-to-recur!
o/m