/core/words/words-tests.factor

http://github.com/abeaumont/factor · Factor · 137 lines · 97 code · 36 blank · 4 comment · 7 complexity · 3cc05797c40a0a97a3838a4ad8d502ec MD5 · raw file

  1. USING: arrays generic assocs kernel math namespaces
  2. sequences tools.test words definitions parser quotations
  3. vocabs continuations classes.tuple compiler.units
  4. io.streams.string accessors eval words.symbol grouping ;
  5. IN: words.tests
  6. [ 4 ] [
  7. [
  8. "poo" "words.tests" create [ 2 2 + ] ( -- n ) define-declared
  9. ] with-compilation-unit
  10. "poo" "words.tests" lookup-word execute
  11. ] unit-test
  12. [ t ] [ t vocabs [ words [ word? and ] each ] each ] unit-test
  13. DEFER: plist-test
  14. [ t ] [
  15. \ plist-test t "sample-property" set-word-prop
  16. \ plist-test "sample-property" word-prop
  17. ] unit-test
  18. [ f ] [
  19. \ plist-test f "sample-property" set-word-prop
  20. \ plist-test "sample-property" word-prop
  21. ] unit-test
  22. [ ] [ [ "create-test" "scratchpad" create { 1 2 } "testing" set-word-prop ] with-compilation-unit ] unit-test
  23. [ { 1 2 } ] [
  24. "create-test" "scratchpad" lookup-word "testing" word-prop
  25. ] unit-test
  26. [
  27. [ t ] [ \ array? "array?" "arrays" lookup-word = ] unit-test
  28. [ ] [ [ "test-scope" "scratchpad" create drop ] with-compilation-unit ] unit-test
  29. ] with-scope
  30. [ "test-scope" ] [
  31. "test-scope" "scratchpad" lookup-word name>>
  32. ] unit-test
  33. [ t ] [ vocabs array? ] unit-test
  34. [ t ] [ vocabs [ words [ word? ] all? ] all? ] unit-test
  35. [ f ] [ gensym gensym = ] unit-test
  36. SYMBOL: a-symbol
  37. [ t ] [ \ a-symbol symbol? ] unit-test
  38. ! See if redefining a generic as a colon def clears some
  39. ! word props.
  40. GENERIC: testing ( a -- b )
  41. "IN: words.tests : testing ( -- ) ;" eval( -- )
  42. [ f ] [ \ testing generic? ] unit-test
  43. : forgotten ( -- ) ;
  44. : another-forgotten ( -- ) ;
  45. FORGET: forgotten
  46. FORGET: another-forgotten
  47. : another-forgotten ( -- ) ;
  48. ! Make sure that undefined words throw proper errors
  49. DEFER: deferred
  50. [ deferred ] [ T{ undefined f deferred } = ] must-fail-with
  51. [ "IN: words.tests DEFER: not-compiled << not-compiled >>" eval( -- ) ]
  52. [ error>> [ undefined? ] [ word>> name>> "not-compiled" = ] bi and ] must-fail-with
  53. [ ] [ "IN: words.tests FORGET: not-compiled" eval( -- ) ] unit-test
  54. [ ] [ [ "no-loc" "words.tests" create drop ] with-compilation-unit ] unit-test
  55. [ f ] [ "no-loc" "words.tests" lookup-word where ] unit-test
  56. [ ] [ "IN: words.tests : no-loc-2 ( -- ) ;" eval( -- ) ] unit-test
  57. [ f ] [ "no-loc-2" "words.tests" lookup-word where ] unit-test
  58. [ ] [ "IN: words.tests : test-last ( -- ) ;" eval( -- ) ] unit-test
  59. [ "test-last" ] [ word name>> ] unit-test
  60. "undef-test" "words.tests" lookup-word [
  61. [ forget ] with-compilation-unit
  62. ] when*
  63. [ "IN: words.tests : undef-test ( -- ) ; << undef-test >>" eval( -- ) ]
  64. [ error>> undefined? ] must-fail-with
  65. [ ] [
  66. "IN: words.tests GENERIC: symbol-generic ( -- )" eval( -- )
  67. ] unit-test
  68. [ ] [
  69. "IN: words.tests SYMBOL: symbol-generic" eval( -- )
  70. ] unit-test
  71. [ t ] [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
  72. [ f ] [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
  73. [ ] [
  74. "IN: words.tests GENERIC: symbol-generic ( a -- b )" <string-reader>
  75. "symbol-generic-test" parse-stream drop
  76. ] unit-test
  77. [ ] [
  78. "IN: words.tests TUPLE: symbol-generic ;" <string-reader>
  79. "symbol-generic-test" parse-stream drop
  80. ] unit-test
  81. [ t ] [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
  82. [ f ] [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
  83. ! Regressions
  84. [ ] [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" eval( -- ) ] unit-test
  85. [ t ] [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
  86. [ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
  87. [ f ] [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
  88. [ ] [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" eval( -- ) ] unit-test
  89. [ t ] [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
  90. [ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
  91. [ f ] [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
  92. [ { } ]
  93. [
  94. all-words [
  95. [ "effect-dependencies" word-prop ]
  96. [ "definition-dependencies" word-prop ]
  97. [ "conditional-dependencies" word-prop ] tri
  98. 3append [ "forgotten" word-prop ] filter
  99. ] map harvest
  100. ] unit-test
  101. [ "hi" word-code ] must-fail