From 08bc8f16b86b1c5a310adf33ff3fc5e59028429f Mon Sep 17 00:00:00 2001
From: toy <toy>
Date: Thu, 25 Jul 2002 14:49:25 +0000
Subject: [PATCH] From Eric Marsden:

  * the PARSE-INTEGER function should signal an error of type
    PARSE-ERROR when the substring argument is not a valid
    representation of an integer.
---
 code/error.lisp  |  6 ++++--
 code/reader.lisp | 21 ++++++++++++++-------
 2 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/code/error.lisp b/code/error.lisp
index 74365626e..5e2ddcc6b 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.61 2002/02/01 12:54:53 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.62 2002/07/25 14:49:25 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -20,7 +20,8 @@
 
 (in-package "KERNEL")
 (export '(layout-invalid condition-function-name simple-control-error
-	  simple-file-error simple-program-error simple-style-warning
+	  simple-file-error simple-program-error simple-parse-error
+          simple-style-warning
 	  simple-undefined-function))
 
 (in-package "LISP")
@@ -907,6 +908,7 @@
 
 ;;; INTERNAL
 (define-condition simple-program-error (simple-condition program-error)())
+(define-condition simple-parse-error (simple-condition program-error)())
 (define-condition simple-control-error (simple-condition control-error)())
 
 (define-condition simple-file-error (simple-condition file-error) ()
diff --git a/code/reader.lisp b/code/reader.lisp
index 225ecf501..0d3280296 100644
--- a/code/reader.lisp
+++ b/code/reader.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/reader.lisp,v 1.31 2001/07/16 13:21:07 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.32 2002/07/25 14:49:25 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1380,7 +1380,7 @@
   ;;get the dispatch char for macro (error if not there), diddle
   ;;entry for sub-char.
   (when (digit-char-p sub-char)
-    (error "Sub-Char must not be a decibal digit: ~S" sub-char))
+    (error "Sub-Char must not be a decimal digit: ~S" sub-char))
   (let* ((sub-char (char-upcase sub-char))
 	 (dpair (find disp-char (dispatch-tables rt)
 		      :test #'char= :key #'car)))
@@ -1388,7 +1388,7 @@
 	(setf (elt (the simple-vector (cdr dpair))
 		   (char-code sub-char))
 	      (coerce function 'function))
-	(error "~S is not a dispatch char." disp-char))))
+	(error "~S is not a dispatch character." disp-char))))
 
 (defun get-dispatch-macro-character
        (disp-char sub-char &optional (rt *readtable*))
@@ -1476,7 +1476,8 @@
 		     ((= i end)
 		      (if junk-allowed
 			  (return-from parse-integer (values nil end))
-			  (error "No non-whitespace characters in number.")))
+			  (error 'simple-parse-error
+                                 :format-control "No non-whitespace characters in number.")))
 		   (declare (fixnum i))
 		   (unless (whitespacep (char string i)) (return i))))
 	  (minusp nil)
@@ -1502,17 +1503,23 @@
 		     ((= jndex end))
 		   (declare (fixnum jndex))
 		   (unless (whitespacep (char string jndex))
-		     (error "There's junk in this string: ~S." string)))
+		     (error 'simple-parse-error
+                            :format-control "There's junk in this string: ~S."
+                            :format-arguments (list string))))
 		 (return nil))
 		(t
-		 (error "There's junk in this string: ~S." string))))
+		 (error 'simple-parse-error
+                        :format-control "There's junk in this string: ~S."
+                        :format-arguments (list string)))))
 	(incf index))
       (values
        (if found-digit
 	   (if minusp (- result) result)
 	   (if junk-allowed
 	       nil
-	       (error "There's no digits in this string: ~S" string)))
+	       (error 'simple-parse-error
+                      :format-control "There are no digits in this string: ~S"
+                      :format-arguments (list string))))
        index))))
 
 
-- 
GitLab