steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Regression fixes

db4
Slava Pestov 2008-02-25 19:37:43 -06:00
parent 438f00a6a5
commit 84016a36c0
18 changed files with 103 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
core/compiler/tests/curry.factor
View File

@ -1,5 +1,5 @@
USING: tools.test compiler quotations math kernel sequences
assocs namespaces ;
USING: tools.test quotations math kernel sequences
assocs namespaces compiler.units ;
IN: temporary
[ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test

2
core/compiler/tests/float.factor
View File

@ -1,5 +1,5 @@
IN: temporary
USING: compiler kernel kernel.private memory math
USING: compiler.units kernel kernel.private memory math
math.private tools.test math.floats.private ;
[ 5.0 ] [ [ 5.0 ] compile-call data-gc data-gc data-gc ] unit-test

13
core/compiler/tests/intrinsics.factor
View File

@ -1,10 +1,11 @@
IN: temporary
USING: arrays compiler kernel kernel.private math math.constants
math.private sequences strings tools.test words continuations
sequences.private hashtables.private byte-arrays strings.private
system random layouts vectors.private sbufs.private
strings.private slots.private alien alien.accessors
alien.c-types alien.syntax namespaces libc sequences.private ;
USING: arrays compiler.units kernel kernel.private math
math.constants math.private sequences strings tools.test words
continuations sequences.private hashtables.private byte-arrays
strings.private system random layouts vectors.private
sbufs.private strings.private slots.private alien
alien.accessors alien.c-types alien.syntax namespaces libc
sequences.private ;
! Make sure that intrinsic ops compile to correct code.
[ ] [ 1 [ drop ] compile-call ] unit-test

2
core/compiler/tests/simple.factor
View File

@ -1,4 +1,4 @@
USING: compiler tools.test kernel kernel.private
USING: compiler.units tools.test kernel kernel.private
sequences.private math.private math combinators strings
alien arrays memory ;
IN: temporary

2
core/compiler/tests/tuples.factor
View File

@ -1,5 +1,5 @@
IN: temporary
USING: kernel tools.test compiler ;
USING: kernel tools.test compiler.units ;
TUPLE: color red green blue ;

9
core/compiler/units/units.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel continuations assocs namespaces sequences words
vocabs definitions hashtables ;
vocabs definitions hashtables init ;
IN: compiler.units
SYMBOL: old-definitions
@ -37,12 +37,13 @@ SYMBOL: recompile-hook
SYMBOL: definition-observers
definition-observers global [ V{ } like ] change-at
GENERIC: definitions-changed ( assoc obj -- )
[ V{ } clone definition-observers set-global ]
"compiler.units" add-init-hook
: add-definition-observer ( obj -- )
definition-observers get push-new ;
definition-observers get push ;
: remove-definition-observer ( obj -- )
definition-observers get delete ;

2
core/inference/state/state-tests.factor
View File

@ -1,5 +1,5 @@
IN: temporary
USING: tools.test inference.state ;
USING: tools.test inference.state words ;
SYMBOL: a
SYMBOL: b

2
core/optimizer/optimizer-tests.factor
View File

@ -1,4 +1,4 @@
USING: arrays compiler generic hashtables inference kernel
USING: arrays compiler.units generic hashtables inference kernel
kernel.private math optimizer prettyprint sequences sbufs
strings tools.test vectors words sequences.private quotations
optimizer.backend classes inference.dataflow tuples.private

2
core/parser/parser.factor
View File

@ -468,7 +468,7 @@ SYMBOL: interactive-vocabs
#! If a class word had a compound definition which was
#! removed, it must go back to being a symbol.
new-definitions get first2 diff
[ nip define-symbol ] assoc-each ;
[ nip dup reset-generic define-symbol ] assoc-each ;
: forget-smudged ( -- )
smudged-usage forget-all

8
core/words/words-tests.factor
View File

@ -1,6 +1,6 @@
USING: arrays generic assocs kernel math namespaces
sequences tools.test words definitions parser quotations
vocabs continuations tuples compiler.units ;
vocabs continuations tuples compiler.units io.streams.string ;
IN: temporary
[ 4 ] [
@ -156,11 +156,13 @@ SYMBOL: quot-uses-b
[ f ] [ "symbol-generic" "temporary" lookup generic? ] unit-test
[ ] [
"IN: temporary GENERIC: symbol-generic" eval
"IN: temporary GENERIC: symbol-generic" <string-reader>
"symbol-generic-test" parse-stream drop
] unit-test
[ ] [
"IN: temporary TUPLE: symbol-generic ;" eval
"IN: temporary TUPLE: symbol-generic ;" <string-reader>
"symbol-generic-test" parse-stream drop
] unit-test
[ t ] [ "symbol-generic" "temporary" lookup symbol? ] unit-test

3
extra/cocoa/cocoa-tests.factor
View File

@ -1,6 +1,7 @@
IN: temporary
USING: cocoa cocoa.messages cocoa.subclassing cocoa.types
compiler kernel namespaces cocoa.classes tools.test memory ;
compiler kernel namespaces cocoa.classes tools.test memory
compiler.units ;
CLASS: {
{ +superclass+ "NSObject" }

21
extra/concurrency/flags/flags.factor Normal file
View File

@ -0,0 +1,21 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: boxes kernel threads ;
IN: concurrency.flags
TUPLE: flag value? thread ;
: <flag> ( -- flag ) f <box> flag construct-boa ;
: raise-flag ( flag -- )
dup flag-value? [
dup flag-thread ?box
[ resume ] [ drop t over set-flag-value? ] if
] unless drop ;
: lower-flag ( flag -- )
dup flag-value? [
f swap set-flag-value?
] [
[ flag-thread >box ] curry "flag" suspend drop
] if ;

2
extra/concurrency/mailboxes/mailboxes.factor
View File

@ -15,7 +15,7 @@ TUPLE: mailbox threads data ;
: mailbox-put ( obj mailbox -- )
[ mailbox-data push-front ] keep
mailbox-threads notify-all ;
mailbox-threads notify-all yield ;
: block-unless-pred ( pred mailbox timeout -- )
2over mailbox-data dlist-contains? [

4
extra/html/elements/elements.factor
View File

@ -87,14 +87,14 @@ SYMBOL: html
#! word.
foo> [ ">" write-html ] empty-effect html-word ;
: </foo> [ "</" % % ">" % ] "" make ;
: </foo> "</" swap ">" 3append ;
: def-for-html-word-</foo> ( name -- )
#! Return the name and code for the </foo> patterned
#! word.
</foo> dup [ write-html ] curry empty-effect html-word ;
: <foo/> [ "<" % % "/>" % ] "" make ;
: <foo/> "<" swap "/>" 3append ;
: def-for-html-word-<foo/> ( name -- )
#! Return the name and code for the <foo/> patterned

60
extra/io/unix/unix-tests.factor
View File

@ -4,12 +4,12 @@ sequences prettyprint system ;
IN: temporary
! Unix domain stream sockets
[
[
"unix-domain-socket-test" resource-path delete-file
] ignore-errors
: socket-server "unix-domain-socket-test" temp-file ;
"unix-domain-socket-test" resource-path <local>
[
[ socket-server delete-file ] ignore-errors
socket-server <local>
<server> [
stdio get accept [
"Hello world" print flush
@ -17,14 +17,14 @@ IN: temporary
] with-stream
] with-stream
"unix-domain-socket-test" resource-path delete-file
socket-server delete-file
] "Test" spawn drop
yield
[ { "Hello world" "FOO" } ] [
[
"unix-domain-socket-test" resource-path <local> <client>
socket-server <local> <client>
[
readln ,
"XYZ" print flush
@ -33,17 +33,16 @@ yield
] { } make
] unit-test
! Unix domain datagram sockets
[
"unix-domain-datagram-test" resource-path delete-file
] ignore-errors
: datagram-server "unix-domain-datagram-test" temp-file ;
: datagram-client "unix-domain-datagram-test-2" temp-file ;
: server-addr "unix-domain-datagram-test" temp-file <local> ;
: client-addr "unix-domain-datagram-test-2" temp-file <local> ;
! Unix domain datagram sockets
[ datagram-server delete-file ] ignore-errors
[ datagram-client delete-file ] ignore-errors
[
[
server-addr <datagram> "d" set
datagram-server <local> <datagram> "d" set
"Receive 1" print
@ -67,58 +66,53 @@ yield
"Done" print
"unix-domain-datagram-test" resource-path delete-file
datagram-server delete-file
] with-scope
] "Test" spawn drop
yield
[
"unix-domain-datagram-test-2" resource-path delete-file
] ignore-errors
[ datagram-client delete-file ] ignore-errors
client-addr <datagram>
datagram-client <local> <datagram>
"d" set
[ ] [
"hello" >byte-array
server-addr
datagram-server <local>
"d" get send
] unit-test
[ "olleh" t ] [
"d" get receive
server-addr =
datagram-server <local> =
>r >string r>
] unit-test
[ ] [
"hello" >byte-array
server-addr
datagram-server <local>
"d" get send
] unit-test
[ "hello world" t ] [
"d" get receive
server-addr =
datagram-server <local> =
>r >string r>
] unit-test
[ ] [ "d" get dispose ] unit-test
! Test error behavior
: another-datagram "unix-domain-datagram-test-3" temp-file ;
[
"unix-domain-datagram-test-3" resource-path delete-file
] ignore-errors
[ another-datagram delete-file ] ignore-errors
"unix-domain-datagram-test-2" temp-file delete-file
datagram-client delete-file
[ ] [ client-addr <datagram> "d" set ] unit-test
[ ] [ datagram-client <local> <datagram> "d" set ] unit-test
[
B{ 1 2 3 } "unix-domain-datagram-test-3" <local> "d" get send
] must-fail
[ B{ 1 2 3 } another-datagram <local> "d" get send ] must-fail
[ ] [ "d" get dispose ] unit-test
@ -126,7 +120,7 @@ client-addr <datagram>
[ "d" get receive ] must-fail
[ B{ 1 2 } server-addr "d" get send ] must-fail
[ B{ 1 2 } datagram-server <local> "d" get send ] must-fail
! Invalid parameter tests
@ -140,7 +134,7 @@ client-addr <datagram>
[
image [
B{ 1 2 } server-addr
B{ 1 2 } datagram-server <local>
stdio get send
] with-file-reader
] must-fail

11
extra/ui/gadgets/gadgets.factor
View File

@ -2,17 +2,12 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays hashtables kernel models math namespaces sequences
quotations math.vectors combinators sorting vectors dlists
models threads concurrency.messaging ;
models threads concurrency.flags ;
IN: ui.gadgets
SYMBOL: ui-thread
SYMBOL: ui-notify-flag
: notify-ui-thread ( -- )
self ui-thread get-global eq? [
"notify" ui-thread get-global send
] unless ;
: stop-ui-thread ( -- ) "stop" ui-thread get-global send ;
: notify-ui-thread ( -- ) ui-notify-flag get-global raise-flag ;
TUPLE: rect loc dim ;

5
extra/ui/tools/search/search.factor
View File

@ -7,7 +7,7 @@ source-files definitions strings tools.completion tools.crossref
tuples ui.commands ui.gadgets ui.gadgets.editors
ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks
ui.gestures ui.operations vocabs words vocabs.loader
tools.browser unicode.case calendar ;
tools.browser unicode.case calendar ui ;
IN: ui.tools.search
TUPLE: live-search field list ;
@ -45,7 +45,8 @@ search-field H{
} set-gestures
: <search-model> ( producer -- model )
>r g live-search-field gadget-model 1/5 seconds <delay>
>r g live-search-field gadget-model
ui-running? [ 1/5 seconds <delay> ] when
[ "\n" join ] r> append <filter> ;
: <search-list> ( seq limited? presenter -- gadget )

31
extra/ui/ui.factor
View File

@ -4,7 +4,7 @@ USING: arrays assocs io kernel math models namespaces
prettyprint dlists sequences threads sequences words
debugger ui.gadgets ui.gadgets.worlds ui.gadgets.tracks
ui.gestures ui.backend ui.render continuations init combinators
hashtables concurrency.messaging ;
hashtables concurrency.flags ;
IN: ui
! Assoc mapping aliens to gadgets
@ -138,18 +138,25 @@ SYMBOL: ui-hook
: ui-try ( quot -- ) [ ui-error ] recover ;
SYMBOL: ui-thread
: ui-running ( quot -- )
t \ ui-running set-global
[ f \ ui-running set-global ] [ ] cleanup ; inline
: ui-running? ( -- ? )
\ ui-running get-global ;
: update-ui-loop ( -- )
receive { { "notify" [ ] } { "stop" [ stop ] } } case
[ update-ui ] ui-try
update-ui-loop ;
ui-running? ui-thread get-global self eq? [
ui-notify-flag get lower-flag
[ update-ui ] ui-try
update-ui-loop
] when ;
: start-ui-thread ( -- )
[ update-ui-loop ]
"UI update" spawn ui-thread set-global ;
[ self ui-thread set-global update-ui-loop ]
"UI update" spawn drop ;
: open-world-window ( world -- )
dup pref-dim over set-gadget-dim dup relayout graft ;
@ -173,17 +180,17 @@ M: object close-window
find-world [ ungraft ] when* ;
: start-ui ( -- )
start-ui-thread
restore-windows? [
restore-windows
] [
init-ui ui-hook get call
] if update-ui ;
] if
notify-ui-thread start-ui-thread ;
: ui-running? ( -- ? )
\ ui-running get-global ;
[ f \ ui-running set-global ] "ui" add-init-hook
[
f \ ui-running set-global
<flag> ui-notify-flag set-global
] "ui" add-init-hook
HOOK: ui ui-backend ( -- )