Commit 59744901 authored by ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f's avatar ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files

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

  the redefinition if the two structure definitions are not equalp.
parent 0bb77c56
......@@ -517,8 +517,8 @@
slots
inherited-accessors
documentation)
(setf (get name 'structure-definition)
(make-defstruct-description :name name
(let ((description
(make-defstruct-description :name name
:conc-name conc-name
:default-constructor default-constructor
:constructors constructors
......@@ -533,6 +533,27 @@
:direct-slots direct-slots
:slots slots
:inherited-accessors inherited-accessors))
(old (get name 'structure-definition)))
(when old
(unless
;; Assert that the structure definitions are exactly the same
;; we need to support this type of redefinition during bootstrap
;; building ourselves
(and (equalp (aref old 0) (aref description 0))
;; the CONC-NAME slot is an uninterned symbol if not supplied
;; thus different on each redefinition round. Check that the
;; names are equal, because it produces the same end result
;; when they are.
(string= (aref old 1) (aref description 1))
(dotimes (index 13 t)
(when (not (equalp (aref old (+ 2 index))
(aref description (+ 2 index))))
(return nil))))
(error 'program-error
:format-control "Structure redefinition not supported ~
in DEFSTRUCT for ~A"
:format-arguments (list name))))
(setf (get name 'structure-definition) description))
(%set-documentation name 'structure documentation)
(when (or (null type) named)
(let ((structure-class
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment