suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Tests for different file:// parsing of URLs

Browse Source 
svn: r3111
This commit is contained in:
Eli Barzilay 2006-05-29 18:13:33 +00:00
parent 6bc10c8cca
commit ce92ae725a
2 changed files with 35 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/net/url-unit.ss
View File

@ -21,6 +21,11 @@
"tcp-sig.ss")
(provide url@)
;; undocumented hook to allow testing
(provide set-url:os-type!)
(define url:os-type (system-type))
(define (set-url:os-type! new) (set! url:os-type new))
(define url@
(unit/sig net:url^
(import net:tcp^)
@ -146,7 +151,7 @@
(let ([elts (remove* '("") (map path/param-path (url-path url)))]
[abs? (url-path-absolute? url)])
;; See the discussion in PR8060 for an explanation
(if (eq? 'windows (system-type))
(if (eq? 'windows url:os-type)
(let ([host (or (url-host url) "")])
(unless (equal? "" host) (set! elts (cons host elts)))
(if (null? elts)
@ -391,7 +396,7 @@
(lambda (scheme user host port path query fragment)
;; Windows => "file://xxx:/...." specifies a "xxx:/..." path
(when (and (equal? "" port) (equal? "file" scheme)
(eq? 'windows (system-type)))
(eq? 'windows url:os-type))
(set! path (string-append host ":" path))
(set! host #f))
(let* ([user (uri-decode/maybe user)]

31
collects/tests/mzscheme/net.ss
View File

@ -8,7 +8,9 @@
(require (lib "url.ss" "net")
(lib "uri-codec.ss" "net")
(lib "string.ss"))
(lib "string.ss")
(lib "url-unit.ss" "net") ; to get set-url:os-type!
)
(test "%Pq" uri-decode "%Pq")
(test "%P" uri-decode "%P")
@ -243,10 +245,33 @@
;; test file: urls
(test-s->u (vector "file" #f #f #f #t '(#("abc") #("def.html")) '() #f)
"file:/abc/def.html")
(test-s->u (vector "file" #f "localhost" #f #t '(#("abc") #("def.html")) '() #f)
"file://localhost/abc/def.html")
;; test files: urls with colons, and the different parsing on Windows
(test-s->u (vector "file" #f "localhost" 123 #t '(#("abc") #("def.html")) '() #f)
"file://localhost:123/abc/def.html")
(set-url:os-type! 'unix)
;; different parse for file://foo:/...
(test (vector "file" #f "foo" #f #t '(#("abc") #("def.html")) '() #f)
string->url/vec
"file://foo:/abc/def.html")
(set-url:os-type! 'windows)
(test (vector "file" #f #f #f #f '(#("foo:") #("abc") #("def.html")) '() #f)
string->url/vec
"file://foo:/abc/def.html")
(set-url:os-type! 'unix)
;; but no effect on http://foo:/...
(test (vector "http" #f "foo" #f #t '(#("abc") #("def.html")) '() #f)
string->url/vec
"http://foo:/abc/def.html")
(set-url:os-type! 'windows)
(test (vector "http" #f "foo" #f #t '(#("abc") #("def.html")) '() #f)
string->url/vec
"http://foo:/abc/def.html")
(set-url:os-type! 'unix)
;; test case sensitivity
(test (vector "http" "ROBBY" "www.drscheme.org" 80 #t '(#("INDEX.HTML" "XXX")) '((T . "P")) "YYY")
string->url/vec