extra/cursors/cursors-tests.factor

   1 ! (c)2010 Joe Groff bsd license
   2 USING: accessors cursors kernel make math sequences sorting tools.test ;
   3 FROM: cursors => each map assoc-each assoc>map ;
   4 IN: cursors.tests
   5
   6 [ { 1 2 3 4 } ] [
   7     [ T{ linear-cursor f 1 1 } T{ linear-cursor f 5 1 } [ value>> , ] -each ]
   8     { } make
   9 ] unit-test
  10
  11 [ T{ linear-cursor f 3 1 } ] [
  12     T{ linear-cursor f 1 1 } T{ linear-cursor f 5 1 } [ value>> 3 mod zero? ] -find
  13 ] unit-test
  14
  15 [ T{ linear-cursor f 5 1 } ] [
  16     T{ linear-cursor f 1 1 } T{ linear-cursor f 5 1 } [ value>> 6 = ] -find
  17 ] unit-test
  18
  19 [ { 1 3 } ] [
  20     [ T{ linear-cursor f 1 2 } T{ linear-cursor f 5 2 } [ value>> , ] -each ]
  21     { } make
  22 ] unit-test
  23
  24 [ B{ 1 2 3 4 5 } ] [ [ { 1 2 3 4 5 } [ , ] each ] B{ } make ] unit-test
  25 [ B{ } ] [ [ { } [ , ] each ] B{ } make ] unit-test
  26 [ { 2 4 6 8 10 } ] [ { 1 2 3 4 5 } [ 2 * ] map ] unit-test
  27
  28 [ { "roses: lutefisk" "tulips: lox" } ]
  29 [
  30     [
  31         H{ { "roses" "lutefisk" } { "tulips" "lox" } }
  32         [ ": " glue , ] assoc-each
  33     ] { } make natural-sort
  34 ] unit-test
  35
  36 [ { "roses: lutefisk" "tulips: lox" } ]
  37 [
  38     H{ { "roses" "lutefisk" } { "tulips" "lox" } }
  39     [ ": " glue ] { } assoc>map natural-sort
  40 ] unit-test
  41
  42 : compile-test-each ( xs -- )
  43     [ , ] each ;
  44
  45 : compile-test-map ( xs -- ys )
  46     [ 2 * ] map ;
  47
  48 : compile-test-assoc-each ( xs -- )
  49     [ ": " glue , ] assoc-each ;
  50
  51 : compile-test-assoc>map ( xs -- ys )
  52     [ ": " glue ] { } assoc>map ;
  53
  54 [ B{ 1 2 3 4 5 } ] [ [ { 1 2 3 4 5 } compile-test-each ] B{ } make ] unit-test
  55 [ { 2 4 6 8 10 } ] [ { 1 2 3 4 5 } compile-test-map ] unit-test
  56
  57 [ { "roses: lutefisk" "tulips: lox" } ]
  58 [
  59     [ H{ { "roses" "lutefisk" } { "tulips" "lox" } } compile-test-assoc-each ]
  60     { } make natural-sort
  61 ] unit-test
  62
  63 [ { "roses: lutefisk" "tulips: lox" } ]
  64 [
  65     H{ { "roses" "lutefisk" } { "tulips" "lox" } } compile-test-assoc>map
  66     natural-sort
  67 ] unit-test
  68