basis/tools/deploy/deploy-tests.factor

   1 USING: bootstrap.image tools.test system io io.encodings.ascii
   2 io.pathnames io.files io.files.info io.files.temp kernel
   3 tools.deploy.config tools.deploy.config.editor
   4 tools.deploy.backend math sequences io.launcher arrays
   5 namespaces continuations layouts accessors urls math.parser
   6 io.directories splitting tools.deploy tools.deploy.test vocabs ;
   7
   8 IN: tools.deploy.tests
   9
  10 ! Delete all cached staging images in case syntax or
  11 ! other core vocabularies have changed and staging
  12 ! images are stale.
  13 delete-staging-images
  14
  15 [ "nosuchvocab" deploy ] [ no-vocab? ] must-fail-with
  16
  17 [ "no such vocab, fool!" deploy ] [ bad-vocab-name? ] must-fail-with
  18
  19 { } [ "hello-world" shake-and-bake 550000 small-enough? ] unit-test
  20
  21 { } [ "sudoku" shake-and-bake 800000 small-enough? ] unit-test
  22
  23 ! [ ] [ "hello-ui" shake-and-bake 1605000 small-enough? ] unit-test
  24 { } [ "hello-ui" shake-and-bake 2069160 small-enough? ] unit-test
  25
  26 { "math-threads-compiler-io-ui" } [
  27     "hello-ui" deploy-config [
  28         bootstrap-profile staging-image-name file-name
  29         "." split second
  30     ] with-variables
  31 ] unit-test
  32
  33 ! [ ] [ "maze" shake-and-bake 1520000 small-enough? ] unit-test
  34 { } [ "maze" shake-and-bake 2000000 small-enough? ] unit-test
  35
  36 ! [ ] [ "tetris" shake-and-bake 1734000 small-enough? ] unit-test
  37 { } [ "tetris" shake-and-bake 2186392 small-enough? ] unit-test
  38
  39 ! [ ] [ "spheres" shake-and-bake 1557000 small-enough? ] unit-test
  40 { } [ "spheres" shake-and-bake 2031096 small-enough? ] unit-test
  41
  42 ! [ ] [ "terrain" shake-and-bake 2053000 small-enough? ] unit-test
  43 { } [ "terrain" shake-and-bake 2671928 small-enough? ] unit-test
  44
  45 ! [ ] [ "gpu.demos.raytrace" shake-and-bake 2764000 small-enough? ] unit-test
  46 { } [ "gpu.demos.raytrace" shake-and-bake 3307816 small-enough? ] unit-test
  47
  48 { } [ "bunny" shake-and-bake 2500000 small-enough? ] unit-test
  49
  50 { } [ "gpu.demos.bunny" shake-and-bake 3500000 small-enough? ] unit-test
  51
  52 os macosx? [
  53     [ ] [ "webkit-demo" shake-and-bake 600000 small-enough? ] unit-test
  54 ] when
  55
  56 { } [ "benchmark.regex-dna" shake-and-bake 900000 small-enough? ] unit-test
  57
  58 {
  59     "tools.deploy.test.1"
  60     "tools.deploy.test.2"
  61     "tools.deploy.test.3"
  62     "tools.deploy.test.4"
  63 } [
  64     [ ] swap [
  65         shake-and-bake
  66         run-temp-image
  67     ] curry unit-test
  68 ] each
  69
  70 USING: http.client http.server http.server.dispatchers
  71 http.server.responses http.server.static io.servers ;
  72
  73 SINGLETON: quit-responder
  74
  75 M: quit-responder call-responder*
  76     2drop stop-this-server "Goodbye" <html-content> ;
  77
  78 : add-quot-responder ( responder -- responder )
  79     quit-responder "quit" add-responder ;
  80
  81 : test-httpd ( responder -- )
  82     [
  83         main-responder set
  84         <http-server>
  85             0 >>insecure
  86             f >>secure
  87         start-server
  88         servers>> first addr>> port>>
  89         dup number>string "port-number" temp-file ascii set-file-contents
  90     ] with-scope
  91     "port" set ;
  92
  93 { } [
  94     <dispatcher>
  95         add-quot-responder
  96         "vocab:http/test" <static> >>default
  97
  98     test-httpd
  99 ] unit-test
 100
 101 { } [
 102     "tools.deploy.test.5" shake-and-bake
 103     run-temp-image
 104 ] unit-test
 105
 106 : add-port ( url -- url' )
 107     >url clone "port" get >>port ;
 108
 109 { } [ "http://localhost/quit" add-port http-get 2drop ] unit-test
 110
 111 {
 112     "tools.deploy.test.6"
 113     "tools.deploy.test.7"
 114     "tools.deploy.test.9"
 115     "tools.deploy.test.10"
 116     "tools.deploy.test.11"
 117     "tools.deploy.test.12"
 118 } [
 119     [ ] swap [
 120         shake-and-bake
 121         run-temp-image
 122     ] curry unit-test
 123 ] each
 124
 125 os windows? os macosx? or [
 126     [ ] [ "tools.deploy.test.8" shake-and-bake run-temp-image ] unit-test
 127 ] when
 128
 129 os macosx? [
 130     [ ] [ "tools.deploy.test.14" shake-and-bake run-temp-image ] unit-test
 131 ] when
 132
 133 { { "a" "b" "c" } } [
 134     "tools.deploy.test.15" shake-and-bake deploy-test-command
 135     { "a" "b" "c" } append
 136     ascii [ lines ] with-process-reader
 137     rest
 138 ] unit-test
 139
 140 { } [ "tools.deploy.test.16" shake-and-bake run-temp-image ] unit-test
 141
 142 { } [ "tools.deploy.test.17" shake-and-bake run-temp-image ] unit-test
 143
 144 { t } [
 145     "tools.deploy.test.18" shake-and-bake
 146     deploy-test-command ascii [ readln ] with-process-reader
 147     test-image temp-file =
 148 ] unit-test
 149
 150 { } [ "resource:license.txt" "license.txt" temp-file copy-file ] unit-test
 151
 152 { } [ "tools.deploy.test.19" shake-and-bake run-temp-image ] unit-test
 153
 154 { } [ "tools.deploy.test.20" shake-and-bake ] unit-test
 155
 156 { "<?xml version=\"1.0\" encoding=\"UTF-8\"?><foo>Factor</foo>" }
 157 [ deploy-test-command ascii [ readln ] with-process-reader ] unit-test
 158
 159 ! [ ] [ "tools.deploy.test.20" drop 1353000 small-enough? ] unit-test
 160 { } [ "tools.deploy.test.20" drop 1363000 small-enough? ] unit-test
 161
 162 { } [ "tools.deploy.test.21" shake-and-bake ] unit-test
 163
 164 { "1 2 3" }
 165 [ deploy-test-command ascii [ readln ] with-process-reader ] unit-test
 166
 167 { } [ "tools.deploy.test.21" drop 1260000 small-enough? ] unit-test
 168
 169 { } [ "benchmark.ui-panes" shake-and-bake run-temp-image ] unit-test