/core/classes/tuple/parser/parser-tests.factor

http://github.com/abeaumont/factor · Factor · 163 lines · 118 code · 43 blank · 2 comment · 1 complexity · 528e8012a19f78436e910457fa727614 MD5 · raw file

  1. USING: accessors classes.tuple.parser lexer words classes
  2. sequences math kernel slots tools.test parser compiler.units
  3. arrays classes.tuple eval multiline ;
  4. IN: classes.tuple.parser.tests
  5. TUPLE: test-1 ;
  6. [ t ] [ test-1 "slots" word-prop empty? ] unit-test
  7. TUPLE: test-2 < test-1 ;
  8. [ t ] [ test-2 "slots" word-prop empty? ] unit-test
  9. [ test-1 ] [ test-2 superclass ] unit-test
  10. TUPLE: test-3 a ;
  11. [ { "a" } ] [ test-3 "slots" word-prop [ name>> ] map ] unit-test
  12. [ object ] [ "a" test-3 "slots" word-prop slot-named class>> ] unit-test
  13. TUPLE: test-4 < test-3 b ;
  14. [ { "b" } ] [ test-4 "slots" word-prop [ name>> ] map ] unit-test
  15. TUPLE: test-5 { a integer } ;
  16. [ { { "a" integer } } ]
  17. [
  18. test-5 "slots" word-prop
  19. [ [ name>> ] [ class>> ] bi 2array ] map
  20. ] unit-test
  21. TUPLE: test-6 < test-5 { b integer } ;
  22. [ integer ] [ "b" test-6 "slots" word-prop slot-named class>> ] unit-test
  23. [ { { "b" integer } } ]
  24. [
  25. test-6 "slots" word-prop
  26. [ [ name>> ] [ class>> ] bi 2array ] map
  27. ] unit-test
  28. TUPLE: test-7 { b integer initial: 3 } ;
  29. [ 3 ] [ "b" test-7 "slots" word-prop slot-named initial>> ] unit-test
  30. TUPLE: test-8 { b integer read-only } ;
  31. [ t ] [ "b" test-8 "slots" word-prop slot-named read-only>> ] unit-test
  32. DEFER: foo
  33. [ "IN: classes.tuple.parser.tests TUPLE: foo < test-1 < ;" eval( -- ) ]
  34. [ error>> invalid-slot-name? ]
  35. must-fail-with
  36. [ "IN: classes.tuple.parser.tests TUPLE: foo :" eval( -- ) ]
  37. [ error>> invalid-slot-name? ]
  38. must-fail-with
  39. [ "IN: classes.tuple.parser.tests TUPLE: foo" eval( -- ) ]
  40. [ error>> unexpected-eof? ]
  41. must-fail-with
  42. 2 [
  43. [ "IN: classes.tuple.parser.tests USE: alien TUPLE: foo { slot dll } ;" eval( -- ) ]
  44. [ error>> bad-initial-value? ]
  45. must-fail-with
  46. [ f ] [ \ foo tuple-class? ] unit-test
  47. ] times
  48. 2 [
  49. [ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo { slot array initial: 5 } ;" eval( -- ) ]
  50. [ error>> bad-initial-value? ]
  51. must-fail-with
  52. [ f ] [ \ foo tuple-class? ] unit-test
  53. ] times
  54. [ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo slot { slot array } ;" eval( -- ) ]
  55. [ error>> duplicate-slot-names? ]
  56. must-fail-with
  57. [ f ] [ \ foo tuple-class? ] unit-test
  58. [ ] [
  59. [
  60. { test-1 test-2 test-3 test-4 test-5 test-6 test-7 test-8 foo }
  61. [ dup class? [ forget-class ] [ drop ] if ] each
  62. ] with-compilation-unit
  63. ] unit-test
  64. TUPLE: syntax-test bar baz ;
  65. [ T{ syntax-test } ] [ T{ syntax-test } ] unit-test
  66. [ T{ syntax-test f { 2 3 } { 4 { 5 } } } ]
  67. [ T{ syntax-test { bar { 2 3 } } { baz { 4 { 5 } } } } ] unit-test
  68. ! Corner case
  69. TUPLE: parsing-corner-case x ;
  70. [ T{ parsing-corner-case f 3 } ] [
  71. {
  72. "USE: classes.tuple.parser.tests"
  73. "T{ parsing-corner-case"
  74. " f"
  75. " 3"
  76. "}"
  77. } "\n" join eval( -- tuple )
  78. ] unit-test
  79. [ T{ parsing-corner-case f 3 } ] [
  80. {
  81. "USE: classes.tuple.parser.tests"
  82. "T{ parsing-corner-case"
  83. " { x 3 }"
  84. "}"
  85. } "\n" join eval( -- tuple )
  86. ] unit-test
  87. [ T{ parsing-corner-case f 3 } ] [
  88. {
  89. "USE: classes.tuple.parser.tests"
  90. "T{ parsing-corner-case {"
  91. " x 3 }"
  92. "}"
  93. } "\n" join eval( -- tuple )
  94. ] unit-test
  95. [
  96. {
  97. "USE: classes.tuple.parser.tests T{ parsing-corner-case"
  98. " { x 3 }"
  99. } "\n" join eval( -- tuple )
  100. ] [ error>> unexpected-eof? ] must-fail-with
  101. [
  102. {
  103. "USE: classes.tuple.parser.tests T{ parsing-corner-case {"
  104. " x 3 }"
  105. } "\n" join eval( -- tuple )
  106. ] [ error>> unexpected-eof? ] must-fail-with
  107. TUPLE: bad-inheritance-tuple ;
  108. [
  109. "IN: classes.tuple.parser.tests TUPLE: bad-inheritance-tuple < bad-inheritance-tuple ;" eval( -- )
  110. ] [ error>> bad-inheritance? ] must-fail-with
  111. TUPLE: bad-inheritance-tuple2 ;
  112. TUPLE: bad-inheritance-tuple3 < bad-inheritance-tuple2 ;
  113. [
  114. "IN: classes.tuple.parser.tests TUPLE: bad-inheritance-tuple2 < bad-inheritance-tuple3 ;" eval( -- )
  115. ] [ error>> bad-inheritance? ] must-fail-with
  116. ! This must not fail
  117. TUPLE: tup ;
  118. UNION: u tup ;
  119. [ ] [ "IN: classes.tuple.parser.tests TUPLE: u < tup ;" eval( -- ) ] unit-test
  120. [ t ] [ u new tup? ] unit-test