mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

web: Fix 'close' method of delimited input ports.

Browse source 
* module/web/response.scm (make-delimited-input-port)[close]: Replace
  erroneous self-recursive call with a call to 'close-port'.
* test-suite/tests/web-response.test ("example-1")["response-body-port +
  close"]: New test.
This commit is contained in:
Ludovic Courtès 2015-09-10 22:20:54 +02:00 • committed by Andy Wingo
parent 013e69838c
commit d52edc05d3
2 changed files with 14 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

4
module/web/response.scm
View file

@ -1,6 +1,6 @@
;;; HTTP response objects
;; Copyright (C) 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
;; Copyright (C) 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@ -265,7 +265,7 @@ closes PORT, unless KEEP-ALIVE? is true."
(define close
(and (not keep-alive?)
(lambda ()
(close port))))
(close-port port))))
(make-custom-binary-input-port "delimited input port" read! #f #f close))

14
test-suite/tests/web-response.test
View file

@ -1,6 +1,6 @@
;;;; web-response.test --- HTTP responses -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; Copyright (C) 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
;;;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -119,7 +119,17 @@ consectetur adipisicing elit,\r
(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)))))))
(list (port-encoding p) (get-bytevector-all p)))))
(pass-if "response-body-port + close"
(with-fluids ((%default-port-encoding #f))
(let* ((r (read-response (open-input-string example-1)))
(p (response-body-port r #:keep-alive? #f)))
;; Before, calling 'close-port' here would yield a
;; wrong-arg-num error when calling the delimited input port's
;; 'close' procedure.
(close-port p)
(port-closed? p))))))
(with-test-prefix "example-2"
(let* ((r (read-response (open-input-string example-2)))