Fix redirection

diff --git a/extra/http/client/client.factor b/extra/http/client/client.factor
index 10b9206a5136afe1d887d05bb80f4ca6c110f109..ea1cfd9a4b036acc3dd67c1e56b0747fb623300e 100755 (executable)
--- a/extra/http/client/client.factor
+++ b/extra/http/client/client.factor
@@ -95,7 +95,7 @@ DEFER: (http-request)
 SYMBOL: redirects
 
 : redirect-url ( request url -- request )
-    '[ , >url ensure-port derive-url ensure-port ] change-url ;
+    '[ , >url derive-url ensure-port ] change-url ;
 
 : do-redirect ( response data -- response data )
     over code>> 300 399 between? [

diff --git a/extra/http/http-tests.factor b/extra/http/http-tests.factor
index bbf8161dd7dbe1d1e0d976e718b25686fc66391e..3d0ac51e5101c7dffd34260b59aa017981e85833 100755 (executable)
--- a/extra/http/http-tests.factor
+++ b/extra/http/http-tests.factor
@@ -225,6 +225,28 @@ test-db [
     "http://localhost:1237/quit" http-get nip
 ] unit-test
 
+! HTTP client redirect bug
+[ ] [
+    [
+        <dispatcher>
+            add-quit-action
+            <action> [ "quit" <temporary-redirect> ] >>display
+            "redirect" add-responder
+        main-responder set
+
+        test-httpd
+    ] with-scope
+] unit-test
+
+[ "Goodbye" ] [
+    "http://localhost:1237/redirect" http-get nip
+] unit-test
+
+
+[ ] [
+    [ "http://localhost:1237/quit" http-get 2drop ] ignore-errors
+] unit-test
+
 ! Dispatcher bugs
 [ ] [
     [