extra/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.backend math sequences io.launcher arrays\r
   4 namespaces continuations layouts accessors ;\r
   5 \r
   6 : shake-and-bake ( vocab -- )\r
   7     [ "test.image" temp-file delete-file ] ignore-errors\r
   8     "resource:" [\r
   9         >r vm\r
  10         "test.image" temp-file\r
  11         r> dup deploy-config make-deploy-image\r
  12     ] with-directory ;\r
  13 \r
  14 : small-enough? ( n -- ? )\r
  15     >r "test.image" temp-file file-info size>> r> <= ;\r
  16 \r
  17 [ ] [ "hello-world" shake-and-bake ] unit-test\r
  18 \r
  19 [ t ] [\r
  20     cell 8 = 8 5 ? 100000 * small-enough?\r
  21 ] unit-test\r
  22 \r
  23 [ ] [ "sudoku" shake-and-bake ] unit-test\r
  24 \r
  25 [ t ] [\r
  26     cell 8 = 20 10 ? 100000 * small-enough?\r
  27 ] unit-test\r
  28 \r
  29 [ ] [ "hello-ui" shake-and-bake ] unit-test\r
  30 \r
  31 [ "staging.math-compiler-ui-strip.image" ] [\r
  32     "hello-ui" deploy-config\r
  33     [ bootstrap-profile staging-image-name file-name ] bind\r
  34 ] unit-test\r
  35 \r
  36 [ t ] [\r
  37     cell 8 = 35 17 ? 100000 * small-enough?\r
  38 ] unit-test\r
  39 \r
  40 [ ] [ "maze" shake-and-bake ] unit-test\r
  41 \r
  42 [ t ] [\r
  43     cell 8 = 30 15 ? 100000 * small-enough?\r
  44 ] unit-test\r
  45 \r
  46 [ ] [ "bunny" shake-and-bake ] unit-test\r
  47 \r
  48 [ t ] [\r
  49     cell 8 = 50 30 ? 100000 * small-enough?\r
  50 ] unit-test\r
  51 \r
  52 {\r
  53     "tools.deploy.test.1"\r
  54     "tools.deploy.test.2"\r
  55     "tools.deploy.test.3"\r
  56     "tools.deploy.test.4"\r
  57 } [\r
  58     [ ] swap [\r
  59         shake-and-bake\r
  60         vm\r
  61         "-i=" "test.image" temp-file append\r
  62         2array try-process\r
  63     ] curry unit-test\r
  64 ] each\r
  65 \r
  66 USING: http.client http.server http.server.dispatchers\r
  67 http.server.responses http.server.static io.servers.connection ;\r
  68 \r
  69 SINGLETON: quit-responder\r
  70 \r
  71 M: quit-responder call-responder*\r
  72     2drop stop-server "Goodbye" "text/html" <content> ;\r
  73 \r
  74 : add-quot-responder ( responder -- responder )\r
  75     quit-responder "quit" add-responder ;\r
  76 \r
  77 : test-httpd ( -- )\r
  78     #! Return as soon as server is running.\r
  79     <http-server>\r
  80         1237 >>insecure\r
  81         f >>secure\r
  82     start-server* ;\r
  83 \r
  84 [ ] [\r
  85     [\r
  86         <dispatcher>\r
  87             add-quot-responder\r
  88             "resource:extra/http/test" <static> >>default\r
  89         main-responder set\r
  90 \r
  91         test-httpd\r
  92     ] with-scope\r
  93 ] unit-test\r
  94 \r
  95 [ ] [\r
  96     "tools.deploy.test.5" shake-and-bake\r
  97     vm\r
  98     "-i=" "test.image" temp-file append\r
  99     2array try-process\r
 100 ] unit-test\r
 101 \r
 102 [ ] [ "http://localhost:1237/quit" http-get 2drop ] unit-test\r