parse url schemes properly (some test reformatting)
svn: r5241
original commit: 9984b48d88
This commit is contained in:
Eli Barzilay
parent
df4458f899
commit
3996eefb9a
|
|
@ -50,13 +50,13 @@
|
||||||
;; Test all ASCII chars
|
;; Test all ASCII chars
|
||||||
(let ([p (let loop ([n 0])
|
(let ([p (let loop ([n 0])
|
||||||
(if (= n 128)
|
(if (= n 128)
|
||||||
null
|
null
|
||||||
(let ([s (string (char-downcase (integer->char n)))])
|
(let ([s (string (char-downcase (integer->char n)))])
|
||||||
(cons (cons (string->symbol s) s)
|
(cons (cons (string->symbol s) s)
|
||||||
(loop (add1 n))))))])
|
(loop (add1 n))))))])
|
||||||
(test p form-urlencoded->alist (alist->form-urlencoded p))
|
(test p form-urlencoded->alist (alist->form-urlencoded p))
|
||||||
(let ([l (apply string-append (map cdr p))])
|
(let ([l (apply string-append (map cdr p))])
|
||||||
(test l uri-decode (uri-encode l)))))))
|
(test l uri-decode (uri-encode l)))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;
|
;;
|
||||||
|
|
@ -75,7 +75,6 @@
|
||||||
(unless (= i to)
|
(unless (= i to)
|
||||||
(loop (+ i 1)))))]))
|
(loop (+ i 1)))))]))
|
||||||
|
|
||||||
|
|
||||||
(test "hello" uri-encode "hello")
|
(test "hello" uri-encode "hello")
|
||||||
(test "hello%20there" uri-encode "hello there")
|
(test "hello%20there" uri-encode "hello there")
|
||||||
|
|
||||||
|
|
@ -95,7 +94,6 @@
|
||||||
uri-encode
|
uri-encode
|
||||||
(string (integer->char code))))))
|
(string (integer->char code))))))
|
||||||
|
|
||||||
|
|
||||||
(test "" alist->form-urlencoded '())
|
(test "" alist->form-urlencoded '())
|
||||||
(test "key=hello+there" alist->form-urlencoded '((key . "hello there")))
|
(test "key=hello+there" alist->form-urlencoded '((key . "hello there")))
|
||||||
(test "key1=hi;key2=hello" alist->form-urlencoded '((key1 . "hi") (key2 . "hello")))
|
(test "key1=hi;key2=hello" alist->form-urlencoded '((key1 . "hi") (key2 . "hello")))
|
||||||
|
|
@ -153,21 +151,21 @@
|
||||||
(define (test-c-u/r expected base relative)
|
(define (test-c-u/r expected base relative)
|
||||||
(define (combine-url/relative-vec x y)
|
(define (combine-url/relative-vec x y)
|
||||||
(url->vec (combine-url/relative (vec->url 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 x) (url->vec (if (string? x) (string->url x) x)))
|
||||||
|
(test (->vec expected) combine-url/relative-vec (->vec base) relative))
|
||||||
|
|
||||||
(define (vec->url vec)
|
(define (vec->url vec)
|
||||||
(make-url
|
(make-url (vector-ref vec 0)
|
||||||
(vector-ref vec 0)
|
(vector-ref vec 1)
|
||||||
(vector-ref vec 1)
|
(vector-ref vec 2)
|
||||||
(vector-ref vec 2)
|
(vector-ref vec 3)
|
||||||
(vector-ref vec 3)
|
(vector-ref vec 4)
|
||||||
(vector-ref vec 4)
|
(map (lambda (x)
|
||||||
(map (lambda (x)
|
(let ([lst (vector->list x)])
|
||||||
(let ([lst (vector->list x)])
|
(make-path/param (car lst) (cdr lst))))
|
||||||
(make-path/param (car lst) (cdr lst))))
|
(vector-ref vec 5))
|
||||||
(vector-ref vec 5))
|
(vector-ref vec 6)
|
||||||
(vector-ref vec 6)
|
(vector-ref vec 7)))
|
||||||
(vector-ref vec 7)))
|
|
||||||
|
|
||||||
(define (url->vec url)
|
(define (url->vec url)
|
||||||
(vector (url-scheme url)
|
(vector (url-scheme url)
|
||||||
|
|
@ -180,175 +178,191 @@
|
||||||
(url-query url)
|
(url-query url)
|
||||||
(url-fragment url)))
|
(url-fragment url)))
|
||||||
|
|
||||||
(test-s->u (vector #f #f #f #f #t '(#("")) '() #f)
|
(test-s->u #(#f #f #f #f #t (#("")) () #f)
|
||||||
"/")
|
"/")
|
||||||
(test-s->u (vector #f #f #f #f #f '() '() #f)
|
(test-s->u #(#f #f #f #f #f () () #f)
|
||||||
"")
|
"")
|
||||||
(test-s->u (vector "http" #f #f #f #t '(#("")) '() #f)
|
(test-s->u #("http" #f #f #f #t (#("")) () #f)
|
||||||
"http:/")
|
"http:/")
|
||||||
|
|
||||||
(test-s->u (vector "http" #f "" #f #t '(#("")) '() #f)
|
(test-s->u #("http" #f "" #f #t (#("")) () #f)
|
||||||
"http:///")
|
"http:///")
|
||||||
|
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #f '() '() #f)
|
(test-s->u #("http" #f "www.drscheme.org" #f #f () () #f)
|
||||||
"http://www.drscheme.org")
|
"http://www.drscheme.org")
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t '(#("")) '() #f)
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("")) () #f)
|
||||||
"http://www.drscheme.org/")
|
"http://www.drscheme.org/")
|
||||||
|
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a") #("b") #("c")) '() #f)
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a") #("b") #("c")) () #f)
|
||||||
"http://www.drscheme.org/a/b/c")
|
"http://www.drscheme.org/a/b/c")
|
||||||
(test-s->u (vector "http" "robby" "www.drscheme.org" #f #t (list #("a") #("b") #("c")) '() #f)
|
(test-s->u #("http" "robby" "www.drscheme.org" #f #t (#("a") #("b") #("c")) () #f)
|
||||||
"http://robby@www.drscheme.org/a/b/c")
|
"http://robby@www.drscheme.org/a/b/c")
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" 8080 #t (list #("a") #("b") #("c")) '() #f)
|
(test-s->u #("http" #f "www.drscheme.org" 8080 #t (#("a") #("b") #("c")) () #f)
|
||||||
"http://www.drscheme.org:8080/a/b/c")
|
"http://www.drscheme.org:8080/a/b/c")
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a") #("b") #("c")) '() "joe")
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a") #("b") #("c")) () "joe")
|
||||||
"http://www.drscheme.org/a/b/c#joe")
|
"http://www.drscheme.org/a/b/c#joe")
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a") #("b") #("c")) '((tim . "")) #f)
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a") #("b") #("c")) ((tim . "")) #f)
|
||||||
"http://www.drscheme.org/a/b/c?tim=")
|
"http://www.drscheme.org/a/b/c?tim=")
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a") #("b") #("c")) '((tim . "")) "joe")
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a") #("b") #("c")) ((tim . "")) "joe")
|
||||||
"http://www.drscheme.org/a/b/c?tim=#joe")
|
"http://www.drscheme.org/a/b/c?tim=#joe")
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a") #("b") #("c")) '((tim . "tim")) "joe")
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a") #("b") #("c")) ((tim . "tim")) "joe")
|
||||||
"http://www.drscheme.org/a/b/c?tim=tim#joe")
|
"http://www.drscheme.org/a/b/c?tim=tim#joe")
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a") #("b") #("c")) '((tam . "tom")) "joe")
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a") #("b") #("c")) ((tam . "tom")) "joe")
|
||||||
"http://www.drscheme.org/a/b/c?tam=tom#joe")
|
"http://www.drscheme.org/a/b/c?tam=tom#joe")
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a") #("b") #("c")) '((tam . "tom") (pam . "pom")) "joe")
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a") #("b") #("c")) ((tam . "tom") (pam . "pom")) "joe")
|
||||||
"http://www.drscheme.org/a/b/c?tam=tom;pam=pom#joe")
|
"http://www.drscheme.org/a/b/c?tam=tom;pam=pom#joe")
|
||||||
(parameterize ([current-alist-separator-mode 'semi])
|
(parameterize ([current-alist-separator-mode 'semi])
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a") #("b") #("c")) '((tam . "tom") (pam . "pom")) "joe")
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a") #("b") #("c")) ((tam . "tom") (pam . "pom")) "joe")
|
||||||
"http://www.drscheme.org/a/b/c?tam=tom;pam=pom#joe"))
|
"http://www.drscheme.org/a/b/c?tam=tom;pam=pom#joe"))
|
||||||
(parameterize ([current-alist-separator-mode 'amp])
|
(parameterize ([current-alist-separator-mode 'amp])
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a") #("b") #("c")) '((tam . "tom") (pam . "pom")) "joe")
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a") #("b") #("c")) ((tam . "tom") (pam . "pom")) "joe")
|
||||||
"http://www.drscheme.org/a/b/c?tam=tom&pam=pom#joe"))
|
"http://www.drscheme.org/a/b/c?tam=tom&pam=pom#joe"))
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a") #("b") #("c" "b")) '() #f)
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a") #("b") #("c" "b")) () #f)
|
||||||
"http://www.drscheme.org/a/b/c;b")
|
"http://www.drscheme.org/a/b/c;b")
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a" "x") #("b") #("c" "b")) '() #f)
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a" "x") #("b") #("c" "b")) () #f)
|
||||||
"http://www.drscheme.org/a;x/b/c;b")
|
"http://www.drscheme.org/a;x/b/c;b")
|
||||||
|
|
||||||
;; test unquoting for %
|
;; test unquoting for %
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a") #("b") #("c")) '((ti#m . "")) "jo e")
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a") #("b") #("c")) ((ti#m . "")) "jo e")
|
||||||
"http://www.drscheme.org/a/b/c?ti%23m=#jo%20e")
|
"http://www.drscheme.org/a/b/c?ti%23m=#jo%20e")
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a " " a") #(" b ") #(" c ")) '() #f)
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a " " a") #(" b ") #(" c ")) () #f)
|
||||||
"http://www.drscheme.org/a%20;%20a/%20b%20/%20c%20")
|
"http://www.drscheme.org/a%20;%20a/%20b%20/%20c%20")
|
||||||
(test-s->u (vector "http" "robb y" "www.drscheme.org" #f #t '(#("")) '() #f)
|
(test-s->u #("http" "robb y" "www.drscheme.org" #f #t (#("")) () #f)
|
||||||
"http://robb%20y@www.drscheme.org/")
|
"http://robb%20y@www.drscheme.org/")
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("%a") #("b/") #("c")) '() #f)
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("%a") #("b/") #("c")) () #f)
|
||||||
"http://www.drscheme.org/%25a/b%2F/c")
|
"http://www.drscheme.org/%25a/b%2F/c")
|
||||||
|
|
||||||
;; test the characters that need to be encoded in paths vs those that do not need to
|
;; test the characters that need to be encoded in paths vs those that do not need to
|
||||||
;; be encoded in paths
|
;; be encoded in paths
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("a:@!$&'()*+,=z") #("/?#[];") #("")) '() #f)
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("a:@!$&'()*+,=z") #("/?#[];") #("")) () #f)
|
||||||
"http://www.drscheme.org/a:@!$&'()*+,=z/%2F%3F%23%5B%5D%3B/")
|
"http://www.drscheme.org/a:@!$&'()*+,=z/%2F%3F%23%5B%5D%3B/")
|
||||||
|
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #(".") #("..") '#(same) '#(up) #("...") #("abc.def")) '() #f)
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#(".") #("..") #(same) #(up) #("...") #("abc.def")) () #f)
|
||||||
"http://www.drscheme.org/%2e/%2e%2e/./../.../abc.def")
|
"http://www.drscheme.org/%2e/%2e%2e/./../.../abc.def")
|
||||||
(test-s->u (vector "http" #f "www.drscheme.org" #f #t (list #("." "") #(".." "") #(same "") #(up "") #("..." "") #("abc.def" "")) '() #f)
|
(test-s->u #("http" #f "www.drscheme.org" #f #t (#("." "") #(".." "") #(same "") #(up "") #("..." "") #("abc.def" "")) () #f)
|
||||||
"http://www.drscheme.org/%2e;/%2e%2e;/.;/..;/...;/abc.def;")
|
"http://www.drscheme.org/%2e;/%2e%2e;/.;/..;/...;/abc.def;")
|
||||||
|
|
||||||
|
;; test other scheme identifiers
|
||||||
|
(test-s->u #("blah" #f "www.foo.com" #f #t (#("")) () #f)
|
||||||
|
"blah://www.foo.com/")
|
||||||
|
(test-s->u #("blah99" #f "www.foo.com" #f #t (#("")) () #f)
|
||||||
|
"blah99://www.foo.com/")
|
||||||
|
(test-s->u #("blah+" #f "www.foo.com" #f #t (#("")) () #f)
|
||||||
|
"blah+://www.foo.com/")
|
||||||
|
(test-s->u #("a+b-c456.d" #f "www.foo.com" #f #t (#("")) () #f)
|
||||||
|
"a+b-c456.d://www.foo.com/")
|
||||||
|
|
||||||
|
;; test bad schemes
|
||||||
|
(err/rt-test (string->url "://www.foo.com/") url-exception?)
|
||||||
|
(err/rt-test (string->url "9://www.foo.com/") url-exception?)
|
||||||
|
(err/rt-test (string->url "9a://www.foo.com/") url-exception?)
|
||||||
|
(err/rt-test (string->url "a*b://www.foo.com/") url-exception?)
|
||||||
|
(err/rt-test (string->url "a b://www.foo.com/") url-exception?)
|
||||||
|
|
||||||
;; test file: urls
|
;; test file: urls
|
||||||
(test-s->u (vector "file" #f #f #f #t '(#("abc") #("def.html")) '() #f)
|
(test-s->u #("file" #f #f #f #t (#("abc") #("def.html")) () #f)
|
||||||
"file:/abc/def.html")
|
"file:/abc/def.html")
|
||||||
|
|
||||||
(test-s->u (vector "file" #f "localhost" #f #t '(#("abc") #("def.html")) '() #f)
|
(test-s->u #("file" #f "localhost" #f #t (#("abc") #("def.html")) () #f)
|
||||||
"file://localhost/abc/def.html")
|
"file://localhost/abc/def.html")
|
||||||
|
|
||||||
;; test files: urls with colons, and the different parsing on Windows
|
;; test files: urls with colons, and the different parsing on Windows
|
||||||
(test-s->u (vector "file" #f "localhost" 123 #t '(#("abc") #("def.html")) '() #f)
|
(test-s->u #("file" #f "localhost" 123 #t (#("abc") #("def.html")) () #f)
|
||||||
"file://localhost:123/abc/def.html")
|
"file://localhost:123/abc/def.html")
|
||||||
(set-url:os-type! 'unix)
|
(set-url:os-type! 'unix)
|
||||||
;; different parse for file://foo:/...
|
;; different parse for file://foo:/...
|
||||||
(test (vector "file" #f "foo" #f #t '(#("abc") #("def.html")) '() #f)
|
(test #("file" #f "foo" #f #t (#("abc") #("def.html")) () #f)
|
||||||
string->url/vec
|
string->url/vec
|
||||||
"file://foo:/abc/def.html")
|
"file://foo:/abc/def.html")
|
||||||
(set-url:os-type! 'windows)
|
(set-url:os-type! 'windows)
|
||||||
(test (vector "file" #f #f #f #f '(#("foo:") #("abc") #("def.html")) '() #f)
|
(test #("file" #f #f #f #f (#("foo:") #("abc") #("def.html")) () #f)
|
||||||
string->url/vec
|
string->url/vec
|
||||||
"file://foo:/abc/def.html")
|
"file://foo:/abc/def.html")
|
||||||
(set-url:os-type! 'unix)
|
(set-url:os-type! 'unix)
|
||||||
;; but no effect on http://foo:/...
|
;; but no effect on http://foo:/...
|
||||||
(test (vector "http" #f "foo" #f #t '(#("abc") #("def.html")) '() #f)
|
(test #("http" #f "foo" #f #t (#("abc") #("def.html")) () #f)
|
||||||
string->url/vec
|
string->url/vec
|
||||||
"http://foo:/abc/def.html")
|
"http://foo:/abc/def.html")
|
||||||
(set-url:os-type! 'windows)
|
(set-url:os-type! 'windows)
|
||||||
(test (vector "http" #f "foo" #f #t '(#("abc") #("def.html")) '() #f)
|
(test #("http" #f "foo" #f #t (#("abc") #("def.html")) () #f)
|
||||||
string->url/vec
|
string->url/vec
|
||||||
"http://foo:/abc/def.html")
|
"http://foo:/abc/def.html")
|
||||||
(set-url:os-type! 'unix)
|
(set-url:os-type! 'unix)
|
||||||
|
|
||||||
;; test case sensitivity
|
;; test case sensitivity
|
||||||
(test (vector "http" "ROBBY" "www.drscheme.org" 80 #t '(#("INDEX.HTML" "XXX")) '((T . "P")) "YYY")
|
(test #("http" "ROBBY" "www.drscheme.org" 80 #t (#("INDEX.HTML" "XXX")) ((T . "P")) "YYY")
|
||||||
string->url/vec
|
string->url/vec
|
||||||
"HTTP://ROBBY@WWW.DRSCHEME.ORG:80/INDEX.HTML;XXX?T=P#YYY")
|
"HTTP://ROBBY@WWW.DRSCHEME.ORG:80/INDEX.HTML;XXX?T=P#YYY")
|
||||||
|
|
||||||
(test-s->u (vector "mailto" #f #f #f #f '(#("robby@plt-scheme.org")) '() #f)
|
(test-s->u #("mailto" #f #f #f #f (#("robby@plt-scheme.org")) () #f)
|
||||||
"mailto:robby@plt-scheme.org")
|
"mailto:robby@plt-scheme.org")
|
||||||
|
|
||||||
(test (vector "http" #f "www.drscheme.org" #f #f '() '((bar . "馨慧")) #f)
|
(test #("http" #f "www.drscheme.org" #f #f () ((bar . "馨慧")) #f)
|
||||||
string->url/vec
|
string->url/vec
|
||||||
"http://www.drscheme.org?bar=馨慧")
|
"http://www.drscheme.org?bar=馨慧")
|
||||||
|
|
||||||
(test (vector "http" #f "www.drscheme.org" #f #f '() '((bár . "é")) #f)
|
(test #("http" #f "www.drscheme.org" #f #f () ((bár . "é")) #f)
|
||||||
string->url/vec
|
string->url/vec
|
||||||
"http://www.drscheme.org?bár=é")
|
"http://www.drscheme.org?bár=é")
|
||||||
|
|
||||||
(let ([empty-url (make-url #f #f #f #f #f '() '() #f)])
|
(test-c-u/r "http://www.drscheme.org"
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org")
|
(make-url #f #f #f #f #f '() '() #f)
|
||||||
empty-url
|
"http://www.drscheme.org")
|
||||||
"http://www.drscheme.org"))
|
|
||||||
|
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org")
|
(test-c-u/r "http://www.drscheme.org"
|
||||||
(string->url "http://www.drscheme.org")
|
"http://www.drscheme.org"
|
||||||
"")
|
"")
|
||||||
|
|
||||||
(test-c-u/r (string->url "http://www.mzscheme.org")
|
(test-c-u/r "http://www.mzscheme.org"
|
||||||
(string->url "http://www.drscheme.org/")
|
"http://www.drscheme.org/"
|
||||||
"http://www.mzscheme.org")
|
"http://www.mzscheme.org")
|
||||||
|
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/index.html")
|
(test-c-u/r "http://www.drscheme.org/index.html"
|
||||||
(string->url "http://www.drscheme.org/")
|
"http://www.drscheme.org/"
|
||||||
"index.html")
|
"index.html")
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/index.html")
|
(test-c-u/r "http://www.drscheme.org/index.html"
|
||||||
(string->url "http://www.drscheme.org/")
|
"http://www.drscheme.org/"
|
||||||
"/index.html")
|
"/index.html")
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/index.html")
|
(test-c-u/r "http://www.drscheme.org/index.html"
|
||||||
(string->url "http://www.drscheme.org/a/b/c/")
|
"http://www.drscheme.org/a/b/c/"
|
||||||
"/index.html")
|
"/index.html")
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/index.html")
|
(test-c-u/r "http://www.drscheme.org/a/b/index.html"
|
||||||
(string->url "http://www.drscheme.org/a/b/c")
|
"http://www.drscheme.org/a/b/c"
|
||||||
"index.html")
|
"index.html")
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/c/index.html")
|
(test-c-u/r "http://www.drscheme.org/a/b/c/index.html"
|
||||||
(string->url "http://www.drscheme.org/a/b/c/")
|
"http://www.drscheme.org/a/b/c/"
|
||||||
"index.html")
|
"index.html")
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/d/index.html")
|
(test-c-u/r "http://www.drscheme.org/a/b/d/index.html"
|
||||||
(string->url "http://www.drscheme.org/a/b/c")
|
"http://www.drscheme.org/a/b/c"
|
||||||
"d/index.html")
|
"d/index.html")
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/c/d/index.html")
|
(test-c-u/r "http://www.drscheme.org/a/b/c/d/index.html"
|
||||||
(string->url "http://www.drscheme.org/a/b/c/")
|
"http://www.drscheme.org/a/b/c/"
|
||||||
"d/index.html")
|
"d/index.html")
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/index.html")
|
(test-c-u/r "http://www.drscheme.org/a/b/index.html"
|
||||||
(string->url "http://www.drscheme.org/a/b/c/")
|
"http://www.drscheme.org/a/b/c/"
|
||||||
"../index.html")
|
"../index.html")
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/c/index.html")
|
(test-c-u/r "http://www.drscheme.org/a/b/c/index.html"
|
||||||
(string->url "http://www.drscheme.org/a/b/c/")
|
"http://www.drscheme.org/a/b/c/"
|
||||||
"./index.html")
|
"./index.html")
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/c/%2e%2e/index.html")
|
(test-c-u/r "http://www.drscheme.org/a/b/c/%2e%2e/index.html"
|
||||||
(string->url "http://www.drscheme.org/a/b/c/")
|
"http://www.drscheme.org/a/b/c/"
|
||||||
"%2e%2e/index.html")
|
"%2e%2e/index.html")
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/a/index.html")
|
(test-c-u/r "http://www.drscheme.org/a/index.html"
|
||||||
(string->url "http://www.drscheme.org/a/b/../c/")
|
"http://www.drscheme.org/a/b/../c/"
|
||||||
"../index.html")
|
"../index.html")
|
||||||
|
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/c/d/index.html")
|
(test-c-u/r "http://www.drscheme.org/a/b/c/d/index.html"
|
||||||
(string->url "http://www.drscheme.org/a/b/c/d/index.html#ghijkl")
|
"http://www.drscheme.org/a/b/c/d/index.html#ghijkl"
|
||||||
"index.html")
|
"index.html")
|
||||||
(test-c-u/r (string->url "http://www.drscheme.org/a/b/c/d/index.html#abcdef")
|
(test-c-u/r "http://www.drscheme.org/a/b/c/d/index.html#abcdef"
|
||||||
(string->url "http://www.drscheme.org/a/b/c/d/index.html#ghijkl")
|
"http://www.drscheme.org/a/b/c/d/index.html#ghijkl"
|
||||||
"#abcdef")
|
"#abcdef")
|
||||||
|
|
||||||
(test-c-u/r (string->url "file:///a/b/c/d/index.html")
|
(test-c-u/r "file:///a/b/c/d/index.html"
|
||||||
(string->url "file:///a/b/c/")
|
"file:///a/b/c/"
|
||||||
"d/index.html")
|
"d/index.html")
|
||||||
(test-c-u/r (string->url "file:///a/b/d/index.html")
|
(test-c-u/r "file:///a/b/d/index.html"
|
||||||
(string->url "file:///a/b/c")
|
"file:///a/b/c"
|
||||||
"d/index.html")
|
"d/index.html")
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
@ -357,10 +371,7 @@
|
||||||
;;
|
;;
|
||||||
|
|
||||||
(for-each
|
(for-each
|
||||||
(λ (line)
|
(λ (line) (test-c-u/r (caddr line) "http://a/b/c/d;p?q" (car line)))
|
||||||
(test-c-u/r (string->url (caddr line))
|
|
||||||
(string->url "http://a/b/c/d;p?q")
|
|
||||||
(car line)))
|
|
||||||
'(("g:h" = "g:h")
|
'(("g:h" = "g:h")
|
||||||
("g" = "http://a/b/c/g")
|
("g" = "http://a/b/c/g")
|
||||||
("./g" = "http://a/b/c/g")
|
("./g" = "http://a/b/c/g")
|
||||||
|
|
@ -412,7 +423,6 @@
|
||||||
|
|
||||||
))
|
))
|
||||||
|
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user