Fighting fires

db4
Slava Pestov 2008-02-21 02:08:08 -06:00
parent 6c0dd93ff1
commit 91f4ca6a56
9 changed files with 24 additions and 103 deletions

View File

@ -5,7 +5,7 @@ sequences strings vectors words quotations effects tools.test
continuations generic.standard sorting assocs definitions
prettyprint io inspector tuples classes.union classes.predicate
debugger threads.private io.streams.string io.timeouts
sequences.private ;
io.thread sequences.private ;
IN: temporary
{ 0 2 } [ 2 "Hello" ] must-infer-as
@ -440,7 +440,7 @@ DEFER: bar
\ error. must-infer
! Test odds and ends
\ idle-thread must-infer
\ io-thread must-infer
! Incorrect stack declarations on inline recursive words should
! be caught

View File

@ -2,7 +2,7 @@ USING: arrays definitions io.streams.string io.streams.duplex
kernel math namespaces parser prettyprint prettyprint.config
prettyprint.sections sequences tools.test vectors words
effects splitting generic.standard prettyprint.private
continuations generic compiler.units ;
continuations generic compiler.units tools.walker ;
IN: temporary
[ "4" ] [ 4 unparse ] unit-test
@ -299,27 +299,19 @@ unit-test
] unit-test
[ [ + ] ] [
[ \ + (step-into) ] (remove-breakpoints)
[ \ + (step-into-execute) ] (remove-breakpoints)
] unit-test
[ [ (step-into) ] ] [
[ (step-into) ] (remove-breakpoints)
] unit-test
[ [ 3 ] ] [
[ 3 (step-into) ] (remove-breakpoints)
[ [ (step-into-execute) ] ] [
[ (step-into-execute) ] (remove-breakpoints)
] unit-test
[ [ 2 2 + . ] ] [
[ 2 2 \ + (step-into) . ] (remove-breakpoints)
[ 2 2 \ + (step-into-execute) . ] (remove-breakpoints)
] unit-test
[ [ 2 2 + . ] ] [
[ 2 break 2 \ + (step-into) . ] (remove-breakpoints)
] unit-test
[ [ 2 . ] ] [
[ 2 \ break (step-into) . ] (remove-breakpoints)
[ 2 break 2 \ + (step-into-execute) . ] (remove-breakpoints)
] unit-test
[ ] [ 1 \ + curry unparse drop ] unit-test

4
extra/io/server/server-docs.factor Normal file → Executable file
View File

@ -1,10 +1,6 @@
USING: help help.syntax help.markup io ;
IN: io.server
HELP: with-client
{ $values { "quot" "a quotation" } { "client" "a client socket stream" } }
{ $description "Logs a client connection and spawns a new thread that calls the quotation, with the " { $link stdio } " stream set to the client stream. If the quotation throws an error, the client connection is closed, and the error is printed to the " { $link stdio } " stream at the time the thread was spawned." } ;
HELP: with-server
{ $values { "seq" "a sequence of address specifiers" } { "service" "a string or " { $link f } } { "quot" "a quotation" } }
{ $description "Starts a TCP/IP server. The quotation is called in a new thread for each client connection, with the client connection being the " { $link stdio } " stream. Client connections are logged to the " { $link stdio } " stream at the time the server was started." } ;

View File

@ -1,4 +1,4 @@
IN: temporary
USING: tools.test io.server ;
USING: tools.test io.server io.server.private ;
{ 1 0 } [ [ ] spawn-server ] must-infer-as
{ 1 0 } [ [ ] server-loop ] must-infer-as

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel lazy-lists tools.test strings math
sequences parser-combinators arrays math.parser unicode.categories ;
IN: scratchpad
IN: temporary
! Testing <&>
{ { T{ parse-result f { "a" "b" } T{ slice f 2 4 "abcd" } } } } [

View File

@ -15,7 +15,7 @@ IN: tools.walker.debug
[ drop ] show-walker-hook set
break
quot call
] "Walker test" spawn drop
@ -23,5 +23,9 @@ IN: tools.walker.debug
p ?promise
send-synchronous drop
detach
p ?promise
send-synchronous drop
c model-value continuation-data
] ;

View File

@ -1,7 +1,8 @@
USING: continuations documents ui.tools.interactor
ui.tools.listener hashtables kernel namespaces parser sequences
timers tools.test ui.commands ui.gadgets ui.gadgets.editors
ui.gadgets.panes vocabs words tools.test.ui slots.private ;
ui.gadgets.panes vocabs words tools.test.ui slots.private
threads ;
IN: temporary
timers [ init-timers ] unless
@ -13,7 +14,9 @@ timers [ init-timers ] unless
[ ] [ <listener-gadget> "listener" set ] unit-test
"listener" get [
[ "dup" ] [ \ dup "listener" get word-completion-string ] unit-test
[ "dup" ] [
\ dup "listener" get word-completion-string
] unit-test
[ "USE: slots.private slot" ]
[ \ slot "listener" get word-completion-string ] unit-test

View File

@ -1,79 +1,4 @@
USING: arrays continuations ui.tools.listener ui.tools.walker
ui.tools.workspace inspector kernel namespaces sequences threads
listener tools.test ui ui.gadgets ui.gadgets.worlds
ui.gadgets.packs vectors ui.tools tools.walker
tools.walker.debug tools.test.ui ;
USING: ui.tools.walker tools.test ;
IN: temporary
\ <walker> must-infer
[ ] [ <walker> "walker" set ] unit-test
"walker" get [
! Make sure the toolbar buttons don't throw if we're
! not actually walking.
[ ] [ "walker" get com-step ] unit-test
[ ] [ "walker" get com-into ] unit-test
[ ] [ "walker" get com-out ] unit-test
[ ] [ "walker" get com-back ] unit-test
[ ] [ "walker" get com-inspect ] unit-test
[ ] [ "walker" get reset-walker ] unit-test
[ ] [ "walker" get com-continue ] unit-test
] with-grafted-gadget
: <test-world> ( gadget -- world )
[ gadget, ] make-pile "Hi" f <world> ;
f <workspace> dup [
[ <test-world> 2array 1vector windows set ] keep
"ok" off
[
workspace-listener
listener-gadget-input
"ok" on
stream-read-quot
"c" get continue-with
] in-thread drop
[ t ] [ "ok" get ] unit-test
[ ] [ walker get-tool "w" set ] unit-test
continuation "c" set
[ ] [ "c" get "w" get call-tool* ] unit-test
[ ] [
[ "c" set f ] callcc1
[ "q" set ] [ "w" get com-inspect stop ] if*
] unit-test
[ t ] [
"q" get dup first continuation?
swap second \ inspect eq? and
] unit-test
] with-grafted-gadget
[
f <workspace> dup [
<test-world> 2array 1vector windows set
[ ] [
[ 2 3 break 4 ] quot>cont f swap 2array walker call-tool
] unit-test
[ ] [ walker get-tool com-continue ] unit-test
[ ] [ yield ] unit-test
[ t ] [ walker get-tool walker-active? ] unit-test
[ ] [ "walker" get com-continue ] unit-test
[ ] [ "walker" get com-continue ] unit-test
[ ] [ "walker" get com-continue ] unit-test
] with-grafted-gadget
] with-scope
\ <walker-gadget> must-infer

1
extra/xml/tests/soap.factor Normal file → Executable file
View File

@ -1,4 +1,5 @@
USING: sequences xml kernel arrays xml.utilities io.files tools.test ;
IN: temporary
: assemble-data ( tag -- 3array )
{ "URL" "snippet" "title" }