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

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