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

Avoid unnecessary use of fprintf.

Browse Source 
Closes #3113.
This commit is contained in:
Sam Tobin-Hochstadt 2020-04-21 13:27:19 -04:00 committed by Sam Tobin-Hochstadt
parent 392dc33ceb
commit 859e7b4373
3 changed files with 25 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
pkgs/racket-test/tests/racket/dump-tilde-name.rkt Normal file
View File

@ -0,0 +1,20 @@
#lang racket/base
(require racket/contract)
;; This test checks that names of records using ~ can be dumped successfully
;; The contracted procedure is here because the rumble implementation has a
;; ~ in the name.
(define foo
(contract (-> #:x any/c any/c)
(λ (#:x x) 0)
'pos
'neg))
(struct ~s ( x))
(define v (~s 1))
(dump-memory-stats)
v

3
racket/src/cs/chezpart.sls
View File

@ -22,7 +22,7 @@
with-input-from-file with-output-to-file with-input-from-file with-output-to-file
call-with-output-file call-with-output-file
file-position file-position
write display newline port-name port-closed? write-char write newline port-name port-closed? write-char
print-graph print-vector-length print-graph print-vector-length
date? make-date date? make-date
dynamic-wind dynamic-wind
@ -67,6 +67,7 @@
[fprintf chez:fprintf] [fprintf chez:fprintf]
[printf chez:printf] [printf chez:printf]
[format chez:format] [format chez:format]
[display chez:display]
[current-error-port chez:current-error-port] [current-error-port chez:current-error-port]
[string->number chez:string->number] [string->number chez:string->number]
[number->string chez:number->string] [number->string chez:number->string]

6
racket/src/cs/rumble/memory.ss
View File

@ -318,10 +318,10 @@
(unless skip-counts? (unless skip-counts?
(#%fprintf (current-error-port) "Begin RacketCS\n") (#%fprintf (current-error-port) "Begin RacketCS\n")
(for-each (lambda (e) (for-each (lambda (e)
(chez:fprintf (current-error-port) (chez:display (layout-line (chez:format "~a" (car e))
(layout-line (chez:format "~a" (car e))
((get-count #f) e) ((get-bytes #f) e) ((get-count #f) e) ((get-bytes #f) e)
((get-count #t) e) ((get-bytes #t) e)))) ((get-count #t) e) ((get-bytes #t) e))
(current-error-port)))
(list-sort (lambda (a b) (< ((get-bytes #f) a) ((get-bytes #f) b))) counts)) (list-sort (lambda (a b) (< ((get-bytes #f) a) ((get-bytes #f) b))) counts))
(#%fprintf (current-error-port) (layout-line "total" (#%fprintf (current-error-port) (layout-line "total"
(apply + (map (get-count #f) counts)) (apply + (map (get-count #f) counts))