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

   1 IN: classes.tuple.parser.tests
   2 USING: accessors classes.tuple.parser lexer words classes
   3 sequences math kernel slots tools.test parser compiler.units ;
   4
   5 TUPLE: test-1 ;
   6
   7 [ t ] [ test-1 "slot-names" word-prop empty? ] unit-test
   8
   9 TUPLE: test-2 < test-1 ;
  10
  11 [ t ] [ test-2 "slot-names" word-prop empty? ] unit-test
  12 [ test-1 ] [ test-2 superclass ] unit-test
  13
  14 TUPLE: test-3 a ;
  15
  16 [ { "a" } ] [ test-3 "slot-names" word-prop ] unit-test
  17
  18 [ object ] [ "a" test-3 "slots" word-prop slot-named class>> ] unit-test
  19
  20 TUPLE: test-4 < test-3 b ;
  21
  22 [ { "b" } ] [ test-4 "slot-names" word-prop ] unit-test
  23
  24 TUPLE: test-5 { a integer } ;
  25
  26 [ { { "a" integer } } ] [ test-5 "slot-names" word-prop ] unit-test
  27
  28 TUPLE: test-6 < test-5 { b integer } ;
  29
  30 [ integer ] [ "b" test-6 "slots" word-prop slot-named class>> ] unit-test
  31
  32 [ { { "b" integer } } ] [ test-6 "slot-names" word-prop ] unit-test
  33
  34 TUPLE: test-7 { b integer initial: 3 } ;
  35
  36 [ 3 ] [ "b" test-7 "slots" word-prop slot-named initial>> ] unit-test
  37
  38 TUPLE: test-8 { b integer read-only } ;
  39
  40 [ t ] [ "b" test-8 "slots" word-prop slot-named read-only>> ] unit-test
  41
  42 [ "IN: classes.tuple.parser.tests TUPLE: foo < test-1 < ;" eval ]
  43 [ error>> invalid-slot-name? ]
  44 must-fail-with
  45
  46 [ "IN: classes.tuple.parser.tests TUPLE: foo :" eval ]
  47 [ error>> invalid-slot-name? ]
  48 must-fail-with
  49
  50 [ "IN: classes.tuple.parser.tests TUPLE: foo" eval ]
  51 [ error>> unexpected-eof? ]
  52 must-fail-with
  53
  54 [ "IN: classes.tuple.parser.tests USE: generic.standard TUPLE: foo { slot no-method } ;" eval ]
  55 [ error>> no-initial-value? ]
  56 must-fail-with
  57
  58 [ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo { slot array initial: 5 } ;" eval ]
  59 [ error>> bad-initial-value? ]
  60 must-fail-with
  61
  62 [ ] [
  63     [
  64         { test-1 test-2 test-3 test-4 test-5 test-6 test-7 test-8 }
  65         [ dup class? [ forget-class ] [ drop ] if ] each
  66     ] with-compilation-unit
  67 ] unit-test