fix ?at, if-at and add unit tests

diff --git a/extra/assocs/lib/lib-tests.factor b/extra/assocs/lib/lib-tests.factor
index 0bf82700885f414a726334d5181d99be30ff929b..c7e1aa4fbfe907119f8bf6f571d6a9bec2350a57 100644 (file)
--- 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 2a8634987f59e62085375e53e90183b98ec380b9..ed9b4bf0c4ef56a3687f4dae9b5f5333ce36dce3 100755 (executable)
--- 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