From 0221e198ed1af451059db65eba30f1a4e266f872 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Fri, 25 Nov 2016 22:25:06 -0500 Subject: [PATCH] Work around MOP issues on Allegro Call finalize-inheritance in coerce-class on Allegro. Indeed the previous commit uses class meta-objects rather than their naming symbols as canonical representation for operations; now mark-component-preloaded is called at compile-toplevel and uses those representations, but on Allegro the classes haven't been finalized yet, and the finalization isn't implicitly triggered by subtypep. Moreover, comparing a class object to a symbol with subtypep fails, so normalize the super variable to a class object. --- uiop/utility.lisp | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/uiop/utility.lisp b/uiop/utility.lisp index 1bb65b4d5..00c270045 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -461,18 +461,24 @@ A class object designates itself. NIL designates itself (no class). A symbol otherwise designates a class by name." (let* ((normalized - (typecase class + (typecase class (keyword (or (find-symbol* class package nil) (find-symbol* class *package* nil))) (string (symbol-call :uiop :safe-read-from-string class :package package)) (t class))) (found - (etypecase normalized - ((or standard-class built-in-class) normalized) - ((or null keyword) nil) - (symbol (find-class normalized nil nil))))) + (etypecase normalized + ((or standard-class built-in-class) normalized) + ((or null keyword) nil) + (symbol (find-class normalized nil nil)))) + (super-class + (etypecase super + ((or standard-class built-in-class) super) + ((or null keyword) nil) + (symbol (find-class super nil nil))))) + #+allegro (when found (mop:finalize-inheritance found)) (or (and found - (or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super)) + (or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super-class)) found) (call-function error "Can't coerce ~S to a ~:[class~;subclass of ~:*~S~]" class super))))) -- GitLab