From: Fredrik Tolf <fredrik@dolda2000.com>
Date: Fri, 21 May 2010 00:30:13 +0000 (+0200)
Subject: COMMON-NET: Tag a couple of more exceptions and network-errors.
X-Git-Url: http://dolda2000.com/gitweb/?p=lisp-utils.git;a=commitdiff_plain;h=d1cf3c66517b1f83cf465eeb1d0b44fc653cf2f8

COMMON-NET: Tag a couple of more exceptions and network-errors.
---

diff --git a/common-net.lisp b/common-net.lisp
index e17931d..10fc919 100644
--- a/common-net.lisp
+++ b/common-net.lisp
@@ -107,6 +107,11 @@
 
 (define-condition network-error (error) ())
 
+(define-condition simple-network-error (network-error simple-error) ())
+
+(defun simple-network-error (format &rest args)
+  (error 'simple-network-error :format-control format :format-arguments args))
+
 (define-condition socket-error (socket-condition network-error) ())
 
 (define-condition address-busy (network-error)
diff --git a/net-sb-bsd.lisp b/net-sb-bsd.lisp
index 67d9c31..9c757c5 100644
--- a/net-sb-bsd.lisp
+++ b/net-sb-bsd.lisp
@@ -52,13 +52,13 @@
     (udp4-address
      '(sb-bsd-sockets:inet-socket :type :datagram))
     (ipv6-address
-     (error "SBCL does not support IPv6."))
+     (simple-network-error "SBCL does not support IPv6."))
     (inet-host-address
-     (error "SBCL does not support raw sockets."))
+     (simple-network-error "SBCL does not support raw sockets."))
     (local-stream-address
      '(sb-bsd-sockets:local-socket :type :stream))
     (local-seq-address
-     (error "SBCL does not support Unix seqpacket sockets."))
+     (simple-network-error "SBCL does not support Unix seqpacket sockets."))
     (local-datagram-address
      '(sb-bsd-sockets:local-socket :type :datagram))))
 
@@ -137,7 +137,7 @@
 (defmethod socket-send-to ((socket sbcl-socket) buf destination &key (start 0) (end (length buf)) from no-hang)
   (check-not-closed socket)
   (when from
-    (error "SB-BSD-THREADS does not support specifying the source address of individual packets."))
+    (simple-network-error "SB-BSD-THREADS does not support specifying the source address of individual packets."))
   (let ((result (map-sb-bsd-errors (socket)
 		  (retry-loop ("Retry the send operation.")
 		    (sb-bsd-sockets:socket-send (slot-value socket 'sb-socket)