Changeset 14128


Ignore:
Timestamp:
08/19/12 13:22:43 (9 years ago)
Author:
ehuelsmann
Message:

Fix #113 (redefinition of structures can crash ABCL) by failing

the redefinition if the two structure definitions are not equalp.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/defstruct.lisp

    r14072 r14128  
    518518                                inherited-accessors
    519519                                documentation)
    520   (setf (get name 'structure-definition)
    521         (make-defstruct-description :name name
     520  (let ((description
     521         (make-defstruct-description :name name
    522522                                    :conc-name conc-name
    523523                                    :default-constructor default-constructor
     
    534534                                    :slots slots
    535535                                    :inherited-accessors inherited-accessors))
     536        (old (get name 'structure-definition)))
     537    (when old
     538      (unless
     539          ;; Assert that the structure definitions are exactly the same
     540          ;; we need to support this type of redefinition during bootstrap
     541          ;; building ourselves
     542          (and (equalp (aref old 0) (aref description 0))
     543               ;; the CONC-NAME slot is an uninterned symbol if not supplied
     544               ;; thus different on each redefinition round. Check that the
     545               ;; names are equal, because it produces the same end result
     546               ;; when they are.
     547               (string= (aref old 1) (aref description 1))
     548               (dotimes (index 13 t)
     549                 (when (not (equalp (aref old (+ 2 index))
     550                                    (aref description (+ 2 index))))
     551                   (return nil))))
     552        (error 'program-error
     553               :format-control "Structure redefinition not supported ~
     554                              in DEFSTRUCT for ~A"
     555               :format-arguments (list name))))
     556    (setf (get name 'structure-definition) description))
    536557  (%set-documentation name 'structure documentation)
    537558  (when (or (null type) named)
Note: See TracChangeset for help on using the changeset viewer.