more test for print/pretty-print
This commit is contained in:
parent
ecaff3dc96
commit
044c15ec8f
|
@ -407,15 +407,24 @@
|
||||||
(define (print/not-expr v [o (current-output-port)])
|
(define (print/not-expr v [o (current-output-port)])
|
||||||
(parameterize ([print-as-expression #f])
|
(parameterize ([print-as-expression #f])
|
||||||
(print v o)))
|
(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)])
|
(define (print/depth-1 v [o (current-output-port)])
|
||||||
(print v o 1))
|
(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 wri in-string write x)
|
||||||
(test (string-append wri "\n") in-string pretty-write x)
|
(test (string-append wri "\n") in-string pretty-write x)
|
||||||
(test dis in-string display 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 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 prx in-string print x)
|
||||||
(test (string-append prx "\n") in-string pretty-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)
|
(define-syntax (for*/parameterize stx)
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
|
@ -491,14 +500,88 @@
|
||||||
(test-print/all (list x x)
|
(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#)"))
|
"(#0=#(struct:s) #0#)" "(#0=#(struct:s) #0#)" "(#0=#(struct:s) #0#)" "(list #0=(s) #0#)" "(#0=#(struct:s) #0#)"))
|
||||||
|
|
||||||
|
(for*/parameterize ([print-vector-length (in-list '(#t #f))])
|
||||||
(test-print/all (a 1 2)
|
(test-print/all (a 1 2)
|
||||||
"#<a>" "#<a>" "#<a>" "#<a>" "#<a>")
|
"#<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)
|
(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)")
|
"#(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)
|
(test-print/all (b 'b 'b)
|
||||||
"#s(c 1 2)" "#s(c 1 2)" "#s(c 1 2)" "'#s(c 1 2)" "#s(c 1 2)")
|
"#(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)
|
(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#)")
|
"#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))))
|
(void))))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
Loading…
Reference in New Issue
Block a user