2005-03-28 23:45:13 -05:00
|
|
|
IN: temporary
|
2005-02-09 22:35:11 -05:00
|
|
|
USING: generic kernel test math parser ;
|
2005-01-31 14:02:09 -05:00
|
|
|
|
|
|
|
TUPLE: rect x y w h ;
|
|
|
|
C: rect
|
|
|
|
[ set-rect-h ] keep
|
|
|
|
[ set-rect-w ] keep
|
|
|
|
[ set-rect-y ] keep
|
|
|
|
[ set-rect-x ] keep ;
|
|
|
|
|
|
|
|
: move ( x rect -- )
|
|
|
|
[ rect-x + ] keep set-rect-x ;
|
|
|
|
|
|
|
|
[ f ] [ 10 20 30 40 <rect> dup clone 5 swap [ move ] keep = ] unit-test
|
|
|
|
|
|
|
|
[ t ] [ 10 20 30 40 <rect> dup clone 0 swap [ move ] keep = ] unit-test
|
|
|
|
|
2005-02-01 19:00:16 -05:00
|
|
|
GENERIC: delegation-test
|
|
|
|
M: object delegation-test drop 3 ;
|
|
|
|
TUPLE: quux-tuple ;
|
|
|
|
C: quux-tuple ;
|
|
|
|
M: quux-tuple delegation-test drop 4 ;
|
2005-03-08 22:54:59 -05:00
|
|
|
TUPLE: quuux-tuple ;
|
2005-02-09 22:35:11 -05:00
|
|
|
C: quuux-tuple
|
2005-03-08 22:54:59 -05:00
|
|
|
[ set-delegate ] keep ;
|
2005-01-31 14:02:09 -05:00
|
|
|
|
2005-02-01 19:00:16 -05:00
|
|
|
[ 3 ] [ <quux-tuple> <quuux-tuple> delegation-test ] unit-test
|
2005-02-08 22:02:44 -05:00
|
|
|
|
|
|
|
GENERIC: delegation-test-2
|
|
|
|
TUPLE: quux-tuple-2 ;
|
|
|
|
C: quux-tuple-2 ;
|
|
|
|
M: quux-tuple-2 delegation-test-2 drop 4 ;
|
2005-03-08 22:54:59 -05:00
|
|
|
TUPLE: quuux-tuple-2 ;
|
2005-02-09 22:35:11 -05:00
|
|
|
C: quuux-tuple-2
|
2005-03-08 22:54:59 -05:00
|
|
|
[ set-delegate ] keep ;
|
2005-02-08 22:02:44 -05:00
|
|
|
|
|
|
|
[ 4 ] [ <quux-tuple-2> <quuux-tuple-2> delegation-test-2 ] unit-test
|
2005-02-09 22:35:11 -05:00
|
|
|
|
|
|
|
! Make sure we handle changing shapes!
|
|
|
|
|
|
|
|
[
|
|
|
|
100
|
|
|
|
] [
|
|
|
|
TUPLE: point x y ;
|
|
|
|
C: point [ set-point-y ] keep [ set-point-x ] keep ;
|
|
|
|
|
|
|
|
100 200 <point>
|
|
|
|
|
|
|
|
! Use eval to sequence parsing explicitly
|
2005-02-22 23:07:47 -05:00
|
|
|
"TUPLE: point x y z ;" eval
|
2005-02-09 22:35:11 -05:00
|
|
|
|
|
|
|
point-x
|
|
|
|
] unit-test
|
2005-05-09 02:34:15 -04:00
|
|
|
|
|
|
|
TUPLE: predicate-test ;
|
|
|
|
: predicate-test drop f ;
|
|
|
|
|
|
|
|
[ t ] [ <predicate-test> predicate-test? ] unit-test
|