basis/dlists/dlists-tests.factor

   1 USING: accessors arrays classes deques dlists kernel locals
   2 math sequences tools.test ;
   3 IN: dlists.tests
   4
   5 { t } [ <dlist> deque-empty? ] unit-test
   6
   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
   9
  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
  14
  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
  23
  24 ! Test the prev,next links for two nodes
  25 { f } [
  26     <dlist> 1 over push-back 2 over push-back
  27     front>> prev>>
  28 ] unit-test
  29
  30 { 2 } [
  31     <dlist> 1 over push-back 2 over push-back
  32     front>> next>> obj>>
  33 ] unit-test
  34
  35 { 1 } [
  36     <dlist> 1 over push-back 2 over push-back
  37     front>> next>> prev>> obj>>
  38 ] unit-test
  39
  40 { f } [
  41     <dlist> 1 over push-back 2 over push-back
  42     front>> next>> next>>
  43 ] unit-test
  44
  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
  50
  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
  54
  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
  59
  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
  64
  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
  69
  70 { t } [ <dlist> 3 over push-front 4 over push-back 3 swap deque-member? ] unit-test
  71
  72 { f } [ <dlist> 3 over push-front 4 over push-back -1 swap deque-member? ] unit-test
  73
  74 { f } [ <dlist> 0 swap deque-member? ] unit-test
  75
  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@
  81 ] unit-test
  82
  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
  84
  85 { V{ } } [ <dlist> dlist>sequence ] unit-test
  86
  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
  91
  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
 102
 103 TUPLE: my-node < dlist-link { obj fixnum } ;
 104
 105 : <my-node> ( obj -- node )
 106     my-node new
 107         swap >>obj ; inline
 108
 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
 111
 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
 115
 116 : assert-links ( dlist-node -- )
 117     [ prev>> ] [ next>> ] bi 2array { f f } assert= ;
 118
 119 { V{ } } [ <dlist> 1 <my-node> over push-node-back [ [ back>> ] [ ] bi delete-node ] [ ] bi dlist>sequence ] unit-test
 120 [ V{ 1 2 } t ] [| |
 121     <dlist> :> dl
 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
 125
 126     n3 dl delete-node n3 assert-links
 127     dl dlist>sequence dup >dlist dl =
 128 ] unit-test
 129
 130 [ V{ 1 3 } t ] [| |
 131     <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
 135
 136     n2 dl delete-node n2 assert-links
 137     dl dlist>sequence dup >dlist dl =
 138 ] unit-test
 139
 140 [ V{ 2 3 } t ] [| |
 141     <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
 145
 146     n1 dl delete-node n1 assert-links
 147     dl dlist>sequence dup >dlist dl =
 148 ] unit-test
 149
 150
 151 { DL{ 0 1 2 3 4 } } [
 152     <dlist> [
 153         { 3 2 4 1 0 } [ swap push-sorted drop ] with each
 154     ] keep
 155 ] unit-test
 156
 157 { 0 5 } [
 158     <dlist> dlist-length
 159     { 3 4 9 1 7 } >dlist dlist-length
 160 ] unit-test