[armedbear-devel] [armedbear-cvs] r13209 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

This fixes the regression I introduced a few days ago.

Bye,


Erik.

On Tue, Feb 8, 2011 at 10:46 PM, Erik Huelsmann
<ehuelsmann at common-lisp.net> wrote:
> Author: ehuelsmann
> Date: Tue Feb  8 16:46:47 2011
> New Revision: 13209
>
> Log:
> Add documentation to STD-SHARED-INITIALIZE and
> add initarg checking to REINITIALIZE-INSTANCE.
>
> Modified:
>   trunk/abcl/src/org/armedbear/lisp/clos.lisp
>
> Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
> ==============================================================================
> --- trunk/abcl/src/org/armedbear/lisp/clos.lisp (original)
> +++ trunk/abcl/src/org/armedbear/lisp/clos.lisp Tue Feb  8 16:46:47 2011
> @@ -2650,18 +2650,23 @@
>  ;; slots should be initialized according to their initforms), and the initargs
>  ;; it received."
>  (defmethod reinitialize-instance ((instance standard-object) &rest initargs)
> +  (check-initargs (list #'reinitialize-instance) (list* instance initargs)
> +                  instance () initargs)
>   (apply #'shared-initialize instance () initargs))
>
>  (defun std-shared-initialize (instance slot-names all-keys)
>   (when (oddp (length all-keys))
>     (error 'program-error :format-control "Odd number of keyword arguments."))
> +  ;; do a quick scan of the arguments list to see if it's a real
> +  ;; 'initialization argument list' (which is not the same as
> +  ;; checking initarg validity
>   (do* ((tail all-keys (cddr tail))
> -       (initarg (car tail) (car tail)))
> +        (initarg (car tail) (car tail)))
>       ((null tail))
>     (when (and initarg (not (symbolp initarg)))
>       (error 'program-error
> -            :format-control "Invalid initarg ~S."
> -            :format-arguments (list initarg))))
> +             :format-control "Invalid initarg ~S."
> +             :format-arguments (list initarg))))
>   (dolist (slot (class-slots (class-of instance)))
>     (let ((slot-name (slot-definition-name slot)))
>       (multiple-value-bind (init-key init-value foundp)
>
> _______________________________________________
> armedbear-cvs mailing list
> armedbear-cvs at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/armedbear-cvs
>