From 10b760eabdabefed9a8437b04f74ed5b07d58db7 Mon Sep 17 00:00:00 2001 From: emarsden <emarsden> Date: Fri, 26 Mar 2004 18:22:54 +0000 Subject: [PATCH] - add a SIMPLE-STREAM-ERROR class, and use it when signaling errors from fd-streams DO-OUTPUT (noted by Matthew Danish) - fix bug in fd-stream error handling (patch from Ole Rohne) --- code/error.lisp | 3 ++- code/fd-stream.lisp | 8 +++++--- code/serve-event.lisp | 13 ++++++------- code/stream.lisp | 10 +++++----- 4 files changed, 18 insertions(+), 16 deletions(-) diff --git a/code/error.lisp b/code/error.lisp index 351a563fb..fcb790b80 100644 --- a/code/error.lisp +++ b/code/error.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.78 2003/10/26 12:48:23 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.79 2004/03/26 18:22:54 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1010,6 +1010,7 @@ (define-condition simple-program-error (simple-condition program-error)()) (define-condition simple-parse-error (simple-condition parse-error)()) (define-condition simple-control-error (simple-condition control-error)()) +(define-condition simple-stream-error (simple-condition stream-error) ()) (define-condition simple-file-error (simple-condition file-error) () (:report diff --git a/code/fd-stream.lisp b/code/fd-stream.lisp index 1b861c8e4..d49ca57ed 100644 --- a/code/fd-stream.lisp +++ b/code/fd-stream.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.74 2003/11/05 16:47:18 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.75 2004/03/26 18:22:54 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -217,8 +217,10 @@ (cond ((not count) (if (= errno unix:ewouldblock) (output-later stream base start end reuse-sap) - (error "While writing ~S: ~A" - stream (unix:get-unix-error-msg errno)))) + (error 'simple-stream-error + :stream stream + :format-control "while writing: ~A" + :format-arguments (list (unix:get-unix-error-msg errno))))) ((not (eql count length)) (output-later stream base (the index (+ start count)) end reuse-sap))))))) diff --git a/code/serve-event.lisp b/code/serve-event.lisp index ab7d5e1a3..e892100b7 100644 --- a/code/serve-event.lisp +++ b/code/serve-event.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/serve-event.lisp,v 1.25 2000/07/06 05:41:28 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/serve-event.lisp,v 1.26 2004/03/26 18:22:54 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -200,8 +200,8 @@ ;;; Search *descriptor-handlers* for any reference to fd, and nuke 'em. ;;; (defun invalidate-descriptor (fd) - "Remove any handers refering to fd. This should only be used when attempting - to recover from a detected inconsistancy." + "Remove any handers refering to FD. This should only be used when attempting + to recover from a detected inconsistency." (setf *descriptor-handlers* (delete fd *descriptor-handlers* :key #'handler-descriptor))) @@ -427,15 +427,14 @@ (:output (unix:fd-isset desc write-fds))) (unwind-protect (progn - ;; Doesn't work -- ACK - ;(setf (handler-active handler) t) + (setf (handler-active handler) t) (funcall (handler-function handler) desc)) (setf (handler-active handler) nil)) (ecase (handler-direction handler) (:input (unix:fd-clr desc read-fds)) (:output (unix:fd-clr desc write-fds))) - (setf result t))) - result))) + (setf result t)))) + result)) ); eval-when (compile eval) diff --git a/code/stream.lisp b/code/stream.lisp index 8a80947b3..2fa36ddff 100644 --- a/code/stream.lisp +++ b/code/stream.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.67 2004/01/20 17:32:20 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.68 2004/03/26 18:22:54 emarsden Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2014,11 +2014,11 @@ POSITION: an INTEGER greater than or equal to zero, and less than or ;; Just catch some errors earlier than it would be necessary. (cond ((not (open-stream-p stream)) - (error 'stream-error + (error 'simple-stream-error :stream stream :format-control "The stream is not open.")) ((not (input-stream-p stream)) - (error 'stream-error + (error 'simple-stream-error :stream stream :format-control "The stream is not open for input.")) ((and seq (>= start end) 0)) @@ -2334,11 +2334,11 @@ SEQ: a proper SEQUENCE ;; Just catch some errors earlier than it would be necessary. (cond ((not (open-stream-p stream)) - (error 'stream-error + (error 'simple-stream-error :stream stream :format-control "The stream is not open.")) ((not (output-stream-p stream)) - (error 'stream-error + (error 'simple-stream-error :stream stream :format-control "The stream is not open for output.")) ((and seq (>= start end)) seq) -- GitLab