.
original commit: 1bb504e64b4e8d26f80db774d624c3273925e3fb
This commit is contained in:
Robby Findler
parent
41243281d4
commit
c87684a141
|
|
@ -3,68 +3,112 @@
|
|||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; url parsing tests
|
||||
;; url.ss tests
|
||||
;;
|
||||
|
||||
(require (lib "url.ss" "net"))
|
||||
|
||||
(let ()
|
||||
(define (test-s->u vec str)
|
||||
(define (string->url/vec str)
|
||||
(let ([res (string->url str)])
|
||||
(vector (url-scheme res)
|
||||
(url-user res)
|
||||
(url-host res)
|
||||
(url-port res)
|
||||
(map (lambda (x) (if (string? x)
|
||||
x
|
||||
(vector (path/param-path x) (path/param-param x))))
|
||||
(url-path res))
|
||||
(url-query res)
|
||||
(url-fragment res))))
|
||||
(define (url/vec->string vec)
|
||||
(url->string
|
||||
(make-url
|
||||
(vector-ref vec 0)
|
||||
(vector-ref vec 1)
|
||||
(vector-ref vec 2)
|
||||
(vector-ref vec 3)
|
||||
(map (lambda (x) (if (string? x)
|
||||
x
|
||||
(make-path/param (vector-ref x 0) (vector-ref x 1))))
|
||||
(vector-ref vec 4))
|
||||
(vector-ref vec 5)
|
||||
(vector-ref vec 6))))
|
||||
|
||||
(define (string->url/vec str) (url->vec (string->url str)))
|
||||
(define (url/vec->string vec) (url->string (vec->url vec)))
|
||||
(test vec string->url/vec str)
|
||||
(test str url/vec->string vec))
|
||||
|
||||
(test-s->u (vector "http" #f "www.google.com" #f '() #f #f)
|
||||
"http://www.google.com/")
|
||||
(test-s->u (vector "http" #f "www.google.com" #f (list "a" "b" "c") #f #f)
|
||||
"http://www.google.com/a/b/c")
|
||||
(test-s->u (vector "http" "robby" "www.google.com" #f (list "a" "b" "c") #f #f)
|
||||
"http://robby@www.google.com/a/b/c")
|
||||
(test-s->u (vector "http" #f "www.google.com" 8080 (list "a" "b" "c") #f #f)
|
||||
"http://www.google.com:8080/a/b/c")
|
||||
(test-s->u (vector "http" #f "www.google.com" #f (list "a" "b" "c") #f "joe")
|
||||
"http://www.google.com/a/b/c#joe")
|
||||
(test-s->u (vector "http" #f "www.google.com" #f (list "a" "b" "c") "tim" #f)
|
||||
"http://www.google.com/a/b/c?tim")
|
||||
(test-s->u (vector "http" #f "www.google.com" #f (list "a" "b" "c") "tim" "joe")
|
||||
"http://www.google.com/a/b/c?tim#joe")
|
||||
(test-s->u (vector "http" #f "www.google.com" #f (list "a" "b" #("c" "b")) #f #f)
|
||||
"http://www.google.com/a/b/c;b")
|
||||
(test-s->u (vector "http" #f "www.google.com" #f (list #("a" "x") "b" #("c" "b")) #f #f)
|
||||
"http://www.google.com/a;x/b/c;b")
|
||||
(define (test-c-u/r expected base relative)
|
||||
(define (combine-url/relative-vec x y)
|
||||
(url->vec (combine-url/relative (vec->url x) y)))
|
||||
(test (url->vec expected) combine-url/relative-vec (url->vec base) relative))
|
||||
|
||||
(define (vec->url vec)
|
||||
(make-url
|
||||
(vector-ref vec 0)
|
||||
(vector-ref vec 1)
|
||||
(vector-ref vec 2)
|
||||
(vector-ref vec 3)
|
||||
(map (lambda (x) (if (string? x)
|
||||
x
|
||||
(make-path/param (vector-ref x 0) (vector-ref x 1))))
|
||||
(vector-ref vec 4))
|
||||
(vector-ref vec 5)
|
||||
(vector-ref vec 6)))
|
||||
|
||||
(define (url->vec url)
|
||||
(vector (url-scheme url)
|
||||
(url-user url)
|
||||
(url-host url)
|
||||
(url-port url)
|
||||
(map (lambda (x) (if (string? x)
|
||||
x
|
||||
(vector (path/param-path x) (path/param-param x))))
|
||||
(url-path url))
|
||||
(url-query url)
|
||||
(url-fragment url)))
|
||||
|
||||
(test-s->u (vector #f #f #f #f '("") #f #f)
|
||||
"/")
|
||||
(test-s->u (vector #f #f #f #f '() #f #f)
|
||||
"")
|
||||
(test-s->u (vector "http" #f "www.drscheme.org" #f '("") #f #f)
|
||||
"http://www.drscheme.org/")
|
||||
(test-s->u (vector "http" #f "www.drscheme.org" #f (list "a" "b" "c") #f #f)
|
||||
"http://www.drscheme.org/a/b/c")
|
||||
(test-s->u (vector "http" "robby" "www.drscheme.org" #f (list "a" "b" "c") #f #f)
|
||||
"http://robby@www.drscheme.org/a/b/c")
|
||||
(test-s->u (vector "http" #f "www.drscheme.org" 8080 (list "a" "b" "c") #f #f)
|
||||
"http://www.drscheme.org:8080/a/b/c")
|
||||
(test-s->u (vector "http" #f "www.drscheme.org" #f (list "a" "b" "c") #f "joe")
|
||||
"http://www.drscheme.org/a/b/c#joe")
|
||||
(test-s->u (vector "http" #f "www.drscheme.org" #f (list "a" "b" "c") "tim" #f)
|
||||
"http://www.drscheme.org/a/b/c?tim")
|
||||
(test-s->u (vector "http" #f "www.drscheme.org" #f (list "a" "b" "c") "tim" "joe")
|
||||
"http://www.drscheme.org/a/b/c?tim#joe")
|
||||
(test-s->u (vector "http" #f "www.drscheme.org" #f (list "a" "b" #("c" "b")) #f #f)
|
||||
"http://www.drscheme.org/a/b/c;b")
|
||||
(test-s->u (vector "http" #f "www.drscheme.org" #f (list #("a" "x") "b" #("c" "b")) #f #f)
|
||||
"http://www.drscheme.org/a;x/b/c;b")
|
||||
|
||||
;; test unquoting for %
|
||||
(test-s->u (vector "http" #f "www.google.com" #f (list "a" "b" "c") "ti#m" "jo e")
|
||||
"http://www.google.com/a/b/c?ti%23m#jo%20e")
|
||||
(test-s->u (vector "http" #f "www.google.com" #f (list #("a " " a") " b " " c ") #f #f)
|
||||
"http://www.google.com/a ; a/ b / c ")
|
||||
(test-s->u (vector "http" "robb y" "www.google.com" #f '() #f #f)
|
||||
"http://robb%20y@www.google.com/"))
|
||||
(test-s->u (vector "http" #f "www.drscheme.org" #f (list "a" "b" "c") "ti#m" "jo e")
|
||||
"http://www.drscheme.org/a/b/c?ti%23m#jo%20e")
|
||||
(test-s->u (vector "http" #f "www.drscheme.org" #f (list #("a " " a") " b " " c ") #f #f)
|
||||
"http://www.drscheme.org/a ; a/ b / c ")
|
||||
(test-s->u (vector "http" "robb y" "www.drscheme.org" #f '("") #f #f)
|
||||
"http://robb%20y@www.drscheme.org/")
|
||||
|
||||
(let ([empty-url (make-url #f #f #f #f '() #f #f)])
|
||||
(test-c-u/r (string->url "http://www.drscheme.org")
|
||||
empty-url
|
||||
"http://www.drscheme.org")
|
||||
(test-c-u/r (string->url "http://www.drscheme.org")
|
||||
(string->url "http://www.drscheme.org")
|
||||
""))
|
||||
|
||||
(test-c-u/r (string->url "http://www.mzscheme.org")
|
||||
(string->url "http://www.drscheme.org/")
|
||||
"http://www.mzscheme.org")
|
||||
(test-c-u/r (string->url "http://www.drscheme.org/index.html")
|
||||
(string->url "http://www.drscheme.org/")
|
||||
"index.html")
|
||||
(test-c-u/r (string->url "http://www.drscheme.org/index.html")
|
||||
(string->url "http://www.drscheme.org/")
|
||||
"/index.html")
|
||||
(test-c-u/r (string->url "http://www.drscheme.org/index.html")
|
||||
(string->url "http://www.drscheme.org/a/b/c/")
|
||||
"/index.html")
|
||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/index.html")
|
||||
(string->url "http://www.drscheme.org/a/b/c")
|
||||
"index.html")
|
||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/c/index.html")
|
||||
(string->url "http://www.drscheme.org/a/b/c/")
|
||||
"index.html")
|
||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/d/index.html")
|
||||
(string->url "http://www.drscheme.org/a/b/c")
|
||||
"d/index.html")
|
||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/c/d/index.html")
|
||||
(string->url "http://www.drscheme.org/a/b/c/")
|
||||
"d/index.html")
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user