basis/tools/deploy/deploy-tests.factor

   1 IN: tools.deploy.tests\r
   2 USING: tools.test system io.files kernel tools.deploy.config\r
   3 tools.deploy.config.editor tools.deploy.backend math sequences\r
   4 io.launcher arrays namespaces continuations layouts accessors\r
   5 io.encodings.ascii urls math.parser ;\r
   6 \r
   7 : shake-and-bake ( vocab -- )\r
   8     [ "test.image" temp-file delete-file ] ignore-errors\r
   9     "resource:" [\r
  10         [ vm "test.image" temp-file ] dip\r
  11         dup deploy-config make-deploy-image\r
  12     ] with-directory ;\r
  13 \r
  14 : small-enough? ( n -- ? )\r
  15     [ "test.image" temp-file file-info size>> ] [ cell 4 / * ] bi* <= ;\r
  16 \r
  17 [ t ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test\r
  18 \r
  19 [ t ] [ "sudoku" shake-and-bake 800000 small-enough? ] unit-test\r
  20 \r
  21 [ t ] [ "hello-ui" shake-and-bake 1300000 small-enough? ] unit-test\r
  22 \r
  23 [ "staging.math-compiler-threads-ui-strip.image" ] [\r
  24     "hello-ui" deploy-config\r
  25     [ bootstrap-profile staging-image-name file-name ] bind\r
  26 ] unit-test\r
  27 \r
  28 [ t ] [ "maze" shake-and-bake 1200000 small-enough? ] unit-test\r
  29 \r
  30 [ t ] [ "tetris" shake-and-bake 1500000 small-enough? ] unit-test\r
  31 \r
  32 [ t ] [ "bunny" shake-and-bake 2500000 small-enough? ] unit-test\r
  33 \r
  34 os macosx? [\r
  35     [ t ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test\r
  36 ] when\r
  37 \r
  38 : run-temp-image ( -- )\r
  39     vm\r
  40     "-i=" "test.image" temp-file append\r
  41     2array try-process ;\r
  42 \r
  43 {\r
  44     "tools.deploy.test.1"\r
  45     "tools.deploy.test.2"\r
  46     "tools.deploy.test.3"\r
  47     "tools.deploy.test.4"\r
  48 } [\r
  49     [ ] swap [\r
  50         shake-and-bake\r
  51         run-temp-image\r
  52     ] curry unit-test\r
  53 ] each\r
  54 \r
  55 USING: http.client http.server http.server.dispatchers\r
  56 http.server.responses http.server.static io.servers.connection ;\r
  57 \r
  58 SINGLETON: quit-responder\r
  59 \r
  60 M: quit-responder call-responder*\r
  61     2drop stop-this-server "Goodbye" "text/html" <content> ;\r
  62 \r
  63 : add-quot-responder ( responder -- responder )\r
  64     quit-responder "quit" add-responder ;\r
  65 \r
  66 : test-httpd ( responder -- )\r
  67     [\r
  68         main-responder set\r
  69         <http-server>\r
  70             0 >>insecure\r
  71             f >>secure\r
  72         dup start-server*\r
  73         sockets>> first addr>> port>>\r
  74         dup number>string "resource:temp/port-number" ascii set-file-contents\r
  75     ] with-scope\r
  76     "port" set ;\r
  77 \r
  78 [ ] [\r
  79     <dispatcher>\r
  80         add-quot-responder\r
  81         "resource:basis/http/test" <static> >>default\r
  82 \r
  83     test-httpd\r
  84 ] unit-test\r
  85 \r
  86 [ ] [\r
  87     "tools.deploy.test.5" shake-and-bake\r
  88     run-temp-image\r
  89 ] unit-test\r
  90 \r
  91 : add-port ( url -- url' )\r
  92     >url clone "port" get >>port ;\r
  93 \r
  94 [ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test\r
  95 \r
  96 [ ] [\r
  97     "tools.deploy.test.6" shake-and-bake\r
  98     run-temp-image\r
  99 ] unit-test\r
 100 \r
 101 [ ] [\r
 102     "tools.deploy.test.7" shake-and-bake\r
 103     run-temp-image\r
 104 ] unit-test\r
 105 \r
 106 [ ] [\r
 107     "tools.deploy.test.8" shake-and-bake\r
 108     run-temp-image\r
 109 ] unit-test\r
 110 \r
 111 [ ] [\r
 112     "tools.deploy.test.9" shake-and-bake\r
 113     run-temp-image\r
 114 ] unit-test\r