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

cs & io: fix mode argument when print-as-expression is #f

Browse Source
This commit is contained in:
Matthew Flatt 2019-11-25 20:05:23 -07:00
parent 4c981258f6
commit 1048341c62
2 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/racket-test-core/tests/racket/file.rktl
View File

@ -863,9 +863,15 @@
(parameterize ([global-port-print-handler oldd])
(test (void) print "hello" sp)
(test (adding "hello") get-output-string sp))
(parameterize ([global-port-print-handler (lambda (v p [depth 0])
(test #t pair? (member depth '(0 1)))
(write 'changes-to-Y p))])
(test (void) print "hello" sp)
(parameterize ([print-as-expression #f])
(test (void) print "hello" sp))
(test (adding "YY") get-output-string sp))
(test (void) print "hello" sp)
(test (adding "\"hello\"") get-output-string sp)
(port-print-handler sp (lambda (v p) (oldd "Z" p) 5))
(test (void) display "hello" sp)
@ -922,6 +928,7 @@
(port-write-handler p (lambda (x p)
(write-bytes #"W" p)))
(port-print-handler p (lambda (x p [d 0])
(test #t pair? (memq d '(0 1)))
(write-bytes #"P" p)))
(display 'x p)

6
racket/src/io/print/main.rkt
View File

@ -119,19 +119,19 @@
(set! do-global-print
(lambda (who v o [quote-depth-in PRINT-MODE/UNQUOTED] [max-length #f])
(define global-print (param))
(define quote-depth (if (print-as-expression) quote-depth-in WRITE-MODE))
(cond
[(eq? global-print default-value)
(define quote-depth (if (print-as-expression) quote-depth-in WRITE-MODE))
(do-print who v o quote-depth max-length)]
[(not max-length)
(global-print v o quote-depth)]
(global-print v o quote-depth-in)]
[else
;; There's currently no way to communicate `max-length`
;; to the `global-print` function, but we should only get
;; here when `o` is a string port for errors, so write to
;; a fresh string port and truncate as needed.
(define o2 (open-output-bytes))
(global-print v o2 quote-depth)
(global-print v o2 quote-depth-in)
(define bstr (get-output-bytes o2))
(if ((bytes-length bstr) . <= . max-length)
(unsafe-write-bytes who bstr o)