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

added pretty-format

Browse Source 
svn: r5862
This commit is contained in:
Robby Findler 2007-04-03 22:27:21 +00:00
parent c68372b552
commit 8f51c76a7b
3 changed files with 77 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/mzlib/pretty.ss
View File

@ -31,6 +31,8 @@
pretty-print-extend-style-table
pretty-print-remap-stylable
pretty-format
pretty-printing
pretty-print-newline
make-tentative-pretty-print-output-port
@ -1122,5 +1124,20 @@
(substring padded-s (- len 10-power) len)))
;; d has factor(s) other than 2 and 5.
;; Print as a fraction.
(number->string x)))))))])))
(number->string x)))))))]))
(define pretty-format
(case-lambda
[(t) (pretty-format t (pretty-print-columns))]
[(t w)
(parameterize ([pretty-print-columns w])
(let ([op (open-output-string)])
(pretty-print t op)
(let ([s (get-output-string op)])
(if (eq? w 'infinity)
s
(substring s 0 (- (string-length s) 1))))))]))
)

12
collects/tests/drscheme/repl-test.ss
View File

@ -118,6 +118,18 @@
#f
void
void)
;; make sure only a single syntax error occurs when in nested begin situation
(make-test "(begin (lambda ()) (lambda ()))"
"lambda: bad syntax in: (lambda ())"
"{file.gif} repl-test-tmp.ss:1:7: lambda: bad syntax in: (lambda ())"
"lambda: bad syntax in: (lambda ())"
"{bug09.gif} {file.gif} repl-test-tmp.ss:1:7: lambda: bad syntax in: (lambda ())"
(cons (make-loc 0 7 7) (make-loc 0 18 18))
#f
void
void)
(make-test "xx"
"reference to undefined identifier: xx"
"reference to undefined identifier: xx"

95
collects/tests/mzscheme/pretty.ss
View File

@ -49,36 +49,35 @@
(make-struct-type 'pprec #f 2 0 #f
(list (cons prop:custom-write pprec-print))))
(define (pp-string v)
(let ([p (open-output-string)])
(pretty-print v p)
(let ([s (get-output-string p)])
(substring s 0 (sub1 (string-length s))))))
(test "10" pp-string 10)
(test "1/2" pp-string 1/2)
(test "-1/2" pp-string -1/2)
(test "1/2+3/4i" pp-string 1/2+3/4i)
(test "0.333" pp-string #i0.333)
(test "2.0+1.0i" pp-string #i2+1i)
(test "'a" pp-string ''a)
(test "`a" pp-string '`a)
(test ",a" pp-string ',a)
(test ",@a" pp-string ',@a)
(test "#'a" pp-string '#'a)
(test "W{1 2}" pp-string (make-pprec 1 2))
(test "#&10" pp-string (box 10))
(test "10" pretty-format 10)
(test "1/2" pretty-format 1/2)
(test "-1/2" pretty-format -1/2)
(test "1/2+3/4i" pretty-format 1/2+3/4i)
(test "0.333" pretty-format #i0.333)
(test "2.0+1.0i" pretty-format #i2+1i)
(test "'a" pretty-format ''a)
(test "`a" pretty-format '`a)
(test ",a" pretty-format ',a)
(test ",@a" pretty-format ',@a)
(test "#'a" pretty-format '#'a)
(test "W{1 2}" pretty-format (make-pprec 1 2))
(test "#&10" pretty-format (box 10))
(parameterize ([print-box #f])
(test "#<box>" pp-string (box 10)))
(test "#1(10)" pp-string (vector 10))
(test "#2(10)" pp-string (vector 10 10))
(test "#<box>" pretty-format (box 10)))
(test "#1(10)" pretty-format (vector 10))
(test "#2(10)" pretty-format (vector 10 10))
(parameterize ([print-vector-length #f])
(test "#(10 10)" pp-string (vector 10 10)))
(test "#<hash-table>" pp-string (let ([ht (make-hash-table)])
(test "#(10 10)" pretty-format (vector 10 10)))
(test "#<hash-table>" pretty-format (let ([ht (make-hash-table)])
(hash-table-put! ht 1 2)
ht))
(test "(1\n 2)" pretty-format '(1 2) 2)
(test "(1 2)" pretty-format '(1 2) 'infinity)
(parameterize ([print-hash-table #t])
(test "#hasheq((1 . 2))" pp-string (let ([ht (make-hash-table)])
(test "#hasheq((1 . 2))" pretty-format (let ([ht (make-hash-table)])
(hash-table-put! ht 1 2)
ht)))
@ -87,35 +86,35 @@
(test #t pretty-print-style-table? (pretty-print-extend-style-table (pretty-print-current-style-table) null null))
(parameterize ([pretty-print-columns 20])
(test "(1234567890 1 2 3 4)" pp-string '(1234567890 1 2 3 4))
(test "(1234567890xx\n 1\n 2\n 3\n 4)" pp-string '(1234567890xx 1 2 3 4))
(test "(lambda 1234567890\n 1\n 2\n 3\n 4)" pp-string '(lambda 1234567890 1 2 3 4))
(test "(1234567890 1 2 3 4)" pretty-format '(1234567890 1 2 3 4))
(test "(1234567890xx\n 1\n 2\n 3\n 4)" pretty-format '(1234567890xx 1 2 3 4))
(test "(lambda 1234567890\n 1\n 2\n 3\n 4)" pretty-format '(lambda 1234567890 1 2 3 4))
(let ([table (pretty-print-extend-style-table #f null null)])
(parameterize ([pretty-print-current-style-table
(pretty-print-extend-style-table table '(lambda) '(list))])
(test "(lambda\n 1234567890\n 1\n 2\n 3\n 4)" pp-string '(lambda 1234567890 1 2 3 4)))
(test "(lambda 1234567890\n 1\n 2\n 3\n 4)" pp-string '(lambda 1234567890 1 2 3 4))
(test "(lambda\n 1234567890\n 1\n 2\n 3\n 4)" pretty-format '(lambda 1234567890 1 2 3 4)))
(test "(lambda 1234567890\n 1\n 2\n 3\n 4)" pretty-format '(lambda 1234567890 1 2 3 4))
(parameterize ([pretty-print-current-style-table table])
(test "(lambda 1234567890\n 1\n 2\n 3\n 4)" pp-string '(lambda 1234567890 1 2 3 4)))))
(test "(lambda 1234567890\n 1\n 2\n 3\n 4)" pretty-format '(lambda 1234567890 1 2 3 4)))))
(parameterize ([pretty-print-exact-as-decimal #t])
(test "10" pp-string 10)
(test "0.5" pp-string 1/2)
(test "-0.5" pp-string -1/2)
(test "3500.5" pp-string 7001/2)
(test "0.0001220703125" pp-string 1/8192)
(test "10" pretty-format 10)
(test "0.5" pretty-format 1/2)
(test "-0.5" pretty-format -1/2)
(test "3500.5" pretty-format 7001/2)
(test "0.0001220703125" pretty-format 1/8192)
(test "0.0000000000000006869768746897623487"
pp-string 6869768746897623487/10000000000000000000000000000000000)
(test "0.00000000000001048576" pp-string (/ (expt 5 20)))
pretty-format 6869768746897623487/10000000000000000000000000000000000)
(test "0.00000000000001048576" pretty-format (/ (expt 5 20)))
(test "1/3" pp-string 1/3)
(test "1/300000000000000000000000" pp-string 1/300000000000000000000000)
(test "1/3" pretty-format 1/3)
(test "1/300000000000000000000000" pretty-format 1/300000000000000000000000)
(test "0.5+0.75i" pp-string 1/2+3/4i)
(test "0.5-0.75i" pp-string 1/2-3/4i)
(test "1/9+3/17i" pp-string 1/9+3/17i)
(test "0.333" pp-string #i0.333)
(test "2.0+1.0i" pp-string #i2+1i))
(test "0.5+0.75i" pretty-format 1/2+3/4i)
(test "0.5-0.75i" pretty-format 1/2-3/4i)
(test "1/9+3/17i" pretty-format 1/9+3/17i)
(test "0.333" pretty-format #i0.333)
(test "2.0+1.0i" pretty-format #i2+1i))
(let ()
(define-struct wrap (content))
@ -139,13 +138,13 @@
[pretty-print-print-hook
(λ (val dsp? port)
(write (wrap-content val) port))])
(test "(lambda (x)\n abcdef)" pp-string (add-wrappers '(lambda (x) abcdef)))
(test "(call/cc\n call/cc)" pp-string (add-wrappers '(call/cc call/cc)))))
(test "(lambda (x)\n abcdef)" pretty-format (add-wrappers '(lambda (x) abcdef)))
(test "(call/cc\n call/cc)" pretty-format (add-wrappers '(call/cc call/cc)))))
(parameterize ([print-struct #t])
(let ()
(define-struct s (x) (make-inspector))
(test "#(struct:s 1)" pp-string (make-s 1))))
(test "#(struct:s 1)" pretty-format (make-s 1))))
(err/rt-test (pretty-print-extend-style-table 'ack '(a) '(b)))
(err/rt-test (pretty-print-extend-style-table (pretty-print-current-style-table) 'a '(b)))