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

pretty-print: fix for a current inspector that sees through internals

Browse Source 
If the current inspector can inspect the internal `unquoted` structure
type, then `unquoted?` must come before `struct?`.
This commit is contained in:
Matthew Flatt 2015-01-29 07:55:32 -07:00
parent 3029867e9f
commit 8d49a91dce
2 changed files with 20 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/racket-test-core/tests/racket/pretty.rktl
View File

@ -447,6 +447,20 @@
(test "#true" pretty-format #t)
(test "#false" pretty-format #f))
;; ----------------------------------------
;; check that an all-powerful inspector doesn't break the pretty printer internally
(let-values ([(pp v)
(parameterize ([current-namespace (make-base-namespace)]
[current-inspector (make-inspector)])
(define pp (dynamic-require 'racket/pretty 'pretty-print))
(struct a (x))
(values pp (a 1)))])
(define o (open-output-bytes))
(parameterize ([current-output-port o])
(pp v))
(test "(a 1)\n" get-output-string o))
;; ----------------------------------------
(report-errs)

12
racket/collects/racket/pretty.rkt
View File

@ -913,7 +913,11 @@
qd
(to-quoted out qd obj)))])
(write-custom wr* obj pport depth display? width qd #f)))))]
[(struct? obj)
[(hide? obj)
(wr* pport (hide-val obj) depth display? qd)]
[(unquoted? obj)
(orig-write (unquoted-val obj) pport)]
[(struct? obj)
(if (and print-struct?
(not (and depth
(zero? depth))))
@ -959,8 +963,6 @@
pair? car cdr "(" ")" qd))))
(parameterize ([print-hash-table #f])
((if display? orig-display orig-write) obj pport)))]
[(hide? obj)
(wr* pport (hide-val obj) depth display? qd)]
[(boolean? obj)
(out (if long-bools?
(if obj "#true" "#false")
@ -973,7 +975,7 @@
number->decimal-string
number->string)
obj))]
[(and (pretty-print-.-symbol-without-bars)
[(and (pretty-print-.-symbol-without-bars)
(eq? obj '|.|))
(out ".")]
[(and qd (or (symbol? obj)
@ -981,8 +983,6 @@
(unless (eq? obj struct-ellipses)
(to-quoted out qd obj))
(orig-write obj pport)]
[(unquoted? obj)
(orig-write (unquoted-val obj) pport)]
[else
((if display? orig-display orig-write) obj pport)]))
(unless (hide? obj)