extra/shuffle/extras/extras-tests.factor

   1 ! Copyright (C) 2022 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel math modern.slices shuffle.extras tools.test ;
   4 IN: shuffle.extras.tests
   5
   6 { 2 3 4 5 6 1 } [ 1 2 3 4 5 6 6roll ] unit-test
   7 { 2 3 4 5 6 7 1 } [ 1 2 3 4 5 6 7 7roll ] unit-test
   8 { 2 3 4 5 6 7 8 1 } [ 1 2 3 4 5 6 7 8 8roll ] unit-test
   9
  10 { 1 2 3 } [ 1 2 [ 3 ] dip-1up ] unit-test
  11 { 2 2 } [ 1 2 [ 1 + ] dip-1up ] unit-test
  12 { 20 11 } [ 10 20 [ 1 + ] dip-1up ] unit-test
  13
  14 { 0 10 20 30 40 50 60 80 71 } [ 0 10 20 30 40 50 60 70 80 [ 1 + ]  dip-1up ] unit-test
  15 { 0 10 20 30 40 50 70 80 61 } [ 0 10 20 30 40 50 60 70 80 [ 1 + ] 2dip-1up ] unit-test
  16 { 0 10 20 30 40 60 70 80 51 } [ 0 10 20 30 40 50 60 70 80 [ 1 + ] 3dip-1up ] unit-test
  17
  18
  19 { 0 10 20 30 40 50 80 61 71 } [ 0 10 20 30 40 50 60 70 80 [ [ 1 + ] bi@ ]  dip-2up ] unit-test
  20 { 0 10 20 30 40 70 80 51 61 } [ 0 10 20 30 40 50 60 70 80 [ [ 1 + ] bi@ ] 2dip-2up ] unit-test
  21 { 0 10 20 30 60 70 80 41 51 } [ 0 10 20 30 40 50 60 70 80 [ [ 1 + ] bi@ ] 3dip-2up ] unit-test
  22
  23 { 0 10 20 60 70 80 31 41 51 } [ 0 10 20 30 40 50 60 70 80 [ [ 1 + ] tri@ ] 3dip-3up ] unit-test
  24
  25 { 4 "abcd" 97 98 99 100 } [
  26     0 "abcd"
  27     [ [ CHAR: a = ] accept1 ]
  28     [ [ CHAR: b = ] accept1 ]
  29     [ [ CHAR: c = ] accept1 ]
  30     [ [ CHAR: d = ] accept1 ] 4craft-1up
  31 ] unit-test
  32
  33 ! : test-keep-under ( -- a b c d e ) 1 [ [ 5 + ] call 10 20 30 ] keep-under ;
  34 ! : test-2keep-under ( -- a b c d e f g ) 1 2 [ [ 5 + ] bi@ 10 20 30 ] 2keep-under ;
  35 ! : test-3keep-under ( -- a b c d e f g h i ) 1 2 3 [ [ 5 + ] tri@ 10 20 30 ] 3keep-under ;
  36
  37 ! { 1 6 10 20 30 } [ test-keep-under ] unit-test
  38 ! { 1 2 6 7 10 20 30 } [ test-2keep-under ] unit-test
  39 ! { 1 2 3 6 7 8 10 20 30 } [ test-3keep-under ] unit-test
  40
  41 { 20 30 2500 } [ 20 30 [ + sq ] 2keep-1up ] unit-test
  42
  43 { 10 1 } [ 10 [ drop 1 ] keep-1up ] unit-test
  44 { 10 20 1 } [ 10 20 [ 2drop 1 ] 2keep-1up ] unit-test
  45 { 10 20 30 1 } [ 10 20 30 [ 3drop 1 ] 3keep-1up ] unit-test
  46
  47
  48 { 10 1 } [ 10 [ drop 1 ] keep-1up ] unit-test
  49 { 10 20 1 } [ 10 20 [ 2drop 1 ] 2keep-1up ] unit-test
  50 { 10 20 30 1 } [ 10 20 30 [ 3drop 1 ] 3keep-1up ] unit-test
  51
  52 { 10 1 2 } [ 10 [ drop 1 2 ] keep-2up ] unit-test
  53 { 10 20 1 2 } [ 10 20 [ 2drop 1 2 ] 2keep-2up ] unit-test
  54 { 10 20 30 1 2 } [ 10 20 30 [ 3drop 1 2 ] 3keep-2up ] unit-test
  55
  56 { 10 1 2 3 } [ 10 [ drop 1 2 3 ] keep-3up ] unit-test
  57 { 10 20 1 2 3 } [ 10 20 [ 2drop 1 2 3 ] 2keep-3up ] unit-test
  58 { 10 20 30 1 2 3 } [ 10 20 30 [ 3drop 1 2 3 ] 3keep-3up ] unit-test