X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/52a79ab8b310a785f2c2f1a11069f3a5ad53810c..2aa518549b302b3556dbaa42585e6fc16a63ae7c:/src/class-make-impl.lisp?ds=sidebyside diff --git a/src/class-make-impl.lisp b/src/class-make-impl.lisp index 1daab39..28c1958 100644 --- a/src/class-make-impl.lisp +++ b/src/class-make-impl.lisp @@ -152,13 +152,16 @@ (defmethod shared-initialize :after (defmethod make-sod-message ((class sod-class) name type pset &optional location) (with-default-error-location (location) - (let ((message (make-instance (get-property pset :message-class :symbol - 'standard-message) - :class class - :name name - :type type - :location (file-location location) - :pset pset))) + (let* ((msg-class (or (get-property pset :message-class :symbol) + (and (get-property pset :combination :keyword) + 'aggregating-message) + 'standard-message)) + (message (make-instance msg-class + :class class + :name name + :type type + :location (file-location location) + :pset pset))) (with-slots (messages) class (setf messages (append messages (list message)))))))