]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/smtp/smtp-tests.factor
arm.64.factor: extra semicolon removed
[factor.git] / basis / smtp / smtp-tests.factor
index f4cb3e572af1e66686fdd6fa55f2209231940c2e..a00ebea05ac1ca387da513ccedbcc6b449136c73 100644 (file)
@@ -1,7 +1,7 @@
-USING: smtp tools.test io.streams.string io.sockets
-io.sockets.secure threads smtp.server kernel sequences
-namespaces logging accessors assocs sorting smtp.private
-concurrency.promises system ;
+USING: accessors assocs calendar combinators concurrency.promises
+continuations fry io.sockets io.sockets.secure io.streams.string
+kernel namespaces sequences smtp smtp.private smtp.server
+sorting system tools.test ;
 IN: smtp.tests
 
 : with-test-smtp-config ( quot -- )
@@ -10,7 +10,7 @@ IN: smtp.tests
         "p" get mock-smtp-server
 
         default-smtp-config
-            "localhost" "p" get ?promise <inet> >>server
+            "localhost" "p" get 5 seconds ?promise-timeout <inet> >>server
             no-auth >>auth
             os unix? [ t >>tls? ] when
         \ smtp-config
@@ -20,34 +20,34 @@ IN: smtp.tests
 
 [ "hello\nworld" validate-address ] must-fail
 
-[ "slava@factorcode.org" ]
+{ "slava@factorcode.org" }
 [ "slava@factorcode.org" validate-address ] unit-test
 
-[ "aGVsbG8Kd29ybGQ=\r\n.\r\n" ] [
+{ "aGVsbG8Kd29ybGQ=\r\n.\r\n" } [
     T{ email { body "hello\nworld" } } [ send-body ] with-string-writer
 ] unit-test
 
 [ { "500 syntax error" } <response> check-response ]
 [ smtp-error? ] must-fail-with
 
-[ ] [ { "220 success" } <response> check-response ] unit-test
+{ } [ { "220 success" } <response> check-response ] unit-test
 
-[ T{ response f 220 { "220 success" } } ] [
+{ T{ response f 220 { "220 success" } } } [
     "220 success" [ receive-response ] with-string-reader
 ] unit-test
 
-[
+{
     T{ response f 220 {
         "220-a multiline response"
         "250-another line"
         "220 the end"
     } }
-] [
+} [
     "220-a multiline response\r\n250-another line\r\n220 the end"
     [ receive-response ] with-string-reader
 ] unit-test
 
-[ ] [
+{ } [
     "220-a multiline response\r\n250-another line\r\n220 the end"
     [ get-ok ] with-string-reader
 ] unit-test
@@ -56,7 +56,7 @@ IN: smtp.tests
     "Subject:\r\nsecurity hole" validate-header
 ] must-fail
 
-[
+{
     {
         { "Content-Transfer-Encoding" "base64" }
         { "Content-Type" "text/plain; charset=UTF-8" }
@@ -67,7 +67,7 @@ IN: smtp.tests
     }
     { "slava@factorcode.org" "dharmatech@factorcode.org" }
     "erg@factorcode.org"
-] [
+} [
     [
         <email>
             "Factor rules" >>subject
@@ -76,17 +76,21 @@ IN: smtp.tests
                 "Ed <dharmatech@factorcode.org>"
             } >>to
             "Doug <erg@factorcode.org>" >>from
-        [
-            email>headers sort-keys [
-                drop { "Date" "Message-Id" } member? not
-            ] assoc-filter
-        ]
-        [ to>> [ extract-email ] map ]
-        [ from>> extract-email ] tri
+        {
+            [
+                email>headers sort-keys [
+                    { "Date" "Message-Id" } member? not
+                ] filter-keys
+            ]
+            [ to>> [ extract-email ] map ]
+            [ from>> extract-email ]
+            ! To get the smtp server to clean up itself
+            [ '[ _ send-email ] ignore-errors ]
+        } cleave
     ] with-test-smtp-config
 ] unit-test
 
-[ ] [
+{ } [
     <secure-config> f >>verify [
         [
             <email>