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

db4
John Benediktsson 2010-11-01 08:16:32 -07:00
commit afb23da7fe
9 changed files with 99 additions and 16 deletions

20
basis/alien/libraries/libraries-tests.factor Normal file → Executable file
View File

@ -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 IN: alien.libraries.tests
[ f ] [ DLL" fadfasdfsada" dll-valid? ] unit-test [ f ] [ DLL" fadfasdfsada" dll-valid? ] unit-test
@ -8,3 +8,21 @@ IN: alien.libraries.tests
[ ] [ "doesnotexist" dlopen dlclose ] unit-test [ ] [ "doesnotexist" dlopen dlclose ] unit-test
[ "fdasfsf" dll-valid? drop ] must-fail [ "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

View File

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

50
basis/cache/cache-tests.factor vendored Executable file
View File

@ -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

12
basis/cache/cache.factor vendored Normal file → Executable file
View File

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

2
basis/concurrency/count-downs/count-downs.factor Normal file → Executable file
View File

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

View File

@ -0,0 +1 @@
Slava Pestov

View File

@ -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 ;

8
basis/concurrency/mailboxes/mailboxes.factor Normal file → Executable file
View File

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

2
extra/game/loop/loop.factor Normal file → Executable file
View File

@ -2,7 +2,7 @@
USING: accessors timers alien.c-types calendar classes.struct USING: accessors timers alien.c-types calendar classes.struct
continuations destructors fry kernel math math.order memory continuations destructors fry kernel math math.order memory
namespaces sequences specialized-vectors system 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 ; tools.time.struct locals ;
IN: game.loop IN: game.loop