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