From 6c4abbcabf6beb7677076d7fa8d7234b56b53c40 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Tue, 27 May 2008 16:30:44 +0000
Subject: [PATCH] up

svn: r9979
---
 collects/web-server/private/util.ss           |  2 +-
 .../dispatchers/all-dispatchers-tests.ss      |  2 +
 .../tests/dispatchers/dispatch-host-test.ss   | 57 +++++++++++++++++++
 3 files changed, 60 insertions(+), 1 deletion(-)
 create mode 100644 collects/web-server/tests/dispatchers/dispatch-host-test.ss

diff --git a/collects/web-server/private/util.ss b/collects/web-server/private/util.ss
index cf22c99364..fcf17aa97f 100644
--- a/collects/web-server/private/util.ss
+++ b/collects/web-server/private/util.ss
@@ -158,7 +158,7 @@
    (string-downcase
     (if (bytes? s)
         (bytes->string/utf-8 s)
-        (string-copy s)))))
+        s))))
 
 (define (directory-part path)
   (let-values ([(base name must-be-dir) (split-path path)])
diff --git a/collects/web-server/tests/dispatchers/all-dispatchers-tests.ss b/collects/web-server/tests/dispatchers/all-dispatchers-tests.ss
index 6818c014a4..79d213922e 100644
--- a/collects/web-server/tests/dispatchers/all-dispatchers-tests.ss
+++ b/collects/web-server/tests/dispatchers/all-dispatchers-tests.ss
@@ -4,6 +4,7 @@
          "dispatch-files-test.ss"        
          "dispatch-servlets-test.ss"
          "dispatch-lang-test.ss"         
+         "dispatch-host-test.ss"
          "filesystem-map-test.ss")
 (provide all-dispatchers-tests)
 
@@ -11,6 +12,7 @@
   (test-suite
    "Dispatchers"
    dispatch-passwords-tests
+   dispatch-host-tests
    dispatch-files-tests
    dispatch-servlets-tests
    dispatch-lang-tests
diff --git a/collects/web-server/tests/dispatchers/dispatch-host-test.ss b/collects/web-server/tests/dispatchers/dispatch-host-test.ss
new file mode 100644
index 0000000000..f47d216c9b
--- /dev/null
+++ b/collects/web-server/tests/dispatchers/dispatch-host-test.ss
@@ -0,0 +1,57 @@
+#lang scheme/base
+(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
+         (planet "util.ss" ("schematics" "schemeunit.plt" 2))
+         (only-in mzlib/file
+                  make-temporary-file)
+         net/url
+         mzlib/list
+         (lib "request-structs.ss" "web-server" "private")
+         (lib "dispatch.ss" "web-server" "dispatchers")
+         (prefix-in host: (lib "dispatch-host.ss" "web-server" "dispatchers")))
+(provide dispatch-host-tests)
+
+(require/expose (lib "dispatch-host.ss" "web-server" "dispatchers")
+                (get-host))
+
+(define lower-url (make-url #f #f "www.plt-scheme.org" #f #t empty empty #f))
+(define upper-url (make-url #f #f "www.PLT-scheme.org" #f #t empty empty #f))
+(define no-host-url (make-url #f #f #f #f #t empty empty #f))
+
+(define dispatch-host-tests
+  (test-suite
+   "Host"
+   
+   (test-equal? "get-host - uri - lower"
+                'www.plt-scheme.org
+                (get-host lower-url empty))
+   
+   (test-equal? "get-host - uri - upper"
+                'www.plt-scheme.org
+                (get-host upper-url empty))
+   
+   (test-equal? "get-host - headers - lower key - lower val"
+                'www.plt-scheme.org
+                (get-host no-host-url (list (make-header #"host" #"www.plt-scheme.org"))))
+   (test-equal? "get-host - headers - lower key - upper val"
+                'www.plt-scheme.org
+                (get-host no-host-url (list (make-header #"host" #"www.PLT-scheme.org"))))
+
+   (test-equal? "get-host - headers - upper key - lower val"
+                'www.plt-scheme.org
+                (get-host no-host-url (list (make-header #"Host" #"www.plt-scheme.org"))))
+   (test-equal? "get-host - headers - upper key - upper val"
+                'www.plt-scheme.org
+                (get-host no-host-url (list (make-header #"Host" #"www.PLT-scheme.org"))))
+
+   (test-equal? "get-host - headers - caps key - lower val"
+                'www.plt-scheme.org
+                (get-host no-host-url (list (make-header #"HOST" #"www.plt-scheme.org"))))
+   (test-equal? "get-host - headers - caps key - upper val"
+                'www.plt-scheme.org
+                (get-host no-host-url (list (make-header #"HOST" #"www.PLT-scheme.org"))))
+   
+   (test-equal? "get-host - none"
+                'none
+                (get-host no-host-url empty))
+   
+   ))
\ No newline at end of file