2008-06-29 03:12:44 -04:00
|
|
|
USING: mirrors tools.test assocs kernel arrays accessors words
|
2008-07-29 01:05:01 -04:00
|
|
|
namespaces math slots parser eval ;
|
2008-03-01 17:00:45 -05:00
|
|
|
IN: mirrors.tests
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
TUPLE: foo bar baz ;
|
|
|
|
|
|
|
|
C: <foo> foo
|
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 2 } [ 1 2 <foo> <mirror> assoc-size ] unit-test
|
2008-07-01 17:33:45 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ { "bar" "baz" } } [ 1 2 <foo> <mirror> keys ] unit-test
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 1 t } [ "bar" 1 2 <foo> <mirror> at* ] unit-test
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ f f } [ "hi" 1 2 <foo> <mirror> at* ] unit-test
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 3 } [
|
2008-09-02 02:53:37 -04:00
|
|
|
3 "baz" 1 2 <foo> [ <mirror> set-at ] keep baz>>
|
2007-09-20 18:09:08 -04:00
|
|
|
] unit-test
|
2008-04-24 03:48:48 -04:00
|
|
|
|
2008-06-29 03:12:44 -04:00
|
|
|
[ 3 "hi" 1 2 <foo> <mirror> set-at ] must-fail
|
|
|
|
|
|
|
|
[ 3 "numerator" 1/2 <mirror> set-at ] must-fail
|
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ "foo" } [
|
2008-06-29 03:12:44 -04:00
|
|
|
gensym [
|
|
|
|
<mirror> [
|
|
|
|
"foo" "name" set
|
2012-07-19 03:02:47 -04:00
|
|
|
] with-variables
|
2008-06-29 03:12:44 -04:00
|
|
|
] [ name>> ] bi
|
|
|
|
] unit-test
|
|
|
|
|
2012-07-19 03:02:47 -04:00
|
|
|
[ gensym <mirror> [ "compiled" off ] with-variables ] must-fail
|
2008-06-29 03:12:44 -04:00
|
|
|
|
|
|
|
TUPLE: declared-mirror-test
|
2008-06-29 22:37:57 -04:00
|
|
|
{ a integer initial: 0 } ;
|
2008-06-29 03:12:44 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 5 } [
|
2008-06-29 03:12:44 -04:00
|
|
|
3 declared-mirror-test boa <mirror> [
|
|
|
|
5 "a" set
|
|
|
|
"a" get
|
2012-07-19 03:02:47 -04:00
|
|
|
] with-variables
|
2008-06-29 03:12:44 -04:00
|
|
|
] unit-test
|
|
|
|
|
2012-07-19 03:02:47 -04:00
|
|
|
[ 3 declared-mirror-test boa <mirror> [ t "a" set ] with-variables ] must-fail
|
2008-06-29 03:12:44 -04:00
|
|
|
|
|
|
|
TUPLE: color
|
2008-06-29 22:37:57 -04:00
|
|
|
{ red integer }
|
|
|
|
{ green integer }
|
|
|
|
{ blue integer } ;
|
2008-06-29 03:12:44 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ T{ color f 0 0 0 } } [
|
2008-06-29 03:12:44 -04:00
|
|
|
1 2 3 color boa [ <mirror> clear-assoc ] keep
|
|
|
|
] unit-test
|
2008-07-01 17:16:02 -04:00
|
|
|
|
|
|
|
! Test reshaping with a mirror
|
|
|
|
1 2 3 color boa <mirror> "mirror" set
|
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ } [ "IN: mirrors.tests USE: math TUPLE: color { green integer } { red integer } { blue integer } ;" eval( -- ) ] unit-test
|
2008-07-01 17:16:02 -04:00
|
|
|
|
2015-07-02 20:28:17 -04:00
|
|
|
{ 1 } [ "red" "mirror" get at ] unit-test
|
2013-04-23 10:05:51 -04:00
|
|
|
|
2013-04-23 10:56:58 -04:00
|
|
|
{ 3 } [ { 1 2 3 } make-mirror assoc-size ] unit-test
|
2016-03-25 18:56:42 -04:00
|
|
|
{ 4 } [ "asdf" make-mirror assoc-size ] unit-test
|
2013-04-23 10:56:58 -04:00
|
|
|
{ 8 } [ \ + make-mirror assoc-size ] unit-test
|