more test for print/pretty-print

This commit is contained in:
Gustavo Massaccesi 2019-08-05 12:51:51 -03:00
parent ecaff3dc96
commit 044c15ec8f

View File

@ -407,15 +407,24 @@
(define (print/not-expr v [o (current-output-port)])
(parameterize ([print-as-expression #f])
(print v o)))
(define (pretty-print/not-expr v [o (current-output-port)])
(parameterize ([print-as-expression #f])
(pretty-print v o)))
(define (print/depth-1 v [o (current-output-port)])
(print v o 1))
(define (pretty-print/depth-1 v [o (current-output-port)])
(pretty-print v o 1))
(test wri in-string write x)
(test (string-append wri "\n") in-string pretty-write x)
(test dis in-string display x)
(test (string-append dis "\n") in-string pretty-display x)
(test prn in-string print/not-expr x)
(test (string-append prn "\n") in-string pretty-print/not-expr x)
(test prx in-string print x)
(test (string-append prx "\n") in-string pretty-print x)
(test pr1 in-string print/depth-1 x))
(test pr1 in-string print/depth-1 x)
(test (string-append pr1 "\n") in-string pretty-print/depth-1 x))
(define-syntax (for*/parameterize stx)
(syntax-case stx ()
@ -491,14 +500,88 @@
(test-print/all (list x x)
"(#0=#(struct:s) #0#)" "(#0=#(struct:s) #0#)" "(#0=#(struct:s) #0#)" "(list #0=(s) #0#)" "(#0=#(struct:s) #0#)"))
(test-print/all (a 1 2)
"#<a>" "#<a>" "#<a>" "#<a>" "#<a>")
(test-print/all (b 1 2)
"#(struct:b 1 2)" "#(struct:b 1 2)" "#(struct:b 1 2)" "(b 1 2)" "#(struct:b 1 2)")
(test-print/all (c 1 2)
"#s(c 1 2)" "#s(c 1 2)" "#s(c 1 2)" "'#s(c 1 2)" "#s(c 1 2)")
(test-print/all (c x x)
"#s(c #0=#(struct:s) #0#)" "#s(c #0=#(struct:s) #0#)" "#s(c #0=#(struct:s) #0#)" "(c #0=(s) #0#)" "#s(c #0=#(struct:s) #0#)")
(for*/parameterize ([print-vector-length (in-list '(#t #f))])
(test-print/all (a 1 2)
"#<a>" "#<a>" "#<a>" "#<a>" "#<a>")
(test-print/all (c 1 1)
"#s(c 1 1)" "#s(c 1 1)" "#s(c 1 1)" "'#s(c 1 1)" "#s(c 1 1)")
(test-print/all (c 1 2)
"#s(c 1 2)" "#s(c 1 2)" "#s(c 1 2)" "'#s(c 1 2)" "#s(c 1 2)"))
(parameterize ([print-vector-length #t])
(test-print/all (b 1 1)
"#3(struct:b 1)" "#(struct:b 1 1)" "#3(struct:b 1)" "(b 1 1)" "#3(struct:b 1)")
(test-print/all (b 1 2)
"#3(struct:b 1 2)" "#(struct:b 1 2)" "#3(struct:b 1 2)" "(b 1 2)" "#3(struct:b 1 2)")
(test-print/all (b 'b 'b)
"#3(struct:b b)" "#(struct:b b b)" "#3(struct:b b)" "(b 'b 'b)" "#3(struct:b b)")
(test-print/all (b 'struct:b 'struct:b)
"#3(struct:b)" "#(struct:b struct:b struct:b)" "#3(struct:b)" "(b 'struct:b 'struct:b)" "#3(struct:b)")
(test-print/all (c x x)
"#s(c #0=#1(struct:s) #0#)" "#s(c #0=#(struct:s) #0#)" "#s(c #0=#1(struct:s) #0#)" "(c #0=(s) #0#)" "#s(c #0=#1(struct:s) #0#)")
(test-print/all (vector 1 2 3 4 5)
"#5(1 2 3 4 5)" "#(1 2 3 4 5)" "#5(1 2 3 4 5)" "'#5(1 2 3 4 5)" "#5(1 2 3 4 5)")
(test-print/all (vector 1 2 3 3 3)
"#5(1 2 3)" "#(1 2 3 3 3)" "#5(1 2 3)" "'#5(1 2 3)" "#5(1 2 3)")
(test-print/all (vector (b 1 1) 2 3 3 3)
"#5(#3(struct:b 1) 2 3)" "#(#(struct:b 1 1) 2 3 3 3)" "#5(#3(struct:b 1) 2 3)" "(vector (b 1 1) 2 3 3 3)" "#5(#3(struct:b 1) 2 3)")
(test-print/all (vector)
"#0()" "#()" "#0()" "'#0()" "#0()")
(test-print/all (vector 1)
"#1(1)" "#(1)" "#1(1)" "'#1(1)" "#1(1)")
(test-print/all (vector 1 1)
"#2(1)" "#(1 1)" "#2(1)" "'#2(1)" "#2(1)")
(test-print/all (vector 1 1 1)
"#3(1)" "#(1 1 1)" "#3(1)" "'#3(1)" "#3(1)")
(test-print/all (fxvector 1 2 3 4 5)
"#fx5(1 2 3 4 5)" "#fx(1 2 3 4 5)" "#fx5(1 2 3 4 5)" "(fxvector 1 2 3 4 5)" "#fx5(1 2 3 4 5)")
(test-print/all (fxvector 1 2 3 3 3)
"#fx5(1 2 3)" "#fx(1 2 3 3 3)" "#fx5(1 2 3)" "(fxvector 1 2 3 3 3)" "#fx5(1 2 3)")
(test-print/all (fxvector)
"#fx0()" "#fx()" "#fx0()" "(fxvector)" "#fx0()")
(test-print/all (flvector 1.0 2.0 3.0 4.0 5.0)
"#fl5(1.0 2.0 3.0 4.0 5.0)" "#fl(1.0 2.0 3.0 4.0 5.0)" "#fl5(1.0 2.0 3.0 4.0 5.0)" "(flvector 1.0 2.0 3.0 4.0 5.0)" "#fl5(1.0 2.0 3.0 4.0 5.0)")
(test-print/all (flvector 1.0 2.0 3.0 3.0 3.0)
"#fl5(1.0 2.0 3.0)" "#fl(1.0 2.0 3.0 3.0 3.0)" "#fl5(1.0 2.0 3.0)" "(flvector 1.0 2.0 3.0 3.0 3.0)" "#fl5(1.0 2.0 3.0)")
(test-print/all (flvector)
"#fl0()" "#fl()" "#fl0()" "(flvector)" "#fl0()"))
(parameterize ([print-vector-length #f])
(test-print/all (b 1 1)
"#(struct:b 1 1)" "#(struct:b 1 1)" "#(struct:b 1 1)" "(b 1 1)" "#(struct:b 1 1)")
(test-print/all (b 1 2)
"#(struct:b 1 2)" "#(struct:b 1 2)" "#(struct:b 1 2)" "(b 1 2)" "#(struct:b 1 2)")
(test-print/all (b 'b 'b)
"#(struct:b b b)" "#(struct:b b b)" "#(struct:b b b)" "(b 'b 'b)" "#(struct:b b b)")
(test-print/all (b 'struct:b 'struct:b)
"#(struct:b struct:b struct:b)" "#(struct:b struct:b struct:b)" "#(struct:b struct:b struct:b)" "(b 'struct:b 'struct:b)" "#(struct:b struct:b struct:b)")
(test-print/all (c x x)
"#s(c #0=#(struct:s) #0#)" "#s(c #0=#(struct:s) #0#)" "#s(c #0=#(struct:s) #0#)" "(c #0=(s) #0#)" "#s(c #0=#(struct:s) #0#)")
(test-print/all (vector 1 2 3 4 5)
"#(1 2 3 4 5)" "#(1 2 3 4 5)" "#(1 2 3 4 5)" "'#(1 2 3 4 5)" "#(1 2 3 4 5)")
(test-print/all (vector 1 2 3 3 3)
"#(1 2 3 3 3)" "#(1 2 3 3 3)" "#(1 2 3 3 3)" "'#(1 2 3 3 3)" "#(1 2 3 3 3)")
(test-print/all (vector (b 1 1) 2 3 3 3)
"#(#(struct:b 1 1) 2 3 3 3)" "#(#(struct:b 1 1) 2 3 3 3)" "#(#(struct:b 1 1) 2 3 3 3)" "(vector (b 1 1) 2 3 3 3)" "#(#(struct:b 1 1) 2 3 3 3)")
(test-print/all (vector)
"#()" "#()" "#()" "'#()" "#()")
(test-print/all (vector 1)
"#(1)" "#(1)" "#(1)" "'#(1)" "#(1)")
(test-print/all (vector 1 1)
"#(1 1)" "#(1 1)" "#(1 1)" "'#(1 1)" "#(1 1)")
(test-print/all (vector 1 1 1)
"#(1 1 1)" "#(1 1 1)" "#(1 1 1)" "'#(1 1 1)" "#(1 1 1)")
(test-print/all (fxvector 1 2 3 4 5)
"#fx(1 2 3 4 5)" "#fx(1 2 3 4 5)" "#fx(1 2 3 4 5)" "(fxvector 1 2 3 4 5)" "#fx(1 2 3 4 5)")
(test-print/all (fxvector 1 2 3 3 3)
"#fx(1 2 3 3 3)" "#fx(1 2 3 3 3)" "#fx(1 2 3 3 3)" "(fxvector 1 2 3 3 3)" "#fx(1 2 3 3 3)")
(test-print/all (fxvector)
"#fx()" "#fx()" "#fx()" "(fxvector)" "#fx()")
(test-print/all (flvector 1.0 2.0 3.0 4.0 5.0)
"#fl(1.0 2.0 3.0 4.0 5.0)" "#fl(1.0 2.0 3.0 4.0 5.0)" "#fl(1.0 2.0 3.0 4.0 5.0)" "(flvector 1.0 2.0 3.0 4.0 5.0)" "#fl(1.0 2.0 3.0 4.0 5.0)")
(test-print/all (flvector 1.0 2.0 3.0 3.0 3.0)
"#fl(1.0 2.0 3.0 3.0 3.0)" "#fl(1.0 2.0 3.0 3.0 3.0)" "#fl(1.0 2.0 3.0 3.0 3.0)" "(flvector 1.0 2.0 3.0 3.0 3.0)" "#fl(1.0 2.0 3.0 3.0 3.0)")
(test-print/all (flvector)
"#fl()" "#fl()" "#fl()" "(flvector)" "#fl()"))
(void))))
;; ----------------------------------------