1 USING: accessors arrays classes deques dlists kernel locals
2 math sequences tools.test ;
5 [ t ] [ <dlist> deque-empty? ] unit-test
7 [ T{ dlist f T{ dlist-node f f f 1 } T{ dlist-node f f f 1 } } ]
8 [ <dlist> 1 over push-front ] unit-test
10 ! Make sure empty lists are empty
11 [ t ] [ <dlist> deque-empty? ] unit-test
12 [ f ] [ <dlist> 1 over push-front deque-empty? ] unit-test
13 [ f ] [ <dlist> 1 over push-back deque-empty? ] unit-test
15 [ 1 ] [ <dlist> 1 over push-front pop-front ] unit-test
16 [ 1 ] [ <dlist> 1 over push-front pop-back ] unit-test
17 [ 1 ] [ <dlist> 1 over push-back pop-front ] unit-test
18 [ 1 ] [ <dlist> 1 over push-back pop-back ] unit-test
19 [ T{ dlist f f f } ] [ <dlist> 1 over push-front dup pop-front* ] unit-test
20 [ T{ dlist f f f } ] [ <dlist> 1 over push-front dup pop-back* ] unit-test
21 [ T{ dlist f f f } ] [ <dlist> 1 over push-back dup pop-front* ] unit-test
22 [ T{ dlist f f f } ] [ <dlist> 1 over push-back dup pop-back* ] unit-test
24 ! Test the prev,next links for two nodes
26 <dlist> 1 over push-back 2 over push-back
31 <dlist> 1 over push-back 2 over push-back
36 <dlist> 1 over push-back 2 over push-back
37 front>> next>> prev>> obj>>
41 <dlist> 1 over push-back 2 over push-back
45 [ f f ] [ <dlist> [ 1 = ] dlist-find ] unit-test
46 [ 1 t ] [ <dlist> 1 over push-back [ 1 = ] dlist-find ] unit-test
47 [ f f ] [ <dlist> 1 over push-back [ 2 = ] dlist-find ] unit-test
48 [ f ] [ <dlist> 1 over push-back [ 2 = ] dlist-any? ] unit-test
49 [ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-any? ] unit-test
51 [ 1 ] [ <dlist> 1 over push-back [ 1 = ] delete-node-if ] unit-test
52 [ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test
53 [ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test
55 [ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 4 = ] dlist-find-node class-of dlist-node = ] unit-test
56 [ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 5 = ] dlist-find-node class-of dlist-node = ] unit-test
57 [ t ] [ <dlist> 4 over push-back 5 over push-back* [ = ] curry dlist-find-node class-of dlist-node = ] unit-test
58 [ ] [ <dlist> 4 over push-back 5 over push-back [ drop ] dlist-each ] unit-test
60 [ f ] [ <dlist> ?peek-front ] unit-test
61 [ 1 ] [ <dlist> 1 over push-front ?peek-front ] unit-test
62 [ f ] [ <dlist> ?peek-back ] unit-test
63 [ 1 ] [ <dlist> 1 over push-back ?peek-back ] unit-test
65 [ <dlist> peek-front ] [ empty-deque? ] must-fail-with
66 [ <dlist> peek-back ] [ empty-deque? ] must-fail-with
67 [ <dlist> pop-front ] [ empty-deque? ] must-fail-with
68 [ <dlist> pop-back ] [ empty-deque? ] must-fail-with
70 [ t ] [ <dlist> 3 over push-front 4 over push-back 3 swap deque-member? ] unit-test
72 [ f ] [ <dlist> 3 over push-front 4 over push-back -1 swap deque-member? ] unit-test
74 [ f ] [ <dlist> 0 swap deque-member? ] unit-test
76 ! Make sure clone does the right thing
77 [ V{ 2 1 } V{ 2 1 3 } ] [
78 <dlist> 1 over push-front 2 over push-front
79 dup clone 3 over push-back
80 [ dlist>sequence ] bi@
83 [ V{ f 3 1 f } ] [ <dlist> 1 over push-front 3 over push-front f over push-front f over push-back dlist>sequence ] unit-test
85 [ V{ } ] [ <dlist> dlist>sequence ] unit-test
87 [ V{ 0 2 4 } ] [ <dlist> { 0 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>sequence ] unit-test
88 [ V{ 2 4 } ] [ <dlist> { 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>sequence ] unit-test
89 [ V{ 2 4 } ] [ <dlist> { 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>sequence ] unit-test
90 [ V{ 0 2 4 } ] [ <dlist> { 0 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>sequence ] unit-test
92 [ t ] [ DL{ } DL{ } = ] unit-test
93 [ t ] [ DL{ 1 } DL{ 1 } = ] unit-test
94 [ t ] [ DL{ 1 2 } DL{ 1 2 } = ] unit-test
95 [ t ] [ DL{ 1 1 } DL{ 1 1 } = ] unit-test
96 [ f ] [ DL{ 1 2 3 } DL{ 1 2 } = ] unit-test
97 [ f ] [ DL{ 1 2 } DL{ 1 2 3 } = ] unit-test
98 [ f ] [ DL{ } DL{ 1 } = ] unit-test
99 [ f ] [ DL{ f } DL{ 1 } = ] unit-test
100 [ f ] [ f DL{ } = ] unit-test
101 [ f ] [ DL{ } f = ] unit-test
103 TUPLE: my-node < dlist-link { obj fixnum } ;
105 : <my-node> ( obj -- node )
109 [ V{ 1 } ] [ <dlist> 1 <my-node> over push-node-front dlist>sequence ] unit-test
110 [ V{ 2 1 } ] [ <dlist> 1 <my-node> over push-node-front 2 <my-node> over push-node-front dlist>sequence ] unit-test
112 [ V{ 1 } ] [ <dlist> 1 <my-node> over push-node-back dlist>sequence ] unit-test
113 [ V{ 1 2 } ] [ <dlist> 1 <my-node> over push-node-back 2 <my-node> over push-node-back dlist>sequence ] unit-test
114 [ V{ 1 2 3 } ] [ <dlist> 1 <my-node> over push-node-back 2 <my-node> over push-node-back 3 <my-node> over push-node-back dlist>sequence ] unit-test
116 : assert-links ( dlist-node -- )
117 [ prev>> ] [ next>> ] bi 2array { f f } assert= ;
119 [ V{ } ] [ <dlist> 1 <my-node> over push-node-back [ [ back>> ] [ ] bi delete-node ] [ ] bi dlist>sequence ] unit-test
122 1 <my-node> :> n1 n1 dl push-node-back
123 2 <my-node> :> n2 n2 dl push-node-back
124 3 <my-node> :> n3 n3 dl push-node-back
126 n3 dl delete-node n3 assert-links
127 dl dlist>sequence dup >dlist dl =
132 1 <my-node> :> n1 n1 dl push-node-back
133 2 <my-node> :> n2 n2 dl push-node-back
134 3 <my-node> :> n3 n3 dl push-node-back
136 n2 dl delete-node n2 assert-links
137 dl dlist>sequence dup >dlist dl =
142 1 <my-node> :> n1 n1 dl push-node-back
143 2 <my-node> :> n2 n2 dl push-node-back
144 3 <my-node> :> n3 n3 dl push-node-back
146 n1 dl delete-node n1 assert-links
147 dl dlist>sequence dup >dlist dl =
151 { DL{ 0 1 2 3 4 } } [
153 { 3 2 4 1 0 } [ swap push-sorted drop ] with each