57 lines
2.3 KiB
Scheme
57 lines
2.3 KiB
Scheme
#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))
|
|
|
|
)) |