Skip to content
Snippets Groups Projects
Commit 08bc8f16 authored by toy's avatar toy
Browse files

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.
parent 52cef538
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -20,7 +20,8 @@
(in-package "KERNEL") (in-package "KERNEL")
(export '(layout-invalid condition-function-name simple-control-error (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)) simple-undefined-function))
(in-package "LISP") (in-package "LISP")
...@@ -907,6 +908,7 @@ ...@@ -907,6 +908,7 @@
;;; INTERNAL ;;; INTERNAL
(define-condition simple-program-error (simple-condition program-error)()) (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-control-error (simple-condition control-error)())
(define-condition simple-file-error (simple-condition file-error) () (define-condition simple-file-error (simple-condition file-error) ()
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -1380,7 +1380,7 @@
;;get the dispatch char for macro (error if not there), diddle ;;get the dispatch char for macro (error if not there), diddle
;;entry for sub-char. ;;entry for sub-char.
(when (digit-char-p 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)) (let* ((sub-char (char-upcase sub-char))
(dpair (find disp-char (dispatch-tables rt) (dpair (find disp-char (dispatch-tables rt)
:test #'char= :key #'car))) :test #'char= :key #'car)))
...@@ -1388,7 +1388,7 @@ ...@@ -1388,7 +1388,7 @@
(setf (elt (the simple-vector (cdr dpair)) (setf (elt (the simple-vector (cdr dpair))
(char-code sub-char)) (char-code sub-char))
(coerce function 'function)) (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 (defun get-dispatch-macro-character
(disp-char sub-char &optional (rt *readtable*)) (disp-char sub-char &optional (rt *readtable*))
...@@ -1476,7 +1476,8 @@ ...@@ -1476,7 +1476,8 @@
((= i end) ((= i end)
(if junk-allowed (if junk-allowed
(return-from parse-integer (values nil end)) (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)) (declare (fixnum i))
(unless (whitespacep (char string i)) (return i)))) (unless (whitespacep (char string i)) (return i))))
(minusp nil) (minusp nil)
...@@ -1502,17 +1503,23 @@ ...@@ -1502,17 +1503,23 @@
((= jndex end)) ((= jndex end))
(declare (fixnum jndex)) (declare (fixnum jndex))
(unless (whitespacep (char string 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)) (return nil))
(t (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)) (incf index))
(values (values
(if found-digit (if found-digit
(if minusp (- result) result) (if minusp (- result) result)
(if junk-allowed (if junk-allowed
nil 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)))) index))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment