string->url: always mark as absolute when a host is present

Fixes a failure in the web server tests caused by d23b296627.

Formerly, `(string->url "http://racket-lang.org")`, with no trailing
slash, would produce a `url` structure with `path-absolute?` as #f.
That doesn't exactly make sense, because a URL with a host must always
have an absolute path component. Claiming a relative path component
interacts badly with extending a URL with a path later. (Although
`combine-url/relative` compenstate, a similar function in the web
server doesn't.) The revised `url->string` always sets `path-absolute?`
to #t when a host is present, and whether the path is empty or contains
an empty string still records whether a trailing "/" was present.

The `url->string` function, meanwhile, now needs to use whether the
path is empty to determine whether a "/" should be added after
the host name, not whether `path-absolute?` is true.
This commit is contained in:
Matthew Flatt 2016-04-19 05:42:07 -06:00
parent ddd4190edf
commit 3b1b4a0d26

View File

@ -242,6 +242,10 @@
[port (and port (string->number port))]
[abs? (or (equal? "file" scheme)
(regexp-match? #rx"^/" path))]
[use-abs? (or abs?
;; If an authority part is provided, the (empty) path must be
;; absolute, even if it isn't written with a "/":
(and (or host user port) #t))]
[path (if win-file?
(url-path win-file-url)
(separate-path-strings path))]
@ -252,7 +256,7 @@
" host provided with non-absolute path (i.e., missing a slash)\n"
" in: ~e")
str))
(make-url scheme user host port abs? path query fragment))))
(make-url scheme user host port use-abs? path query fragment))))
(cdr (regexp-match url-regexp str))))
(define (uri-decode/maybe f) (friendly-decode/maybe f uri-decode))
@ -287,7 +291,7 @@
(define (combine-path-strings absolute? path/params)
(cond [(null? path/params) null]
[else (let ([p (add-between (map join-params path/params) "/")])
(if absolute? (cons "/" p) p))]))
(if (and absolute? (pair? p)) (cons "/" p) p))]))
(define (join-params s)
(if (null? (path/param-param s))