2016-03-30 21:43:14 -04:00
|
|
|
USING: accessors arrays generic.single kernel math
|
|
|
|
math.functions slots tools.test words ;
|
2009-08-13 20:21:44 -04:00
|
|
|
IN: slots.tests
|
2008-06-28 03:36:20 -04:00
|
|
|
|
|
|
|
TUPLE: r/w-test foo ;
|
|
|
|
|
2008-06-30 02:44:58 -04:00
|
|
|
TUPLE: r/o-test { foo read-only } ;
|
2008-06-28 03:36:20 -04:00
|
|
|
|
|
|
|
[ r/o-test new 123 >>foo ] [ no-method? ] must-fail-with
|
|
|
|
|
2010-01-16 06:30:36 -05:00
|
|
|
TUPLE: decl-test { foo array } ;
|
2008-06-28 03:36:20 -04:00
|
|
|
|
2010-01-16 06:30:36 -05:00
|
|
|
[ decl-test new "" >>foo ] [ bad-slot-value? ] must-fail-with
|
2008-06-28 03:36:20 -04:00
|
|
|
|
|
|
|
TUPLE: hello length ;
|
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 3 } [ "xyz" length>> ] unit-test
|
2008-06-28 03:36:20 -04:00
|
|
|
|
|
|
|
[ "xyz" 4 >>length ] [ no-method? ] must-fail-with
|
2008-06-29 22:37:57 -04:00
|
|
|
|
2008-11-14 01:39:28 -05:00
|
|
|
! Test protocol slots
|
|
|
|
SLOT: my-protocol-slot-test
|
|
|
|
|
|
|
|
TUPLE: protocol-slot-test-tuple x ;
|
|
|
|
|
|
|
|
M: protocol-slot-test-tuple my-protocol-slot-test>> x>> sq ;
|
2010-05-05 16:52:54 -04:00
|
|
|
M: protocol-slot-test-tuple my-protocol-slot-test<< [ sqrt ] dip x<< ;
|
2008-11-14 01:39:28 -05:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 9 } [ T{ protocol-slot-test-tuple { x 3 } } my-protocol-slot-test>> ] unit-test
|
2008-11-14 01:39:28 -05:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 4.0 } [
|
2008-11-14 01:39:28 -05:00
|
|
|
T{ protocol-slot-test-tuple { x 3 } } clone
|
|
|
|
[ 7 + ] change-my-protocol-slot-test x>>
|
|
|
|
] unit-test
|
2009-08-19 22:28:20 -04:00
|
|
|
|
|
|
|
UNION: comme-ci integer float ;
|
|
|
|
UNION: comme-ca integer float ;
|
|
|
|
comme-ca 25.5 "initial-value" set-word-prop
|
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 0 t } [ comme-ci initial-value ] unit-test
|
|
|
|
{ 25.5 t } [ comme-ca initial-value ] unit-test
|