cache: add unit tests, make clear-assoc method dispose of all values

basis/cache/cache-tests.factor

@@ -0,0 +1,50 @@
+USING: cache tools.test accessors destructors kernel assocs
+namespaces ;
+IN: cache.tests
+
+TUPLE: mock-disposable < disposable n ;
+
+: <mock-disposable> ( n -- mock-disposable )
+    mock-disposable new-disposable swap >>n ;
+
+M: mock-disposable dispose* drop ;
+
+[ ] [ <cache-assoc> "cache" set ] unit-test
+
+[ 0 ] [ "cache" get assoc-size ] unit-test
+
+[ ] [ "cache" get 2 >>max-age drop ] unit-test
+
+[ ] [ 1 <mock-disposable> dup "a" set 2 "cache" get set-at ] unit-test
+
+[ 1 ] [ "cache" get assoc-size ] unit-test
+
+[ ] [ "cache" get purge-cache ] unit-test
+
+[ ] [ 2 <mock-disposable> 3 "cache" get set-at ] unit-test
+
+[ 2 ] [ "cache" get assoc-size ] unit-test
+
+[ ] [ "cache" get purge-cache ] unit-test
+
+[ 1 ] [ "cache" get assoc-size ] unit-test
+
+[ ] [ 3 <mock-disposable> dup "b" set 4 "cache" get set-at ] unit-test
+
+[ 2 ] [ "cache" get assoc-size ] unit-test
+
+[ ] [ "cache" get purge-cache ] unit-test
+
+[ 1 ] [ "cache" get assoc-size ] unit-test
+
+[ f ] [ 2 "cache" get key? ] unit-test
+
+[ 3 ] [ 4 "cache" get at n>> ] unit-test
+
+[ t ] [ "a" get disposed>> ] unit-test
+
+[ f ] [ "b" get disposed>> ] unit-test
+
+[ ] [ "cache" get clear-assoc ] unit-test
+
+[ t ] [ "b" get disposed>> ] unit-test

basis/cache/cache.factor

@@ -25,19 +25,21 @@ M: cache-assoc set-at
     [ <cache-entry> ] 2dip
     assoc>> set-at ;
 
-M: cache-assoc clear-assoc assoc>> clear-assoc ;
+M: cache-assoc clear-assoc
+    [ assoc>> values dispose-each ]
+    [ assoc>> clear-assoc ]
+    bi ;
 
 M: cache-assoc >alist assoc>> [ value>> ] { } assoc-map-as ;
 
 INSTANCE: cache-assoc assoc
 
-M: cache-assoc dispose*
+M: cache-assoc dispose* clear-assoc ;
-    [ values dispose-each ] [ clear-assoc ] bi ;
 
 PRIVATE>
 
 : purge-cache ( cache -- )
     dup max-age>> '[
-        [ nip [ 1 + ] change-age age>> _ >= ] assoc-partition
+        [ nip [ 1 + ] change-age age>> _ < ] assoc-partition
-        [ values dispose-each ] dip
+        values dispose-each
     ] change-assoc drop ;