basis/dlists/dlists-tests.factor

   1 USING: deques dlists dlists.private kernel tools.test random
   2 assocs sets sequences namespaces sorting debugger io prettyprint
   3 math accessors classes ;
   4 IN: dlists.tests
   5
   6 [ t ] [ <dlist> deque-empty? ] unit-test
   7
   8 [ T{ dlist f T{ dlist-node f 1 f f } T{ dlist-node f 1 f f } } ]
   9 [ <dlist> 1 over push-front ] unit-test
  10
  11 ! Make sure empty lists are empty
  12 [ t ] [ <dlist> deque-empty? ] unit-test
  13 [ f ] [ <dlist> 1 over push-front deque-empty? ] unit-test
  14 [ f ] [ <dlist> 1 over push-back deque-empty? ] unit-test
  15
  16 [ 1 ] [ <dlist> 1 over push-front pop-front ] unit-test
  17 [ 1 ] [ <dlist> 1 over push-front pop-back ] unit-test
  18 [ 1 ] [ <dlist> 1 over push-back pop-front ] unit-test
  19 [ 1 ] [ <dlist> 1 over push-back pop-back ] unit-test
  20 [ T{ dlist f f f } ] [ <dlist> 1 over push-front dup pop-front* ] unit-test
  21 [ T{ dlist f f f } ] [ <dlist> 1 over push-front dup pop-back* ] unit-test
  22 [ T{ dlist f f f } ] [ <dlist> 1 over push-back dup pop-front* ] unit-test
  23 [ T{ dlist f f f } ] [ <dlist> 1 over push-back dup pop-back* ] unit-test
  24
  25 ! Test the prev,next links for two nodes
  26 [ f ] [
  27     <dlist> 1 over push-back 2 over push-back
  28     front>> prev>>
  29 ] unit-test
  30
  31 [ 2 ] [
  32     <dlist> 1 over push-back 2 over push-back
  33     front>> next>> obj>>
  34 ] unit-test
  35
  36 [ 1 ] [
  37     <dlist> 1 over push-back 2 over push-back
  38     front>> next>> prev>> obj>>
  39 ] unit-test
  40
  41 [ f ] [
  42     <dlist> 1 over push-back 2 over push-back
  43     front>> next>> next>>
  44 ] unit-test
  45
  46 [ f f ] [ <dlist> [ 1 = ] dlist-find ] unit-test
  47 [ 1 t ] [ <dlist> 1 over push-back [ 1 = ] dlist-find ] unit-test
  48 [ f f ] [ <dlist> 1 over push-back [ 2 = ] dlist-find ] unit-test
  49 [ f ] [ <dlist> 1 over push-back [ 2 = ] dlist-any? ] unit-test
  50 [ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-any? ] unit-test
  51
  52 [ 1 ] [ <dlist> 1 over push-back [ 1 = ] delete-node-if ] unit-test
  53 [ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test
  54 [ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test
  55
  56 [ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 4 = ] dlist-find-node drop class dlist-node = ] unit-test
  57 [ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 5 = ] dlist-find-node drop class dlist-node = ] unit-test
  58 [ t ] [ <dlist> 4 over push-back 5 over push-back* [ = ] curry dlist-find-node drop class dlist-node = ] unit-test
  59 [ ] [ <dlist> 4 over push-back 5 over push-back [ drop ] dlist-each ] unit-test
  60
  61 [ <dlist> peek-front ] [ empty-dlist? ] must-fail-with
  62 [ <dlist> peek-back ] [ empty-dlist? ] must-fail-with
  63 [ <dlist> pop-front ] [ empty-dlist? ] must-fail-with
  64 [ <dlist> pop-back ] [ empty-dlist? ] must-fail-with
  65
  66 [ t ] [ <dlist> 3 over push-front 4 over push-back 3 swap deque-member? ] unit-test
  67
  68 [ f ] [ <dlist> 3 over push-front 4 over push-back -1 swap deque-member? ] unit-test
  69
  70 [ f ] [ <dlist> 0 swap deque-member? ] unit-test
  71
  72 ! Make sure clone does the right thing
  73 [ V{ 2 1 } V{ 2 1 3 } ] [
  74     <dlist> 1 over push-front 2 over push-front
  75     dup clone 3 over push-back
  76     [ dlist>seq ] bi@
  77 ] unit-test
  78
  79 [ V{ f 3 1 f } ] [ <dlist> 1 over push-front 3 over push-front f over push-front f over push-back dlist>seq ] unit-test
  80
  81 [ V{ } ] [ <dlist> dlist>seq ] unit-test
  82
  83 [ V{ 0 2 4 } ] [ <dlist> { 0 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test
  84 [ V{ 2 4 } ] [ <dlist> { 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test
  85 [ V{ 2 4 } ] [ <dlist> { 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test
  86 [ V{ 0 2 4 } ] [ <dlist> { 0 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test