From 95a4be3522ec7b5d9fce0fee619c40575e4c63dc Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 4 Sep 2008 16:56:41 -0500
Subject: [PATCH] Fix redirection

---
 extra/http/client/client.factor |  2 +-
 extra/http/http-tests.factor    | 22 ++++++++++++++++++++++
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/extra/http/client/client.factor b/extra/http/client/client.factor
index 10b9206a51..ea1cfd9a4b 100755
--- 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 bbf8161dd7..3d0ac51e51 100755
--- 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
 [ ] [
     [