steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix ?at, if-at and add unit tests

db4
Doug Coleman 2008-08-17 21:54:10 -05:00
parent ab56eb0e48
commit 16342a8a40
2 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
extra/assocs/lib/lib-tests.factor
View File

@ -1,4 +1,17 @@
USING: kernel tools.test sequences vectors assocs.lib ;
IN: assocs.lib.tests IN: assocs.lib.tests
USING: assocs.lib tools.test vectors ;
{ 1 1 } [ [ ?push ] histogram ] must-infer-as { 1 1 } [ [ ?push ] histogram ] must-infer-as
! substitute
[ { 2 } ] [ { 1 } H{ { 1 2 } } [ ?at drop ] curry map ] unit-test
[ { 3 } ] [ { 3 } H{ { 1 2 } } [ ?at drop ] curry map ] unit-test
[ 2 ] [ 1 H{ { 1 2 } } [ ] [ ] if-at ] unit-test
[ 3 ] [ 3 H{ { 1 2 } } [ ] [ ] if-at ] unit-test
[ "hi" ] [ 1 H{ { 1 2 } } [ drop "hi" ] when-at ] unit-test
[ 3 ] [ 3 H{ { 1 2 } } [ drop "hi" ] when-at ] unit-test
[ 2 ] [ 1 H{ { 1 2 } } [ drop "hi" ] unless-at ] unit-test
[ "hi" ] [ 3 H{ { 1 2 } } [ drop "hi" ] unless-at ] unit-test

6
extra/assocs/lib/lib.factor
View File

@ -38,11 +38,11 @@ IN: assocs.lib
swap [ change-at ] 2curry assoc-each swap [ change-at ] 2curry assoc-each
] keep ; inline ] keep ; inline
: ?at ( obj1 assoc -- obj1/obj2 ) : ?at ( obj assoc -- value/obj ? )
dupd at* [ nip ] [ drop ] if ; dupd at* [ [ nip ] [ drop ] if ] keep ;
: if-at ( obj assoc quot1 quot2 -- ) : if-at ( obj assoc quot1 quot2 -- )
[ ?at dup ] 2dip if ; inline [ ?at ] 2dip if ; inline
: when-at ( obj assoc quot -- ) [ ] if-at ; inline : when-at ( obj assoc quot -- ) [ ] if-at ; inline