/core/effects/effects-tests.factor

http://github.com/abeaumont/factor · Factor · 56 lines · 44 code · 11 blank · 1 comment · 0 complexity · efd22d14c060eed428b19f33dba58476 MD5 · raw file 

    

  1. USING: effects effects.parser eval kernel tools.test prettyprint accessors
    2. 

  2. quotations sequences ;
    3. 

  3. IN: effects.tests
    4. 

  4. 

  5. [ t ] [ { "a" } { "a" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
    6. 

  6. [ f ] [ { "a" } { } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
    7. 

  7. [ t ] [ { "a" "b" } { "a" "b" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
    8. 

  8. [ f ] [ { "a" "b" "c" } { "a" "b" "c" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
    9. 

  9. [ f ] [ { "a" "b" } { "a" "b" "c" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
    10. 

  10. [ 2 ] [ ( a b -- c ) in>> length ] unit-test
    11. 

  11. [ 1 ] [ ( a b -- c ) out>> length ] unit-test
    12. 

  12. 

  13. [ t ] [ ( a b -- c ) ( ... a b -- ... c ) effect<= ] unit-test
    14. 

  14. [ t ] [ ( b -- ) ( ... a b -- ... c ) effect<= ] unit-test
    15. 

  15. [ f ] [ ( ... a b -- ... c ) ( a b -- c ) effect<= ] unit-test
    16. 

  16. [ f ] [ ( ... b -- ... ) ( a b -- c ) effect<= ] unit-test
    17. 

  17. [ f ] [ ( a b -- c ) ( ... a b -- c ) effect<= ] unit-test
    18. 

  18. [ f ] [ ( a b -- c ) ( ..x a b -- ..y c ) effect<= ] unit-test
    19. 

  19. 

  20. [ "( object -- object )" ] [ { f } { f } <effect> unparse ] unit-test
    21. 

  21. [ "( a b -- c d )" ] [ { "a" "b" } { "c" "d" } <effect> unparse ] unit-test
    22. 

  22. [ "( -- c d )" ] [ { } { "c" "d" } <effect> unparse ] unit-test
    23. 

  23. [ "( a b -- )" ] [ { "a" "b" } { } <effect> unparse ] unit-test
    24. 

  24. [ "( -- )" ] [ { } { } <effect> unparse ] unit-test
    25. 

  25. [ "( a b -- c )" ] [ ( a b -- c ) unparse ] unit-test
    26. 

  26. 

  27. [ { "x" "y" } ] [ { "y" "x" } ( a b -- b a ) shuffle ] unit-test
    28. 

  28. [ { "y" "x" "y" } ] [ { "y" "x" } ( a b -- a b a ) shuffle ] unit-test
    29. 

  29. [ { } ] [ { "y" "x" } ( a b -- ) shuffle ] unit-test
    30. 

  30. 

  31. [ t ] [ ( -- ) ( -- ) compose-effects ( -- ) effect= ] unit-test
    32. 

  32. [ t ] [ ( -- * ) ( -- ) compose-effects ( -- * ) effect= ] unit-test
    33. 

  33. [ t ] [ ( -- ) ( -- * ) compose-effects ( -- * ) effect= ] unit-test
    34. 

  34. 

  35. [ { object object } ] [ ( a b -- ) effect-in-types ] unit-test
    36. 

  36. [ { object sequence } ] [ ( a b: sequence -- ) effect-in-types ] unit-test
    37. 

  37. 

  38. [ f   ] [ ( a b c -- d ) in-var>> ] unit-test
    39. 

  39. [ f   ] [ ( -- d ) in-var>> ] unit-test
    40. 

  40. [ "a" ] [ ( ..a b c -- d ) in-var>> ] unit-test
    41. 

  41. [ { "b" "c" } ] [ ( ..a b c -- d ) in>> ] unit-test
    42. 

  42. 

  43. [ f   ] [ ( ..a b c -- e ) out-var>> ] unit-test
    44. 

  44. [ "d" ] [ ( ..a b c -- ..d e ) out-var>> ] unit-test
    45. 

  45. [ { "e" } ] [ ( ..a b c -- ..d e ) out>> ] unit-test
    46. 

  46. 

  47. [ "( a ..b c -- d )" eval( -- effect ) ]
    48. 

  48. [ error>> invalid-row-variable? ] must-fail-with
    49. 

  49. 

  50. [ "( ..a: integer b c -- d )" eval( -- effect ) ]
    51. 

  51. [ error>> row-variable-can't-have-type? ] must-fail-with
    52. 

    53. 

  53. ! test curry-effect
    54. 

  54. [ ( -- x ) ] [ ( c -- d ) curry-effect ] unit-test
    55. 

  55. [ ( -- x x ) ] [ ( -- d ) curry-effect ] unit-test
    56. 

  56. [ ( x -- ) ] [ ( a b -- ) curry-effect ] unit-test
    57.