1 USING: arrays definitions io.streams.string io.streams.duplex
2 kernel math namespaces parser prettyprint prettyprint.config
3 prettyprint.sections sequences tools.test vectors words
4 effects splitting generic.standard prettyprint.private
5 continuations generic compiler.units tools.walker eval
9 [ "4" ] [ 4 unparse ] unit-test
10 [ "1.0" ] [ 1.0 unparse ] unit-test
11 [ "1267650600228229401496703205376" ] [ 1 100 shift unparse ] unit-test
13 [ "+" ] [ \ + unparse ] unit-test
15 [ "\\ +" ] [ [ \ + ] first unparse ] unit-test
17 [ "{ }" ] [ { } unparse ] unit-test
19 [ "{ 1 2 3 }" ] [ { 1 2 3 } unparse ] unit-test
21 [ "\"hello\\\\backslash\"" ]
22 [ "hello\\backslash" unparse ]
26 ! [ "\u123456" unparse ]
33 [ "f" ] [ f unparse ] unit-test
34 [ "t" ] [ t unparse ] unit-test
36 [ "SBUF\" hello world\"" ] [ SBUF" hello world" unparse ] unit-test
38 [ "W{ \\ + }" ] [ [ W{ \ + } ] first unparse ] unit-test
40 [ ] [ \ fixnum see ] unit-test
42 [ ] [ \ integer see ] unit-test
44 [ ] [ \ generic see ] unit-test
46 [ ] [ \ duplex-stream see ] unit-test
48 [ "[ \\ + ]" ] [ [ \ + ] unparse ] unit-test
49 [ "[ \\ [ ]" ] [ [ \ [ ] unparse ] unit-test
52 100 \ dup <array> unparse-short
56 : foo ( a -- b ) dup * ; inline
58 [ "USING: kernel math ;\nIN: prettyprint.tests\n: foo ( a -- b ) dup * ; inline\n" ]
59 [ [ \ foo see ] with-string-writer ] unit-test
61 : bar ( x -- y ) 2 + ;
63 [ "USING: math ;\nIN: prettyprint.tests\n: bar ( x -- y ) 2 + ;\n" ]
64 [ [ \ bar see ] with-string-writer ] unit-test
89 \ blah f "inferred-effect" set-word-prop
90 [ \ blah see ] with-string-writer "\n" ?tail drop 6 tail*
93 : check-see ( expect name -- )
98 [ parse-fresh drop ] with-compilation-unit
100 "prettyprint.tests" lookup see
101 ] with-string-writer "\n" split but-last
105 GENERIC: method-layout
107 M: complex method-layout
108 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
111 M: fixnum method-layout ;
113 M: integer method-layout ;
115 M: object method-layout ;
119 "USING: math prettyprint.tests ;"
120 "M: complex method-layout"
121 " \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\""
124 "USING: math prettyprint.tests ;"
125 "M: fixnum method-layout ;"
127 "USING: math prettyprint.tests ;"
128 "M: integer method-layout ;"
130 "USING: kernel prettyprint.tests ;"
131 "M: object method-layout ;"
135 [ \ method-layout see-methods ] with-string-writer "\n" split
140 "USING: io kernel sequences words ;"
141 "IN: prettyprint.tests"
142 ": retain-stack-layout ( x -- )"
143 " dup stream-readln stream-readln"
144 " >r [ define ] map r>"
149 "retain-stack-layout" retain-stack-test check-see
154 "USING: kernel math sequences strings ;"
155 "IN: prettyprint.tests"
156 ": soft-break-layout ( x y -- ? )"
158 " over hashcode over hashcode number="
159 " [ sequence= ] [ 2drop f ] if"
160 " ] [ 2drop f ] if ;"
164 "soft-break-layout" soft-break-test check-see
167 : another-retain-layout-test
169 "USING: kernel sequences ;"
170 "IN: prettyprint.tests"
171 ": another-retain-layout ( seq1 seq2 quot -- newseq )"
172 " -rot 2dup dupd min-length [ each drop roll ] map"
173 " >r 3drop r> ; inline"
177 "another-retain-layout" another-retain-layout-test check-see
180 DEFER: parse-error-file
182 : another-soft-break-test
184 "USING: make sequences ;"
185 "IN: prettyprint.tests"
186 ": another-soft-break-layout ( node -- quot )"
188 " [ <reversed> \"hello world foo\" suffix ] [ ] make ;"
192 "another-soft-break-layout" another-soft-break-test
198 "USING: accessors debugger io kernel ;"
199 "IN: prettyprint.tests"
200 ": string-layout-test ( error -- )"
201 " \"Expected \" write dup want>> expected>string write"
202 " \" but got \" write got>> expected>string print ;"
207 "string-layout-test" string-layout check-see
210 ! Define dummy words for the below...
211 : <NSRect> ( a b c d -- e ) ;
212 : <PixelFormat> ( -- fmt ) ;
215 \ send soft "break-after" set-word-prop
217 : final-soft-break-test
219 "USING: kernel sequences ;"
220 "IN: prettyprint.tests"
221 ": final-soft-break-layout ( class dim -- view )"
222 " >r \"alloc\" send 0 0 r>"
224 " <PixelFormat> \"initWithFrame:pixelFormat:\" send"
225 " dup 1 \"setPostsBoundsChangedNotifications:\" send"
226 " dup 1 \"setPostsFrameChangedNotifications:\" send ;"
230 "final-soft-break-layout" final-soft-break-test check-see
235 "USING: arrays combinators continuations kernel sequences ;"
236 "IN: prettyprint.tests"
237 ": narrow-layout ( obj -- )"
239 " { [ dup continuation? ] [ append ] }"
240 " { [ dup not ] [ drop reverse ] }"
241 " { [ dup pair? ] [ delete ] }"
246 "narrow-layout" narrow-test check-see
249 : another-narrow-test
251 "IN: prettyprint.tests"
252 ": another-narrow-layout ( -- obj )"
265 "another-narrow-layout" another-narrow-test check-see
268 IN: prettyprint.tests
269 TUPLE: class-see-layout ;
271 IN: prettyprint.tests
272 GENERIC: class-see-layout ( x -- y )
274 USING: prettyprint.tests ;
275 M: class-see-layout class-see-layout ;
279 "IN: prettyprint.tests"
280 "TUPLE: class-see-layout ;"
282 "IN: prettyprint.tests"
283 "GENERIC: class-see-layout ( x -- y )"
287 [ \ class-see-layout see ] with-string-writer "\n" split
292 "USING: prettyprint.tests ;"
293 "M: class-see-layout class-see-layout ;"
297 [ \ class-see-layout see-methods ] with-string-writer "\n" split
300 [ ] [ \ in>> synopsis drop ] unit-test
304 "IN: prettyprint.tests\nGENERIC: generic-decl-test ( a -- b ) flushable\n"
306 "generic-decl-test" "prettyprint.tests" lookup
307 [ see ] with-string-writer =
311 [ \ + (step-into-execute) ] (remove-breakpoints)
314 [ [ (step-into-execute) ] ] [
315 [ (step-into-execute) ] (remove-breakpoints)
319 [ 2 2 \ + (step-into-execute) . ] (remove-breakpoints)
323 [ 2 break 2 \ + (step-into-execute) . ] (remove-breakpoints)
326 [ ] [ 1 \ + curry unparse drop ] unit-test
328 [ ] [ 1 \ + compose unparse drop ] unit-test
330 GENERIC: generic-see-test-with-f ( obj -- obj )
332 M: f generic-see-test-with-f ;
334 [ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [
335 [ { POSTPONE: f generic-see-test-with-f } see ] with-string-writer
338 [ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [
339 [ \ f \ generic-see-test-with-f method see ] with-string-writer
342 PREDICATE: predicate-see-test < integer even? ;
344 [ "USING: math ;\nIN: prettyprint.tests\nPREDICATE: predicate-see-test < integer even? ;\n" ] [
345 [ \ predicate-see-test see ] with-string-writer
348 INTERSECTION: intersection-see-test sequence number ;
350 [ "USING: math sequences ;\nIN: prettyprint.tests\nINTERSECTION: intersection-see-test sequence number ;\n" ] [
351 [ \ intersection-see-test see ] with-string-writer
354 [ ] [ \ compose see ] unit-test
355 [ ] [ \ curry see ] unit-test
357 [ "POSTPONE: [" ] [ \ [ unparse ] unit-test