Re: Some bug reports

At 10:38 PM 2/21/03 +0100, Edi Weitz wrote:
>Here's a summary of some bug reports I just sent to Roger. I'll repeat
>them here FYI and to avoid duplicate submissions.
>
>1. Bug report: PARSE-INTEGER hangs
>
>   ;; Corman Lisp 2.0  Copyright © 2002 Roger Corman. All rights reserved.
>   ;; Licensed to Edmund Weitz.
>   (parse-integer "" :junk-allowed t)
>   ;;; An error occurred in function ELT:
>   ;;; Error: Index out of range: 0
>   ;;; Entering Corman Lisp debug loop.
>   ;;; Use :C followed by an option to exit. Type :HELP for help.
>   ;;; Restart options:
>   ;;; 1   Abort to top level.
>   :c 1
>
>
>   ;;; Returning to top level loop.
>   (parse-integer "" :junk-allowed t :radix 16 :start 0)
>
>At this point Corman Lisp hangs and has to be killed. I've looked at
>the source code of PARSE-INTEGER but have no idea what might be the
>cause for this. I guess this must have something to do with how
>keyword arguments are processed.

Yeah, that is mind-boggling.  It doesn't get into the body of the function
at all.

Here is a (crudely) revised PARSE-INTEGER that seems to fix
the problems you mentioned along with a few others I found in
playing with it.

For some reason it also seems to fix the hang, at least on my machine.
I experimented with making a dummy function with the same lambda
list and no body, but it doesn't hang when given equivalent arguments.

------------------------------------

;;; Patch for PARSE-INTEGER
;;; Author:  JP Massar

(in-package :lisp)

(defun parse-integer (string
                       &key (start 0)
                            (end nil) ;; (length string))
                            (radix 10)
                            (junk-allowed nil)
                       &aux (result 0)
                            (state :initial)
                            (sign 1)
                            c)

   (let ((len (length string))
         (whitespace '(#\Space #\Tab #\Newline)))
     (flet ((whitespace? (x) (member x whitespace)))

       ;; First canonicalize the string so that we are always dealing
       ;; with a non-null string which begins and ends with non-whitespace.

       (when (null end) (setq end len))
       (cond
        ;; A substring was specifier
        ((or (not (zerop start)) (not (= end len)))
         (multiple-value-bind (val bound)
             (parse-integer (subseq string start end)
                            :radix radix :junk-allowed junk-allowed)
           (values val (+ bound start))
           ))
        ;; null or blank string
        ((or (zerop len) (not (find-if-not #'whitespace? string)))
         (if junk-allowed
             (values nil len)
           (error "Cannot parse null or blank string as an integer")))
        ;; Initial characters are whitespace
        ((whitespace? (char string 0))
         (let ((start-pos (position-if-not #'whitespace? string)))
           (multiple-value-bind (val bound)
               (parse-integer (string-trim whitespace string)
                              :radix radix :junk-allowed junk-allowed)
             (values val (+ bound start-pos))
             )))
        ;; Ending characters are whitespace
        ((whitespace? (char string (1- len)))
         (parse-integer (string-trim whitespace string)
                        :radix radix :junk-allowed junk-allowed))

        ;; Implement the original algorithm.

        (t

         ;; check for leading sign
         (setf c (char string start))
         (if (char= c #\-)
             (progn (setf sign -1) (incf start))
           (if (char= c #\+)
               (incf start)))

         (do* ((i start (+ i 1))
               (n 0))
             ((>= i end))
           (setq c (char string i))
           (setq n (digit-char-p c radix))
           (cond
            (n (progn
                 (cond
                  ((eq state :finished)
                   (if (not junk-allowed)
                       (error "Invalid integer parsed: ~A" string)
                     (progn (setq end i) (return)))))
                 (setq result (+ (* result radix) n))
                 (setq state :collecting)))

            ;; '(#\Newline #\Space #\Tab)
            ((member c (list (int-char 13) (int-char 32) (int-char 9)))
             (cond
              ((eq state :collecting) (setq state :finished))
              ((eq state :initial) nil)  ; don't do anything
              ((eq state :finished) nil)))
            (t
             (if (not junk-allowed)
                 (error "Invalid integer parsed: ~A" string)  ;; string
               (progn (setq end i) (return))))))

         (if (eq state :initial)
             (setq result nil)
           (setq result (* result sign)))
         (values result end))

        ))))


------------------------ Yahoo! Groups Sponsor ---------------------~-->
Get 128 Bit SSL Encryption!
http://us.click.yahoo.com/FpY02D/vN2EAA/xGHJAA/SyjtlB/TM
---------------------------------------------------------------------~->

To unsubscribe from this group, send an email to:
[email protected]

 

Your use of Yahoo! Groups is subject to http://docs.yahoo.com/info/terms/