Skip to content
Snippets Groups Projects
Commit 69a2336b authored by gerd's avatar gerd
Browse files

(parse-integer " 1 ") => 0, 2 instead of 0, 3.

	Found by Paul Dietz.

	* src/code/reader.lisp (parse-integer): Rewritten.
parent 18894485
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/reader.lisp,v 1.39 2003/07/20 13:48:38 emarsden Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.40 2003/09/08 09:36:06 gerd Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1514,55 +1514,43 @@ ...@@ -1514,55 +1514,43 @@
(with-array-data ((string string) (with-array-data ((string string)
(start start) (start start)
(end (or end (length string)))) (end (or end (length string))))
(let ((index (do ((i start (1+ i))) (let ((index start)
((= i end) (sign 1)
(if junk-allowed (any-digits nil)
(return-from parse-integer (values nil end))
(error 'simple-parse-error
:format-control "No non-whitespace characters in number.")))
(declare (fixnum i))
(unless (whitespacep (char string i)) (return i))))
(minusp nil)
(found-digit nil)
(result 0)) (result 0))
(declare (fixnum index)) (declare (type index index)
(let ((char (char string index))) (type (member 1 -1) sign)
(cond ((char= char #\-) (type boolean any-digits)
(setq minusp t) (integer result))
(incf index)) (flet ((skip-whitespace ()
((char= char #\+) (loop while (< index end)
(incf index)))) while (whitespacep (char string index)) do
(loop (incf index))))
(when (= index end) (return nil)) (declare (inline skip-whitespace))
(let* ((char (char string index)) (skip-whitespace)
(weight (digit-char-p char radix))) (when (< index end)
(cond (weight (case (char string index)
(setq result (+ weight (* result radix)) (#\+ (incf index))
found-digit t)) (#\- (incf index) (setq sign -1))))
(junk-allowed (return nil)) (loop while (< index end)
((whitespacep char) for weight = (digit-char-p (char string index) radix)
(do ((jndex (1+ index) (1+ jndex))) while weight do
((= jndex end)) (incf index)
(declare (fixnum jndex)) (setq any-digits t)
(unless (whitespacep (char string jndex)) (setq result (+ (* radix result) weight)))
(error 'simple-parse-error (skip-whitespace)
:format-control "There's junk in this string: ~S." (cond ((not any-digits)
:format-arguments (list string)))) (if junk-allowed
(return nil)) (values nil index)
(t (error 'simple-parse-error
(error 'simple-parse-error :format-control "There are no digits in this string: ~S"
:format-control "There's junk in this string: ~S." :format-arguments (list string))))
:format-arguments (list string))))) ((and (< index end) (not junk-allowed))
(incf index))
(values
(if found-digit
(if minusp (- result) result)
(if junk-allowed
nil
(error 'simple-parse-error (error 'simple-parse-error
:format-control "There are no digits in this string: ~S" :format-control "There's junk in this string: ~S."
:format-arguments (list string)))) :format-arguments (list string)))
index)))) (t
(values (* sign result) index)))))))
;;;; Reader initialization code. ;;;; Reader initialization code.
......
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