basis/constructors/constructors-tests.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors calendar combinators.short-circuit
   4 constructors eval kernel math strings tools.test ;
   5 IN: constructors.tests
   6
   7 TUPLE: stock-spread stock spread timestamp ;
   8
   9 CONSTRUCTOR: <stock-spread> stock-spread ( stock spread -- stock-spread )
  10    now >>timestamp ;
  11
  12 SYMBOL: AAPL
  13
  14 { t } [
  15     AAPL 1234 <stock-spread>
  16     {
  17         [ stock>> AAPL eq? ]
  18         [ spread>> 1234 = ]
  19         [ timestamp>> timestamp? ]
  20     } 1&&
  21 ] unit-test
  22
  23 TUPLE: ct1 a ;
  24 TUPLE: ct2 < ct1 b ;
  25 TUPLE: ct3 < ct2 c ;
  26 TUPLE: ct4 < ct3 d ;
  27
  28 CONSTRUCTOR: <ct1> ct1 ( a -- obj ) ;
  29
  30 CONSTRUCTOR: <ct2> ct2 ( a b -- obj ) ;
  31
  32 CONSTRUCTOR: <ct3> ct3 ( a b c -- obj ) ;
  33
  34 CONSTRUCTOR: <ct4> ct4 ( a b c d -- obj ) ;
  35
  36 { 1000 } [ 1000 <ct1> a>> ] unit-test
  37 { 0 } [ 0 0 <ct2> a>> ] unit-test
  38 { 0 } [ 0 0 0 <ct3> a>> ] unit-test
  39 { 0 } [ 0 0 0 0 <ct4> a>> ] unit-test
  40
  41
  42 TUPLE: monster
  43     { name string read-only } { hp integer } { max-hp integer read-only }
  44     { computed integer read-only }
  45     lots of extra slots that make me not want to use boa, maybe they get set later
  46     { stop initial: 18 } ;
  47
  48 TUPLE: a-monster < monster ;
  49
  50 TUPLE: b-monster < monster ;
  51
  52 <<
  53 SLOT-CONSTRUCTOR: a-monster
  54 >>
  55
  56 : <a-monster> ( name hp max-hp -- obj )
  57     2dup +
  58     a-monster( name hp max-hp computed ) ;
  59
  60 : <b-monster> ( name hp max-hp -- obj )
  61     2dup +
  62     { "name" "hp" "max-hp" "computed" } \ b-monster slots>boa ;
  63
  64 { 20 } [ "Norm" 10 10 <a-monster> computed>> ] unit-test
  65 { 18 } [ "Norm" 10 10 <a-monster> stop>> ] unit-test
  66
  67 { 22 } [ "Phil" 11 11 <b-monster> computed>> ] unit-test
  68 { 18 } [ "Phil" 11 11 <b-monster> stop>> ] unit-test
  69
  70 [
  71     "USE: constructors
  72 IN: constructors.tests
  73 TUPLE: foo a b ;
  74 CONSTRUCTOR: <foo> foo ( a a -- obj )" eval( -- )
  75 ] [
  76     error>> repeated-constructor-parameters?
  77 ] must-fail-with
  78
  79 [
  80     "USE: constructors
  81 IN: constructors.tests
  82 TUPLE: foo a b ;
  83 CONSTRUCTOR: <foo> foo ( a c -- obj )" eval( -- )
  84 ] [
  85     error>> unknown-constructor-parameters?
  86 ] must-fail-with