Merge branch 'master' of git://github.com/slavapestov/factor

basis/alien/libraries/libraries-tests.factor

@@ -1,4 +1,4 @@
-USING: alien.libraries alien.syntax tools.test kernel ;
+USING: alien alien.libraries alien.syntax tools.test kernel ;
 IN: alien.libraries.tests
 
 [ f ] [ DLL" fadfasdfsada" dll-valid? ] unit-test
@@ -8,3 +8,21 @@ IN: alien.libraries.tests
 [ ] [ "doesnotexist" dlopen dlclose ] unit-test
 
 [ "fdasfsf" dll-valid? drop ] must-fail
+
+[ t ] [
+    "test-library" "blah" cdecl add-library
+    "test-library" "BLAH" cdecl add-library?
+    "blah" remove-library
+] unit-test
+
+[ t ] [
+    "test-library" "blah" cdecl add-library
+    "test-library" "blah" stdcall add-library?
+    "blah" remove-library
+] unit-test
+
+[ f ] [
+    "test-library" "blah" cdecl add-library
+    "test-library" "blah" cdecl add-library?
+    "blah" remove-library
+] unit-test

basis/alien/libraries/libraries.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.strings assocs io.backend
 kernel namespaces destructors sequences strings
-system io.pathnames ;
+system io.pathnames fry ;
 IN: alien.libraries
 
 : dlopen ( path -- dll ) native-string>alien (dlopen) ;
@@ -32,9 +32,15 @@ M: library dispose dll>> [ dispose ] when* ;
 : remove-library ( name -- )
     libraries get delete-at* [ dispose ] [ drop ] if ;
 
+: add-library? ( name path abi -- ? )
+    [ library ] 2dip
+    '[ [ path>> _ = ] [ abi>> _ = ] bi and not ] [ t ] if* ;
+
 : add-library ( name path abi -- )
-    [ 2drop remove-library ]
-    [ <library> swap libraries get set-at ] 3bi ;
+    3dup add-library? [
+        [ 2drop remove-library ]
+        [ <library> swap libraries get set-at ] 3bi
+    ] [ 3drop ] if ;
 
 : library-abi ( library -- abi )
     library [ abi>> ] [ cdecl ] if* ;

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*
-    [ values dispose-each ] [ clear-assoc ] bi ;
+M: cache-assoc dispose* clear-assoc ;
 
 PRIVATE>
 
 : purge-cache ( cache -- )
     dup max-age>> '[
-        [ nip [ 1 + ] change-age age>> _ >= ] assoc-partition
-        [ values dispose-each ] dip
+        [ nip [ 1 + ] change-age age>> _ < ] assoc-partition
+        values dispose-each
     ] change-assoc drop ;

basis/concurrency/count-downs/count-downs.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: dlists kernel math concurrency.promises
-concurrency.mailboxes debugger accessors fry ;
+concurrency.mailboxes accessors fry ;
 IN: concurrency.count-downs
 
 ! http://java.sun.com/j2se/1.5.0/docs/api/java/util/concurrent/CountDownLatch.html

basis/concurrency/mailboxes/debugger/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/concurrency/mailboxes/debugger/debugger.factor

@@ -0,0 +1,8 @@
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: debugger accessors debugger.threads kernel
+concurrency.mailboxes ;
+IN: concurrency.mailboxes.debugger
+
+M: linked-error error.
+    [ thread>> error-in-thread. ] [ error>> error. ] bi ;

basis/concurrency/mailboxes/mailboxes.factor

@@ -2,8 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: dlists deques threads sequences continuations namespaces
 math quotations words kernel arrays assocs init system
-concurrency.conditions accessors debugger debugger.threads
-locals fry ;
+concurrency.conditions accessors locals fry vocabs.loader ;
 IN: concurrency.mailboxes
 
 TUPLE: mailbox { threads dlist } { data dlist } ;
@@ -77,9 +76,6 @@ M: mailbox mailbox-get-timeout block-if-empty data>> pop-back ;
 
 TUPLE: linked-error error thread ;
 
-M: linked-error error.
-    [ thread>> error-in-thread. ] [ error>> error. ] bi ;
-
 C: <linked-error> linked-error
 
 : ?linked ( message -- message )
@@ -95,3 +91,5 @@ M: linked-thread error-in-thread
 
 : spawn-linked-to ( quot name mailbox -- thread )
     <linked-thread> [ (spawn) ] keep ;
+
+{ "concurrency.mailboxes" "debugger" } "concurrency.mailboxes.debugger" require-when

extra/game/loop/loop.factor

@@ -2,7 +2,7 @@
 USING: accessors timers alien.c-types calendar classes.struct
 continuations destructors fry kernel math math.order memory
 namespaces sequences specialized-vectors system
-tools.memory ui ui.gadgets.worlds vm vocabs.loader arrays
+ui ui.gadgets.worlds vm vocabs.loader arrays
 tools.time.struct locals ;
 IN: game.loop