From 84b6f8d4268516bee5379a2110436370915d91a2 Mon Sep 17 00:00:00 2001 From: Stelian Ionescu Date: Thu, 7 Jul 2011 00:44:28 +0200 Subject: [PATCH] Make sure that OPEN-STREAM-P works on stream sockets. Primary methods on SOCKET and DUAL-CHANNEL-GRAY-STREAM were preventing the one on FUNDAMENTAL-STREAM from being executed, so I removed them and reworked the other :AROUND methods a little bit. Thanks to Daniel Rebelo de Oliveira for reporting this bug. --- src/sockets/socket-methods.lisp | 17 +++++++++-------- src/streams/gray/gray-stream-methods.lisp | 6 +----- tests/sockets.lisp | 26 ++++++++++++++++++++++++++ 3 files changed, 36 insertions(+), 13 deletions(-) diff --git a/src/sockets/socket-methods.lisp b/src/sockets/socket-methods.lisp index 4f51706..be14caf 100644 --- a/src/sockets/socket-methods.lisp +++ b/src/sockets/socket-methods.lisp @@ -149,17 +149,18 @@ (defmethod close :around ((socket socket) &key abort) (declare (ignore abort)) (call-next-method) - (setf (slot-value socket 'bound) nil) - (values socket)) + (setf (slot-value socket 'bound) nil)) -(defmethod close :around ((socket passive-socket) &key abort) +(defmethod close ((socket passive-socket) &key abort) (declare (ignore abort)) - (call-next-method) - (setf (slot-value socket 'listening) nil) - (values socket)) + (prog1 (socket-open-p socket) + (when (next-method-p) (call-next-method)) + (setf (slot-value socket 'listening) nil))) -(defmethod close ((socket socket) &key abort) - (declare (ignore socket abort))) +(defmethod close ((socket datagram-socket) &key abort) + (declare (ignore abort)) + (prog1 (socket-open-p socket) + (when (next-method-p) (call-next-method)))) (defmethod socket-open-p ((socket socket)) (when (fd-of socket) diff --git a/src/streams/gray/gray-stream-methods.lisp b/src/streams/gray/gray-stream-methods.lisp index ee52e36..f819df8 100644 --- a/src/streams/gray/gray-stream-methods.lisp +++ b/src/streams/gray/gray-stream-methods.lisp @@ -71,11 +71,7 @@ (unless (or abort (null ibuf)) (finish-output stream)) (free-stream-buffers ibuf obuf) (setf ibuf nil obuf nil)) - (call-next-method) - stream) - -(defmethod close ((stream dual-channel-gray-stream) &key abort) - (declare (ignore stream abort))) + (call-next-method)) (defmethod (setf external-format-of) (external-format (stream dual-channel-gray-stream)) diff --git a/tests/sockets.lisp b/tests/sockets.lisp index 0a884ff..8924799 100644 --- a/tests/sockets.lisp +++ b/tests/sockets.lisp @@ -417,6 +417,32 @@ (close s) (socket-open-p s)))) +(test (socket-open-p.4 :compile-at :definition-time) + (is-false (with-open-socket (s :remote-host *echo-address* :remote-port *echo-port* + :address-family :ipv4) + (close s) + (socket-open-p s)))) + +(test (open-stream-p.1 :compile-at :definition-time) + (is-true (with-open-socket (s) + (open-stream-p s)))) + +(test (open-stream-p.2 :compile-at :definition-time) + (is-true (with-open-socket (s :remote-host *echo-address* :remote-port *echo-port* + :address-family :ipv4) + (open-stream-p s)))) + +(test (open-stream-p.3 :compile-at :definition-time) + (is-false (with-open-socket (s) + (close s) + (open-stream-p s)))) + +(test (open-stream-p.4 :compile-at :definition-time) + (is-false (with-open-socket (s :remote-host *echo-address* :remote-port *echo-port* + :address-family :ipv4) + (close s) + (open-stream-p s)))) + ;;; we don't have an automatic test for some of this yet. There's no ;;; simple way to run servers and have something automatically connect ;;; to them as client, unless we spawn external programs. Then we -- 2.11.4.GIT