[Guile-commits] 25/47: web: Fix 'close' method of delimited input ports.

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit d52edc05d3ef565446f4710f3bf275b340eccc10
Author: Ludovic Courtès <address@hidden>
Date:   Thu Sep 10 22:20:54 2015 +0200

    web: Fix 'close' method of delimited input ports.
    
    * 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.
---
 module/web/response.scm            |    4 ++--
 test-suite/tests/web-response.test |   14 ++++++++++++--
 2 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/module/web/response.scm b/module/web/response.scm
index 58e3f11..614abcd 100644
--- a/module/web/response.scm
+++ b/module/web/response.scm
@@ -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))
 
diff --git a/test-suite/tests/web-response.test 
b/test-suite/tests/web-response.test
index 3c1894e..848a726 100644
--- a/test-suite/tests/web-response.test
+++ b/test-suite/tests/web-response.test
@@ -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)))