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.continuations
6 tools.continuations.private eval accessors make vocabs.parser see
10 [ "4" ] [ 4 unparse ] unit-test
11 [ "4096" ] [ 4096 unparse ] unit-test
12 [ "BIN: 1000000000000" ] [ 2 number-base [ 4096 unparse ] with-variable ] unit-test
13 [ "OCT: 10000" ] [ 8 number-base [ 4096 unparse ] with-variable ] unit-test
14 [ "HEX: 1000" ] [ 16 number-base [ 4096 unparse ] with-variable ] unit-test
15 [ "1.0" ] [ 1.0 unparse ] unit-test
16 [ "8.0" ] [ 8.0 unparse ] unit-test
17 [ "8.0" ] [ 2 number-base [ 8.0 unparse ] with-variable ] unit-test
18 [ "8.0" ] [ 8 number-base [ 8.0 unparse ] with-variable ] unit-test
19 [ "HEX: 1.0p3" ] [ 16 number-base [ 8.0 unparse ] with-variable ] unit-test
20 [ "1267650600228229401496703205376" ] [ 1 100 shift unparse ] unit-test
22 [ "+" ] [ \ + unparse ] unit-test
24 [ "\\ +" ] [ [ \ + ] first unparse ] unit-test
26 [ "{ }" ] [ { } unparse ] unit-test
28 [ "{ 1 2 3 }" ] [ { 1 2 3 } unparse ] unit-test
30 [ "\"hello\\\\backslash\"" ]
31 [ "hello\\backslash" unparse ]
35 ! [ "\u123456" unparse ]
42 [ "f" ] [ f unparse ] unit-test
43 [ "t" ] [ t unparse ] unit-test
45 [ "SBUF\" hello world\"" ] [ SBUF" hello world" unparse ] unit-test
47 [ "W{ \\ + }" ] [ [ W{ \ + } ] first unparse ] unit-test
49 [ ] [ \ fixnum see ] unit-test
51 [ ] [ \ integer see ] unit-test
53 [ ] [ \ generic see ] unit-test
55 [ ] [ \ duplex-stream see ] unit-test
57 [ "[ \\ + ]" ] [ [ \ + ] unparse ] unit-test
58 [ "[ \\ [ ]" ] [ [ \ [ ] unparse ] unit-test
61 100 \ dup <array> unparse-short
65 : foo ( a -- b ) dup * ; inline
67 [ "USING: kernel math ;\nIN: prettyprint.tests\n: foo ( a -- b ) dup * ; inline\n" ]
68 [ [ \ foo see ] with-string-writer ] unit-test
70 : bar ( x -- y ) 2 + ;
72 [ "USING: math ;\nIN: prettyprint.tests\n: bar ( x -- y ) 2 + ;\n" ]
73 [ [ \ bar see ] with-string-writer ] unit-test
75 : blah ( a a a a a a a a a a a a a a a a a a a a -- )
98 [ \ blah see ] with-string-writer "\n" ?tail drop 6 tail*
101 : check-see ( expect name -- ? )
104 [ parse-fresh drop ] with-compilation-unit
106 "prettyprint.tests" lookup see
107 ] with-string-writer "\n" split but-last
109 ] with-interactive-vocabs ;
111 GENERIC: method-layout ( a -- b )
113 M: complex method-layout
115 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
118 M: fixnum method-layout ;
120 M: integer method-layout ;
122 M: object method-layout ;
126 "USING: kernel math prettyprint.tests ;"
127 "M: complex method-layout"
129 " \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\""
132 "USING: math prettyprint.tests ;"
133 "M: fixnum method-layout ;"
135 "USING: math prettyprint.tests ;"
136 "M: integer method-layout ;"
138 "USING: kernel prettyprint.tests ;"
139 "M: object method-layout ;"
143 [ \ method-layout see-methods ] with-string-writer "\n" split
146 : soft-break-test ( -- str )
148 "USING: kernel math sequences strings ;"
149 "IN: prettyprint.tests"
150 ": soft-break-layout ( x y -- ? )"
152 " over hashcode over hashcode number="
153 " [ sequence= ] [ 2drop f ] if"
154 " ] [ 2drop f ] if ;"
158 "soft-break-layout" soft-break-test check-see
161 DEFER: parse-error-file
163 : another-soft-break-test ( -- str )
165 "USING: make sequences ;"
166 "IN: prettyprint.tests"
167 ": another-soft-break-layout ( node -- quot )"
169 " [ <reversed> \"hello world foo\" suffix ] [ ] make ;"
173 "another-soft-break-layout" another-soft-break-test
177 : string-layout ( -- str )
179 "USING: accessors debugger io kernel ;"
180 "IN: prettyprint.tests"
181 ": string-layout-test ( error -- )"
182 " \"Expected \" write dup want>> expected>string write"
183 " \" but got \" write got>> expected>string print ;"
188 "string-layout-test" string-layout check-see
191 : narrow-test ( -- array )
193 "USING: arrays combinators continuations kernel sequences ;"
194 "IN: prettyprint.tests"
195 ": narrow-layout ( obj1 obj2 -- obj3 )"
197 " { [ dup continuation? ] [ append ] }"
198 " { [ dup not ] [ drop reverse ] }"
199 " { [ dup pair? ] [ [ remove! drop ] keep ] }"
204 "narrow-layout" narrow-test check-see
207 : another-narrow-test ( -- array )
209 "IN: prettyprint.tests"
210 ": another-narrow-layout ( -- obj )"
223 "another-narrow-layout" another-narrow-test check-see
226 IN: prettyprint.tests
227 TUPLE: class-see-layout ;
229 IN: prettyprint.tests
230 GENERIC: class-see-layout ( x -- y )
232 USING: prettyprint.tests ;
233 M: class-see-layout class-see-layout ;
237 "IN: prettyprint.tests"
238 "TUPLE: class-see-layout ;"
240 "IN: prettyprint.tests"
241 "GENERIC: class-see-layout ( x -- y )"
245 [ \ class-see-layout see ] with-string-writer "\n" split
250 "USING: prettyprint.tests ;"
251 "M: class-see-layout class-see-layout ;"
255 [ \ class-see-layout see-methods ] with-string-writer "\n" split
258 [ ] [ \ in>> synopsis drop ] unit-test
262 "IN: prettyprint.tests\nGENERIC: generic-decl-test ( a -- b ) flushable\n"
264 "generic-decl-test" "prettyprint.tests" lookup
265 [ see ] with-string-writer =
268 [ [ + ] ] [ [ \ + (step-into-execute) ] (remove-breakpoints) ] unit-test
270 [ [ (step-into-execute) ] ] [ [ (step-into-execute) ] (remove-breakpoints) ] unit-test
273 [ 2 2 \ + (step-into-execute) . ] (remove-breakpoints)
277 [ 2 break 2 \ + (step-into-execute) . ] (remove-breakpoints)
280 GENERIC: generic-see-test-with-f ( obj -- obj )
282 M: f generic-see-test-with-f ;
284 [ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [
285 [ M\ f generic-see-test-with-f see ] with-string-writer
288 PREDICATE: predicate-see-test < integer even? ;
290 [ "USING: math ;\nIN: prettyprint.tests\nPREDICATE: predicate-see-test < integer even? ;\n" ] [
291 [ \ predicate-see-test see ] with-string-writer
294 INTERSECTION: intersection-see-test sequence number ;
296 [ "USING: math sequences ;\nIN: prettyprint.tests\nINTERSECTION: intersection-see-test sequence number ;\n" ] [
297 [ \ intersection-see-test see ] with-string-writer
300 [ ] [ \ compose see ] unit-test
301 [ ] [ \ curry see ] unit-test
303 [ "POSTPONE: [" ] [ \ [ unparse ] unit-test
305 TUPLE: started-out-hustlin' ;
307 GENERIC: ended-up-ballin' ( a -- b )
309 M: started-out-hustlin' ended-up-ballin' ; inline
311 [ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" ] [
312 [ M\ started-out-hustlin' ended-up-ballin' see ] with-string-writer
315 TUPLE: tuple-with-declared-slot { x integer } ;
320 "IN: prettyprint.tests"
321 "TUPLE: tuple-with-declared-slot { x integer initial: 0 } ;"
325 [ \ tuple-with-declared-slot see ] with-string-writer "\n" split
328 TUPLE: tuple-with-read-only-slot { x read-only } ;
332 "IN: prettyprint.tests"
333 "TUPLE: tuple-with-read-only-slot { x read-only } ;"
337 [ \ tuple-with-read-only-slot see ] with-string-writer "\n" split
340 TUPLE: tuple-with-initial-slot { x initial: 123 } ;
344 "IN: prettyprint.tests"
345 "TUPLE: tuple-with-initial-slot { x initial: 123 } ;"
349 [ \ tuple-with-initial-slot see ] with-string-writer "\n" split
352 TUPLE: tuple-with-initial-declared-slot { x integer initial: 123 } ;
357 "IN: prettyprint.tests"
358 "TUPLE: tuple-with-initial-declared-slot"
359 " { x integer initial: 123 } ;"
363 [ \ tuple-with-initial-declared-slot see ] with-string-writer "\n" split
366 TUPLE: final-tuple ; final
370 "IN: prettyprint.tests"
371 "TUPLE: final-tuple ; final"
375 [ \ final-tuple see ] with-string-writer "\n" split