Fixing deployment tests

extra/bunny/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-word-defs? f }
+    { deploy-math? t }
+    { deploy-reflection 2 }
+    { deploy-io 3 }
+    { deploy-c-types? f }
     { deploy-random? f }
+    { deploy-ui? t }
     { deploy-name "Bunny" }
+    { deploy-word-defs? f }
+    { "stop-after-last-window?" t }
     { deploy-threads? t }
     { deploy-compiler? t }
-    { deploy-math? t }
-    { deploy-c-types? f }
-    { deploy-io 3 }
-    { deploy-reflection 1 }
-    { deploy-ui? t }
-    { "stop-after-last-window?" t }
     { deploy-word-props? f }
 }

extra/http/http-tests.factor

@@ -215,7 +215,7 @@ test-db [
 
 [ t ] [
     "resource:extra/http/test/foo.html" ascii file-contents
-    "http://localhost:1237/nested/foo.html" http-get nip ascii decode =
+    "http://localhost:1237/nested/foo.html" http-get nip =
 ] unit-test
 
 [ "http://localhost:1237/redirect-loop" http-get nip ]

extra/tools/deploy/deploy-tests.factor

@@ -62,3 +62,38 @@ namespaces continuations layouts accessors ;
         2array try-process
     ] curry unit-test
 ] each
+
+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

extra/tools/deploy/shaker/shaker.factor

@@ -69,26 +69,69 @@ IN: tools.deploy.shaker
     [ "no-def-strip" word-prop not ] filter
     [ [ ] swap set-word-def ] each ;
 
-: strip-word-props ( retain-props words -- )
+: strip-word-props ( stripped-props words -- )
     "Stripping word properties" show
     [
         [
             word-props swap
-            '[ , nip member? ] assoc-filter
+            '[ , nip member? not ] assoc-filter
             f assoc-like
         ] keep set-word-props
     ] with each ;
 
-: retained-props ( -- seq )
+: stripped-word-props ( -- seq )
     [
-        "class" ,
+        strip-dictionary? [
-        "metaclass" ,
+            {
-        "layout" ,
+                "coercer"
-        deploy-ui? get [
+                "compiled-effect"
-            "gestures" ,
+                "compiled-uses"
-            "commands" ,
+                "constraints"
-            { "+nullary+" "+listener+" "+description+" }
+                "declared-effect"
-            [ "ui.commands" lookup , ] each
+                "default-output-classes"
+                "identities"
+                "if-intrinsics"
+                "infer"
+                "inferred-effect"
+                "interval"
+                "intrinsics"
+                "loc"
+                "members"
+                "methods"
+                "combination"
+                "cannot-infer"
+                "default-method"
+                "optimizer-hooks"
+                "output-classes"
+                "participants"
+                "predicate"
+                "predicate-definition"
+                "predicating"
+                "slots"
+                "slot-names"
+                "specializer"
+                "step-into"
+                "step-into?"
+                "superclass"
+                "reading"
+                "writing"
+                "type"
+                "engines"
+            } %
+        ] when
+        
+        strip-prettyprint? [
+            {
+                "delimiter"
+                "flushable"
+                "foldable"
+                "inline"
+                "lambda"
+                "macro"
+                "memo-quot"
+                "parsing"
+                "word-style"
+            } %
         ] when
     ] { } make ;
 
@@ -134,11 +177,11 @@ IN: tools.deploy.shaker
 
         strip-io? [ io.backend:io-backend , ] when
 
-        [
+        { } {
-            io.backend:io-backend ,
+            "alarms"
-            "default-buffer-size" "io.ports" lookup ,
+            "tools"
-        ] { } make
+            "io.launcher"
-        { "alarms" "io" "tools" } strip-vocab-globals %
+        } strip-vocab-globals %
 
         strip-dictionary? [
             { } { "cpu" } strip-vocab-globals %
@@ -243,7 +286,7 @@ SYMBOL: deploy-vocab
     strip-recompile-hook
     strip-init-hooks
     deploy-vocab get vocab-main set-boot-quot*
-    retained-props >r
+    stripped-word-props >r
     stripped-globals strip-globals
     r> strip-words ;
 

extra/tools/deploy/test/4/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
     { deploy-math? f }
-    { deploy-ui? f }
+    { deploy-reflection 1 }
-    { deploy-compiler? t }
-    { deploy-word-props? f }
-    { deploy-word-defs? f }
     { deploy-io 2 }
-    { deploy-name "tools.deploy.test.4" }
     { deploy-c-types? f }
     { deploy-random? f }
+    { deploy-ui? f }
+    { deploy-name "tools.deploy.test.4" }
+    { deploy-word-defs? f }
     { "stop-after-last-window?" t }
     { deploy-threads? t }
-    { deploy-reflection 1 }
+    { deploy-compiler? t }
+    { deploy-word-props? f }
 }

extra/tools/deploy/test/5/5.factor

@@ -0,0 +1,7 @@
+IN: tools.deploy.test.5
+USING: http.client kernel ;
+
+: deploy-test-5 ( -- )
+    "http://localhost:1237/foo.html" http-get 2drop ;
+
+MAIN: deploy-test-5

extra/tools/deploy/test/5/deploy.factor

@@ -0,0 +1,15 @@
+USING: tools.deploy.config ;
+H{
+    { deploy-math? t }
+    { deploy-reflection 2 }
+    { deploy-io 3 }
+    { deploy-c-types? f }
+    { deploy-random? t }
+    { deploy-ui? f }
+    { deploy-name "tools.deploy.test.5" }
+    { deploy-word-defs? f }
+    { "stop-after-last-window?" t }
+    { deploy-threads? t }
+    { deploy-compiler? t }
+    { deploy-word-props? f }
+}