Unverified Commit 02cfb4e3 authored by Anton Vodonosov's avatar Anton Vodonosov Committed by GitHub
Browse files

Support (SOCKET-SHUTDOWN ... :DIRECTION :IO) as the generic function documentation advertises (#76)

contributed by Anton Vodonosov
parent 5c0c2629
......@@ -284,6 +284,9 @@
(:input
(jcall $@shutdownInput/Socket/0 (socket usocket)))
(:output
(jcall $@shutdownOutput/Socket/0 (socket usocket)))
(:io
(jcall $@shutdownInput/Socket/0 (socket usocket))
(jcall $@shutdownOutput/Socket/0 (socket usocket))))))
;;; GET-LOCAL/PEER-NAME/ADDRESS/PORT
......
......@@ -114,7 +114,11 @@
(defmethod socket-shutdown ((usocket stream-usocket) direction)
(with-mapped-conditions (usocket)
(socket:shutdown (socket usocket) :direction direction)))
(if (eq :io direction)
(progn
(socket:shutdown (socket usocket) :direction :input)
(socket:shutdown (socket usocket) :direction :output))
(socket:shutdown (socket usocket) :direction direction))))
(defun socket-listen (host port
&key reuseaddress
......
......@@ -198,7 +198,11 @@
(defmethod socket-shutdown ((usocket stream-usocket) direction)
(with-mapped-conditions (usocket)
(socket:socket-stream-shutdown (socket usocket) direction)))
(if (eq :io direction)
(progn
(socket:socket-stream-shutdown (socket usocket) :input)
(socket:socket-stream-shutdown (socket usocket) :output))
(socket:socket-stream-shutdown (socket usocket) direction))))
(defmethod get-local-name ((usocket stream-usocket))
(multiple-value-bind
......
......@@ -178,7 +178,8 @@
(with-mapped-conditions (usocket)
(ext:inet-shutdown (socket usocket) (ecase direction
(:input ext:shut-rd)
(:output ext:shut-wr)))))
(:output ext:shut-wr)
(:io ext:shut-rdwr)))))
(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0)
&aux (real-buffer (if (zerop offset)
......
......@@ -158,8 +158,19 @@
(close (socket usocket) :abort t))) ; see "sbcl.lisp" for (:abort t)
(defmethod socket-shutdown ((usocket usocket) direction)
(with-mapped-conditions (usocket)
(openmcl-socket:shutdown (socket usocket) :direction direction)))
(let ((ccl-direction (case direction
(:io :both)
(otherwise direction))))
(with-mapped-conditions (usocket)
(if (and (eq ccl-direction :both)
;; The :BOTH support was introduced in CCL 1.11.5,
;; and CCL's *FEATURES* allow to distignguish only major version,
;; so we use it starting with 1.12.
(not (member :ccl-1.12 *features*)))
(progn
(openmcl-socket:shutdown (socket usocket) :direction :input)
(openmcl-socket:shutdown (socket usocket) :direction :output))
(openmcl-socket:shutdown (socket usocket) :direction ccl-direction)))))
#-ipv6
(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
......
......@@ -554,7 +554,8 @@ happen. Use with care."
(let ((sock-fd (sb-bsd-sockets:socket-file-descriptor (socket usocket)))
(direction-flag (ecase direction
(:input 0)
(:output 1))))
(:output 1)
(:io 2))))
(unless (zerop (ffi:c-inline (sock-fd direction-flag) (:int :int) :int
"shutdown(#0, #1)" :one-liner t))
(error (map-errno-error (cerrno))))))
......@@ -564,7 +565,8 @@ happen. Use with care."
(let ((sock-fd (sb-bsd-sockets:socket-file-descriptor (socket usocket)))
(direction-flag (ecase direction
(:input 0)
(:output 1))))
(:output 1)
(:io 2))))
(unless (zerop (sockets-internal:shutdown sock-fd direction-flag))
(error (map-errno-error (cerrno))))))
......
......@@ -177,5 +177,15 @@
t))
t)
(deftest socket-shutdown.3
(with-caught-conditions (nil nil)
(let ((sock (socket-connect *common-lisp-net* 80)))
(unwind-protect
(usocket::ignore-unsupported-warnings
(socket-shutdown sock :io))
(socket-close sock))
t))
t)
(defun run-usocket-tests ()
(do-tests))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment