mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-18 01:30:27 +02:00
web: Add `response-body-port'.
* module/web/response.scm (make-delimited-input-port, response-body-port): New procedures. (read-response-body): Use `response-body-port'. * test-suite/tests/web-response.test ("example-1")["response-body-port"]: New test. ("example-2")["response-body-port"]: New test.
This commit is contained in:
parent
ee2d874119
commit
75d6c59fc2
3 changed files with 85 additions and 13 deletions
|
@ -21,6 +21,7 @@
|
|||
#:use-module (web uri)
|
||||
#:use-module (web response)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:use-module (test-suite lib))
|
||||
|
||||
|
@ -109,7 +110,14 @@ consectetur adipisicing elit,\r
|
|||
|
||||
(pass-if-equal "by accessor"
|
||||
'(gzip)
|
||||
(response-content-encoding r))))
|
||||
(response-content-encoding r))
|
||||
|
||||
(pass-if-equal "response-body-port"
|
||||
`("utf-8" ,body)
|
||||
(with-fluids ((%default-port-encoding #f))
|
||||
(let* ((r (read-response (open-input-string example-1)))
|
||||
(p (response-body-port r)))
|
||||
(list (port-encoding p) (get-bytevector-all p)))))))
|
||||
|
||||
(with-test-prefix "example-2"
|
||||
(let* ((r (read-response (open-input-string example-2)))
|
||||
|
@ -121,4 +129,10 @@ consectetur adipisicing elit,\r
|
|||
(string-append
|
||||
"Lorem ipsum dolor sit amet, consectetur adipisicing elit,"
|
||||
" sed do eiusmod tempor incididunt ut labore et dolore magna aliqua."))
|
||||
b)))
|
||||
b)
|
||||
(pass-if-equal "response-body-port"
|
||||
`("ISO-8859-1" ,(utf8->string b)) ; no `charset', hence ISO-8859-1
|
||||
(with-fluids ((%default-port-encoding #f))
|
||||
(let* ((r (read-response (open-input-string example-2)))
|
||||
(p (response-body-port r)))
|
||||
(list (port-encoding p) (get-string-all p)))))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue