1 IN: compiler.cfg.builder.tests
2 USING: tools.test kernel sequences words sequences.private fry
3 prettyprint alien alien.accessors math.private compiler.tree.builder
4 compiler.tree.optimizer compiler.cfg.builder compiler.cfg.debugger
5 compiler.cfg.optimizer compiler.cfg.predecessors compiler.cfg.checker
6 arrays locals byte-arrays kernel.private math slots.private ;
8 ! Just ensure that various CFGs build correctly.
9 : unit-test-cfg ( quot -- )
10 '[ _ test-cfg [ optimize-cfg check-cfg ] each ] [ ] swap unit-test ;
12 : blahblah ( nodes -- ? )
14 dup 3 bitand 1 = [ drop t ] [
19 ] any? ; inline recursive
31 [ 3 swap fixnum*fast ]
33 [ 10 fixnum-shift-fast ]
34 [ -10 fixnum-shift-fast ]
35 [ 0 fixnum-shift-fast ]
36 [ 10 swap fixnum-shift-fast ]
37 [ -10 swap fixnum-shift-fast ]
38 [ 0 swap fixnum-shift-fast ]
53 [ fixnum< [ 1 ] [ 2 ] if ]
54 [ float+ [ 2.0 float* ] [ 3.0 float* ] bi float/f ]
55 [ { [ 1 ] [ 2 ] [ 3 ] } dispatch ]
58 [ [ 2 ] [ 3 throw ] if 4 ]
59 [ "int" f "malloc" { "int" } alien-invoke ]
60 [ "int" { "int" } "cdecl" alien-indirect ]
61 [ "int" { "int" } "cdecl" [ ] alien-callback ]
69 : test-1 ( -- ) test-1 ;
70 : test-2 ( -- ) 3 . test-2 ;
71 : test-3 ( a -- b ) dup [ test-3 ] when ;
77 } [ unit-test-cfg ] each
96 { class } word '[ _ declare 10 _ execute ] unit-test-cfg
97 { class fixnum } word '[ _ declare _ execute ] unit-test-cfg
108 { fixnum class } word '[ _ declare 10 _ execute ] unit-test-cfg
109 { fixnum class fixnum } word '[ _ declare _ execute ] unit-test-cfg
112 { float class } \ set-alien-float '[ _ declare 10 _ execute ] unit-test-cfg
113 { float class fixnum } \ set-alien-float '[ _ declare _ execute ] unit-test-cfg
115 { float class } \ set-alien-double '[ _ declare 10 _ execute ] unit-test-cfg
116 { float class fixnum } \ set-alien-double '[ _ declare _ execute ] unit-test-cfg
118 { pinned-c-ptr class } \ set-alien-cell '[ _ declare 10 _ execute ] unit-test-cfg
119 { pinned-c-ptr class fixnum } \ set-alien-cell '[ _ declare _ execute ] unit-test-cfg