Commit 27aebe81 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau Committed by Robert Goldman
Browse files

Make redefined class upgrade properly on MKCL

parent 823c389f
...@@ -124,17 +124,15 @@ previously-loaded version of ASDF." ...@@ -124,17 +124,15 @@ previously-loaded version of ASDF."
,@(when (version< previous-version "3.1.2") '(#:component-depends-on #:input-files)) ;; crucial methods *removed* before 3.1.2 ,@(when (version< previous-version "3.1.2") '(#:component-depends-on #:input-files)) ;; crucial methods *removed* before 3.1.2
,@(when (version< previous-version "3.1.7.20") '(#:find-component)))) ;; added &key registered ,@(when (version< previous-version "3.1.7.20") '(#:find-component)))) ;; added &key registered
(redefined-classes (redefined-classes
;; redefining the classes causes interim circularities
;; with the old ASDF during upgrade, and many implementations bork ;; with the old ASDF during upgrade, and many implementations bork
#-clozure () (when (or #+(or clozure mkcl) t)
#+clozure '((#:compile-concatenated-source-op (#:operation) ())
'((#:compile-concatenated-source-op (#:operation) ()) (#:compile-bundle-op (#:operation) ())
(#:compile-bundle-op (#:operation) ()) (#:concatenate-source-op (#:operation) ())
(#:concatenate-source-op (#:operation) ()) (#:dll-op (#:operation) ())
(#:dll-op (#:operation) ()) (#:lib-op (#:operation) ())
(#:lib-op (#:operation) ()) (#:monolithic-compile-bundle-op (#:operation) ())
(#:monolithic-compile-bundle-op (#:operation) ()) (#:monolithic-concatenate-source-op (#:operation) ())))))
(#:monolithic-concatenate-source-op (#:operation) ()))))
(loop :for name :in redefined-functions (loop :for name :in redefined-functions
:for sym = (find-symbol* name :asdf nil) :for sym = (find-symbol* name :asdf nil)
:do (when sym (fmakunbound sym))) :do (when sym (fmakunbound sym)))
...@@ -142,11 +140,11 @@ previously-loaded version of ASDF." ...@@ -142,11 +140,11 @@ previously-loaded version of ASDF."
(if (consp x) (values (car x) (cadr x)) (values x :asdf)) (if (consp x) (values (car x) (cadr x)) (values x :asdf))
(find-symbol* s p nil))) (find-symbol* s p nil)))
(asyms (l) (mapcar #'asym l))) (asyms (l) (mapcar #'asym l)))
(loop :for (name superclasses slots) :in redefined-classes (loop* :for (name superclasses slots) :in redefined-classes
:for sym = (find-symbol* name :asdf nil) :for sym = (find-symbol* name :asdf nil)
:when (and sym (find-class sym)) :when (and sym (find-class sym))
:do (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots))))))) :do #+ccl (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots)))
#-ccl (setf (find-class sym) nil))))) ;; mkcl
;;; Self-upgrade functions ;;; Self-upgrade functions
(with-upgradability () (with-upgradability ()
......
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