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 "#true" pretty-format #t)
(test "#false" pretty-format #f)) (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) (report-errs)

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

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