2008-03-01 17:00:45 -05:00
|
|
|
IN: tools.deploy.tests
|
2008-02-28 02:21:30 -05:00
|
|
|
USING: tools.test system io.files kernel tools.deploy.config
|
2008-03-19 16:24:49 -04:00
|
|
|
tools.deploy.backend math sequences io.launcher arrays
|
2008-04-11 15:43:26 -04:00
|
|
|
namespaces continuations layouts accessors ;
|
2008-02-28 02:21:30 -05:00
|
|
|
|
2008-03-14 18:39:57 -04:00
|
|
|
: shake-and-bake ( vocab -- )
|
2008-03-27 12:48:51 -04:00
|
|
|
[ "test.image" temp-file delete-file ] ignore-errors
|
|
|
|
"resource:" [
|
2008-03-14 18:39:57 -04:00
|
|
|
>r vm
|
2008-03-13 04:46:25 -04:00
|
|
|
"test.image" temp-file
|
2008-03-14 18:39:57 -04:00
|
|
|
r> dup deploy-config make-deploy-image
|
2008-02-28 02:21:30 -05:00
|
|
|
] with-directory ;
|
|
|
|
|
2008-03-14 18:39:57 -04:00
|
|
|
: small-enough? ( n -- ? )
|
2008-04-11 15:09:09 -04:00
|
|
|
>r "test.image" temp-file file-info size>> r> <= ;
|
2008-03-14 18:39:57 -04:00
|
|
|
|
2008-02-28 02:21:30 -05:00
|
|
|
[ ] [ "hello-world" shake-and-bake ] unit-test
|
|
|
|
|
|
|
|
[ t ] [
|
2008-03-30 01:13:53 -04:00
|
|
|
cell 8 = 8 5 ? 100000 * small-enough?
|
2008-02-28 02:21:30 -05:00
|
|
|
] unit-test
|
|
|
|
|
2008-03-13 04:46:25 -04:00
|
|
|
[ ] [ "sudoku" shake-and-bake ] unit-test
|
|
|
|
|
|
|
|
[ t ] [
|
2008-05-31 01:07:30 -04:00
|
|
|
cell 8 = 20 10 ? 100000 * small-enough?
|
2008-03-13 04:46:25 -04:00
|
|
|
] unit-test
|
|
|
|
|
2008-02-28 02:21:30 -05:00
|
|
|
[ ] [ "hello-ui" shake-and-bake ] unit-test
|
|
|
|
|
2008-03-19 15:39:08 -04:00
|
|
|
[ "staging.math-compiler-ui-strip.image" ] [
|
2008-03-20 22:35:01 -04:00
|
|
|
"hello-ui" deploy-config
|
|
|
|
[ bootstrap-profile staging-image-name file-name ] bind
|
2008-03-19 15:39:08 -04:00
|
|
|
] unit-test
|
|
|
|
|
2008-02-28 02:21:30 -05:00
|
|
|
[ t ] [
|
2008-07-02 16:57:38 -04:00
|
|
|
cell 8 = 35 17 ? 100000 * small-enough?
|
2008-02-28 02:21:30 -05:00
|
|
|
] unit-test
|
2008-03-13 04:46:25 -04:00
|
|
|
|
2008-05-31 01:07:30 -04:00
|
|
|
[ ] [ "maze" shake-and-bake ] unit-test
|
|
|
|
|
|
|
|
[ t ] [
|
|
|
|
cell 8 = 30 15 ? 100000 * small-enough?
|
|
|
|
] unit-test
|
|
|
|
|
2008-03-13 04:46:25 -04:00
|
|
|
[ ] [ "bunny" shake-and-bake ] unit-test
|
|
|
|
|
|
|
|
[ t ] [
|
2008-04-06 02:51:04 -04:00
|
|
|
cell 8 = 50 30 ? 100000 * small-enough?
|
2008-03-13 04:46:25 -04:00
|
|
|
] unit-test
|
|
|
|
|
2008-06-18 23:29:48 -04:00
|
|
|
{
|
|
|
|
"tools.deploy.test.1"
|
|
|
|
"tools.deploy.test.2"
|
|
|
|
"tools.deploy.test.3"
|
|
|
|
"tools.deploy.test.4"
|
|
|
|
} [
|
|
|
|
[ ] swap [
|
|
|
|
shake-and-bake
|
|
|
|
vm
|
|
|
|
"-i=" "test.image" temp-file append
|
|
|
|
2array try-process
|
|
|
|
] curry unit-test
|
|
|
|
] each
|
2008-06-25 21:47:07 -04:00
|
|
|
|
|
|
|
USING: http.client furnace.actions http.server http.server.dispatchers
|
|
|
|
http.server.responses http.server.static io.servers.connection ;
|
|
|
|
|
|
|
|
: add-quit-action
|
|
|
|
<action>
|
|
|
|
[ stop-server "Goodbye" "text/html" <content> ] >>display
|
|
|
|
"quit" add-responder ;
|
|
|
|
|
|
|
|
: test-httpd ( -- )
|
|
|
|
#! Return as soon as server is running.
|
|
|
|
<http-server>
|
|
|
|
1237 >>insecure
|
|
|
|
f >>secure
|
|
|
|
start-server* ;
|
|
|
|
|
|
|
|
[ ] [
|
|
|
|
[
|
|
|
|
<dispatcher>
|
|
|
|
add-quit-action
|
|
|
|
"resource:extra/http/test" <static> >>default
|
|
|
|
main-responder set
|
|
|
|
|
|
|
|
test-httpd
|
|
|
|
] with-scope
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
[ ] [
|
|
|
|
"tools.deploy.test.5" shake-and-bake
|
|
|
|
vm
|
|
|
|
"-i=" "test.image" temp-file append
|
|
|
|
2array try-process
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
[ ] [ "http://localhost:1237/quit" http-get 2drop ] unit-test
|