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

Unit tests no longer use hard-coded ports

db4
Slava Pestov 2008-10-20 22:05:22 -05:00
parent d7ad12207c
commit 1df08ba8c8
4 changed files with 109 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
basis/http/http-tests.factor
View File

@ -192,15 +192,17 @@ test-db [
init-furnace-tables init-furnace-tables
] with-db ] with-db
: test-httpd ( -- ) : test-httpd ( responder -- )
#! Return as soon as server is running. [
main-responder set
<http-server> <http-server>
1237 >>insecure 0 >>insecure
f >>secure f >>secure
start-server* ; dup start-server*
sockets>> first addr>> port>>
] with-scope "port" set ;
[ ] [ [ ] [
[
<dispatcher> <dispatcher>
add-quit-action add-quit-action
<dispatcher> <dispatcher>
@ -209,49 +211,46 @@ test-db [
<action> <action>
[ URL" redirect-loop" <temporary-redirect> ] >>display [ URL" redirect-loop" <temporary-redirect> ] >>display
"redirect-loop" add-responder "redirect-loop" add-responder
main-responder set
test-httpd test-httpd
] with-scope
] unit-test ] unit-test
: add-port ( url -- url' )
>url clone "port" get >>port ;
[ t ] [ [ t ] [
"resource:basis/http/test/foo.html" ascii file-contents "resource:basis/http/test/foo.html" ascii file-contents
"http://localhost:1237/nested/foo.html" http-get nip = "http://localhost/nested/foo.html" add-port http-get nip =
] unit-test ] unit-test
[ "http://localhost:1237/redirect-loop" http-get nip ] [ "http://localhost/redirect-loop" add-port http-get nip ]
[ too-many-redirects? ] must-fail-with [ too-many-redirects? ] must-fail-with
[ "Goodbye" ] [ [ "Goodbye" ] [
"http://localhost:1237/quit" http-get nip "http://localhost/quit" add-port http-get nip
] unit-test ] unit-test
! HTTP client redirect bug ! HTTP client redirect bug
[ ] [ [ ] [
[
<dispatcher> <dispatcher>
add-quit-action add-quit-action
<action> [ "quit" <temporary-redirect> ] >>display <action> [ "quit" <temporary-redirect> ] >>display
"redirect" add-responder "redirect" add-responder
main-responder set
test-httpd test-httpd
] with-scope
] unit-test ] unit-test
[ "Goodbye" ] [ [ "Goodbye" ] [
"http://localhost:1237/redirect" http-get nip "http://localhost/redirect" add-port http-get nip
] unit-test ] unit-test
[ ] [ [ ] [
[ "http://localhost:1237/quit" http-get 2drop ] ignore-errors [ "http://localhost/quit" add-port http-get 2drop ] ignore-errors
] unit-test ] unit-test
! Dispatcher bugs ! Dispatcher bugs
[ ] [ [ ] [
[
<dispatcher> <dispatcher>
<action> <protected> <action> <protected>
"Test" <login-realm> "Test" <login-realm>
@ -262,24 +261,21 @@ test-db [
<action> "" add-responder <action> "" add-responder
"d" add-responder "d" add-responder
test-db <db-persistence> test-db <db-persistence>
main-responder set
test-httpd test-httpd
] with-scope
] unit-test ] unit-test
: 404? [ download-failed? ] [ response>> code>> 404 = ] bi and ; : 404? [ download-failed? ] [ response>> code>> 404 = ] bi and ;
! This should give a 404 not an infinite redirect loop ! This should give a 404 not an infinite redirect loop
[ "http://localhost:1237/d/blah" http-get nip ] [ 404? ] must-fail-with [ "http://localhost/d/blah" add-port http-get nip ] [ 404? ] must-fail-with
! This should give a 404 not an infinite redirect loop ! This should give a 404 not an infinite redirect loop
[ "http://localhost:1237/blah/" http-get nip ] [ 404? ] must-fail-with [ "http://localhost/blah/" add-port http-get nip ] [ 404? ] must-fail-with
[ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test [ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
[ ] [ [ ] [
[
<dispatcher> <dispatcher>
<action> [ [ "Hi" write ] "text/plain" <content> ] >>display <action> [ [ "Hi" write ] "text/plain" <content> ] >>display
"Test" <login-realm> "Test" <login-realm>
@ -287,15 +283,13 @@ test-db [
"" add-responder "" add-responder
add-quit-action add-quit-action
test-db <db-persistence> test-db <db-persistence>
main-responder set
test-httpd test-httpd
] with-scope
] unit-test ] unit-test
[ "Hi" ] [ "http://localhost:1237/" http-get nip ] unit-test [ "Hi" ] [ "http://localhost/" add-port http-get nip ] unit-test
[ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test [ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
USING: html.components html.elements html.forms USING: html.components html.elements html.forms
xml xml.utilities validators xml xml.utilities validators
@ -304,7 +298,6 @@ furnace furnace.conversations ;
SYMBOL: a SYMBOL: a
[ ] [ [ ] [
[
<dispatcher> <dispatcher>
<action> <action>
[ a get-global "a" set-value ] >>init [ a get-global "a" set-value ] >>init
@ -316,10 +309,8 @@ SYMBOL: a
>>default >>default
add-quit-action add-quit-action
test-db <db-persistence> test-db <db-persistence>
main-responder set
test-httpd test-httpd
] with-scope
] unit-test ] unit-test
3 a set-global 3 a set-global
@ -327,27 +318,35 @@ SYMBOL: a
: test-a string>xml "input" tag-named "value" swap at ; : test-a string>xml "input" tag-named "value" swap at ;
[ "3" ] [ [ "3" ] [
"http://localhost:1237/" http-get "http://localhost/" add-port http-get
swap dup cookies>> "cookies" set session-id-key get-cookie swap dup cookies>> "cookies" set session-id-key get-cookie
value>> "session-id" set test-a value>> "session-id" set test-a
] unit-test ] unit-test
[ "4" ] [ [ "4" ] [
H{ { "a" "4" } { "__u" "http://localhost:1237/" } } "session-id" get session-id-key associate assoc-union [
"http://localhost:1237/" <post-request> "cookies" get >>cookies http-request nip test-a "4" "a" set
"http://localhost" add-port "__u" set
"session-id" get session-id-key set
] H{ } make-assoc
"http://localhost/" add-port <post-request> "cookies" get >>cookies http-request nip test-a
] unit-test ] unit-test
[ 4 ] [ a get-global ] unit-test [ 4 ] [ a get-global ] unit-test
! Test flash scope ! Test flash scope
[ "xyz" ] [ [ "xyz" ] [
H{ { "a" "xyz" } { "__u" "http://localhost:1237/" } } "session-id" get session-id-key associate assoc-union [
"http://localhost:1237/" <post-request> "cookies" get >>cookies http-request nip test-a "xyz" "a" set
"http://localhost" add-port "__u" set
"session-id" get session-id-key set
] H{ } make-assoc
"http://localhost/" add-port <post-request> "cookies" get >>cookies http-request nip test-a
] unit-test ] unit-test
[ 4 ] [ a get-global ] unit-test [ 4 ] [ a get-global ] unit-test
[ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test [ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
! Test cloning ! Test cloning
[ f ] [ <404> dup clone "b" "a" set-header drop "a" header ] unit-test [ f ] [ <404> dup clone "b" "a" set-header drop "a" header ] unit-test

19
basis/io/servers/connection/connection-tests.factor
View File

@ -27,25 +27,12 @@ concurrency.promises io.encodings.ascii io threads calendar ;
init-server semaphore>> count>> init-server semaphore>> count>>
] unit-test ] unit-test
[ ] [ <promise> "p" set ] unit-test
[ ] [ [ ] [
<threaded-server> <threaded-server>
5 >>max-connections 5 >>max-connections
1237 >>insecure 0 >>insecure
[ "Hello world." write stop-this-server ] >>handler [ "Hello world." write stop-this-server ] >>handler
"server" set dup start-server* sockets>> first addr>> port>> "port" set
] unit-test ] unit-test
[ ] [ [ "Hello world." ] [ "localhost" "port" get <inet> ascii <client> drop contents ] unit-test
[
"server" get start-server
t "p" get fulfill
] in-thread
] unit-test
[ ] [ "server" get wait-for-server ] unit-test
[ "Hello world." ] [ "localhost" 1237 <inet> ascii <client> drop contents ] unit-test
[ t ] [ "p" get 2 seconds ?promise-timeout ] unit-test

26
basis/tools/deploy/deploy-tests.factor
View File

@ -1,7 +1,8 @@
IN: tools.deploy.tests IN: tools.deploy.tests
USING: tools.test system io.files kernel tools.deploy.config USING: tools.test system io.files kernel tools.deploy.config
tools.deploy.backend math sequences io.launcher arrays tools.deploy.backend math sequences io.launcher arrays
namespaces continuations layouts accessors ; namespaces continuations layouts accessors io.encodings.ascii
urls math.parser ;
: shake-and-bake ( vocab -- ) : shake-and-bake ( vocab -- )
[ "test.image" temp-file delete-file ] ignore-errors [ "test.image" temp-file delete-file ] ignore-errors
@ -38,7 +39,7 @@ namespaces continuations layouts accessors ;
! [ ] [ "tetris" shake-and-bake ] unit-test ! [ ] [ "tetris" shake-and-bake ] unit-test
! !
! [ t ] [ 1500000 small-enough? ] unit-test ! [ t ] [ 1500000 small-enough? ] unit-test
!
[ ] [ "bunny" shake-and-bake ] unit-test [ ] [ "bunny" shake-and-bake ] unit-test
[ t ] [ 2500000 small-enough? ] unit-test [ t ] [ 2500000 small-enough? ] unit-test
@ -71,22 +72,24 @@ M: quit-responder call-responder*
: add-quot-responder ( responder -- responder ) : add-quot-responder ( responder -- responder )
quit-responder "quit" add-responder ; quit-responder "quit" add-responder ;
: test-httpd ( -- ) : test-httpd ( responder -- )
#! Return as soon as server is running. [
main-responder set
<http-server> <http-server>
1237 >>insecure 0 >>insecure
f >>secure f >>secure
start-server* ; dup start-server*
sockets>> first addr>> port>>
dup number>string "resource:temp/port-number" ascii set-file-contents
] with-scope
"port" set ;
[ ] [ [ ] [
[
<dispatcher> <dispatcher>
add-quot-responder add-quot-responder
"resource:basis/http/test" <static> >>default "resource:basis/http/test" <static> >>default
main-responder set
test-httpd test-httpd
] with-scope
] unit-test ] unit-test
[ ] [ [ ] [
@ -94,7 +97,10 @@ M: quit-responder call-responder*
run-temp-image run-temp-image
] unit-test ] unit-test
[ ] [ "http://localhost:1237/quit" http-get 2drop ] unit-test : add-port ( url -- url' )
>url clone "port" get >>port ;
[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test
[ ] [ [ ] [
"tools.deploy.test.6" shake-and-bake "tools.deploy.test.6" shake-and-bake

7
basis/tools/deploy/test/5/5.factor
View File

@ -1,7 +1,10 @@
IN: tools.deploy.test.5 IN: tools.deploy.test.5
USING: http.client kernel ; USING: accessors urls io.encodings.ascii io.files math.parser
http.client kernel ;
: deploy-test-5 ( -- ) : deploy-test-5 ( -- )
"http://localhost:1237/foo.html" http-get 2drop ; URL" http://localhost/foo.html" clone
"resource:port-number" ascii file-contents string>number >>port
http-get 2drop ;
MAIN: deploy-test-5 MAIN: deploy-test-5