1
Fork 0
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:
Ludovic Courtès 2012-11-28 22:26:44 +01:00
parent ee2d874119
commit 75d6c59fc2
3 changed files with 85 additions and 13 deletions

View file

@ -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)))))))