From 16342a8a403bf0d44a090546cd1d6f479f9bb371 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 Aug 2008 21:54:10 -0500 Subject: [PATCH] fix ?at, if-at and add unit tests --- extra/assocs/lib/lib-tests.factor | 15 ++++++++++++++- extra/assocs/lib/lib.factor | 6 +++--- 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/extra/assocs/lib/lib-tests.factor b/extra/assocs/lib/lib-tests.factor index 0bf8270088..c7e1aa4fbf 100644 --- a/extra/assocs/lib/lib-tests.factor +++ b/extra/assocs/lib/lib-tests.factor @@ -1,4 +1,17 @@ +USING: kernel tools.test sequences vectors assocs.lib ; IN: assocs.lib.tests -USING: assocs.lib tools.test vectors ; { 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 + diff --git a/extra/assocs/lib/lib.factor b/extra/assocs/lib/lib.factor index 2a8634987f..ed9b4bf0c4 100755 --- a/extra/assocs/lib/lib.factor +++ b/extra/assocs/lib/lib.factor @@ -38,11 +38,11 @@ IN: assocs.lib swap [ change-at ] 2curry assoc-each ] keep ; inline -: ?at ( obj1 assoc -- obj1/obj2 ) - dupd at* [ nip ] [ drop ] if ; +: ?at ( obj assoc -- value/obj ? ) + dupd at* [ [ nip ] [ drop ] if ] keep ; : if-at ( obj assoc quot1 quot2 -- ) - [ ?at dup ] 2dip if ; inline + [ ?at ] 2dip if ; inline : when-at ( obj assoc quot -- ) [ ] if-at ; inline