From d002fd43e98dc4da830fb98bc81e3d989c61fffd Mon Sep 17 00:00:00 2001 From: pw <pw> Date: Thu, 16 Jul 1998 13:30:53 +0000 Subject: [PATCH] Fixes and improvements to July-14 commit dealing with condition types in calls to error. From Douglas. --- code/error.lisp | 5 ++--- code/exports.lisp | 5 +++-- code/fd-stream.lisp | 6 ++---- code/stream.lisp | 26 +++++++++++++++++++++----- code/sysmacs.lisp | 14 +------------- pcl/boot.lisp | 8 +++++--- 6 files changed, 34 insertions(+), 30 deletions(-) diff --git a/code/error.lisp b/code/error.lisp index a18a98f2d..9cf3d317a 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.49 1998/07/14 18:12:15 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.50 1998/07/16 13:30:43 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -20,8 +20,7 @@ (in-package "KERNEL") (export '(layout-invalid simple-style-warning condition-function-name - ;;simple-program-error simple-file-error - )) + simple-program-error simple-file-error)) (in-package "LISP") (export '(break error warn cerror diff --git a/code/exports.lisp b/code/exports.lisp index c5cfb3e8e..172d88df3 100644 --- a/code/exports.lisp +++ b/code/exports.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/exports.lisp,v 1.155 1998/05/27 03:32:59 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.156 1998/07/16 13:30:44 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1661,7 +1661,8 @@ "%FUNCALLABLE-INSTANCE-FUNCTION" "SYMBOL-HASH" "MAKE-UNDEFINED-CLASS" "%COMPILER-ONLY-DEFSTRUCT" - "CLASS-DIRECT-SUPERCLASSES" "MAKE-LAYOUT" "SIMPLE-STYLE-WARNING" + "CLASS-DIRECT-SUPERCLASSES" "MAKE-LAYOUT" "SIMPLE-FILE-ERROR" + "SIMPLE-PROGRAM-ERROR" "SIMPLE-STYLE-WARNING" "BYTE-FUNCTION-TYPE" "SLOT-CLASS-PRINT-FUNCTION" "REDEFINE-LAYOUT-WARNING" "SLOT-CLASS" "INSURED-FIND-CLASS" "CONDITION-FUNCTION-NAME")) diff --git a/code/fd-stream.lisp b/code/fd-stream.lisp index 9f958ab46..4a411d068 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.44 1998/07/14 18:12:15 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.45 1998/07/16 13:30:45 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1260,9 +1260,7 @@ non-server method is also significantly more efficient for large reads. :overwrite, :append, :supersede or nil :if-does-not-exist - one of :error, :create or nil See the manual for details." - - (unless (eq external-format :default) - (error "Only :DEFAULT is acceptable for :EXTERNAL-FORMAT.")) + (declare (ignore external-format)) ;; First, make sure that DIRECTION is valid. Allow it to be changed if not. (setf direction diff --git a/code/stream.lisp b/code/stream.lisp index 5d263ab30..b97a05fc5 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.33 1998/05/15 01:03:18 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.34 1998/07/16 13:30:52 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -66,16 +66,32 @@ (defun ill-in (stream &rest ignore) (declare (ignore ignore)) - (error "~S is not a character input stream." stream)) + (error 'simple-type-error + :datum stream + :expected-type '(satisfies input-stream-p) + :format-control "~S is not a character input stream." + :format-arguments (list stream))) (defun ill-out (stream &rest ignore) (declare (ignore ignore)) - (error "~S is not a character output stream." stream)) + (error 'simple-type-error + :datum stream + :expected-type '(satisfies output-stream-p) + :format-control "~S is not a character output stream." + :format-arguments (list stream))) (defun ill-bin (stream &rest ignore) (declare (ignore ignore)) - (error "~S is not a binary input stream." stream)) + (error 'simple-type-error + :datum stream + :expected-type '(satisfies input-stream-p) + :format-control "~S is not a binary input stream." + :format-arguments (list stream))) (defun ill-bout (stream &rest ignore) (declare (ignore ignore)) - (error "~S is not a binary output stream." stream)) + (error 'simple-type-error + :datum stream + :expected-type '(satisfies output-stream-p) + :format-control "~S is not a binary output stream." + :format-arguments (list stream))) (defun closed-flame (stream &rest ignore) (declare (ignore ignore)) (error "~S is closed." stream)) diff --git a/code/sysmacs.lisp b/code/sysmacs.lisp index cd98babc7..eda733fd6 100644 --- a/code/sysmacs.lisp +++ b/code/sysmacs.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/sysmacs.lisp,v 1.21 1998/07/14 18:12:22 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sysmacs.lisp,v 1.22 1998/07/16 13:30:52 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -97,12 +97,6 @@ (cond ((null ,svar) *standard-input*) ((eq ,svar t) *terminal-io*) (T ,@(if check-type `((check-type ,svar ,check-type))) - (unless (input-stream-p ,svar) - (error 'simple-type-error - :datum stream - :expected-type '(satisfies input-stream-p) - :format-control "~S isn't an input stream." - :format-arguments ,(list svar))) ,svar))))) (defmacro out-synonym-of (stream &optional check-type) @@ -111,12 +105,6 @@ (cond ((null ,svar) *standard-output*) ((eq ,svar t) *terminal-io*) (T ,@(if check-type `((check-type ,svar ,check-type))) - (unless (output-stream-p ,svar) - (error 'simple-type-error - :datum stream - :expected-type '(satisfies output-stream-p) - :format-control "~S isn't an output stream." - :format-arguments ,(list svar))) ,svar))))) ;;; With-Mumble-Stream calls the function in the given Slot of the diff --git a/pcl/boot.lisp b/pcl/boot.lisp index 2ec17d9b2..3bb989bf8 100644 --- a/pcl/boot.lisp +++ b/pcl/boot.lisp @@ -26,7 +26,7 @@ ;;; #+cmu (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.14 1998/07/14 18:12:23 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.15 1998/07/16 13:30:53 pw Exp $") (in-package :pcl) @@ -172,7 +172,7 @@ work during bootstrapping. (let ((initargs ()) (methods ())) (flet ((duplicate-option (name) - (error 'lisp::simple-program-error + (error 'kernel:simple-program-error :format-control "The option ~S appears more than once." :format-arguments (list name))) (define-method(gf-name q-a-b) @@ -220,6 +220,8 @@ work during bootstrapping. (if (initarg :method-class) (duplicate-option :method-class) (initarg :method-class `',(cadr option)))) + (:method + (push (cdr option) methods)) (t ;unsuported things must get a 'program-error (error 'lisp::simple-program-error :format-control "Unsupported option ~S." @@ -1286,7 +1288,7 @@ work during bootstrapping. (defun generic-clobbers-function (function-specifier) #+Lispm (zl:signal 'generic-clobbers-function :name function-specifier) #+cmu - (error 'lisp::simple-program-error + (error 'kernel:simple-program-error :format-control "~S already names an ordinary function or a macro,~%~ you may want to replace it with a generic function, but doing so~%~ -- GitLab