Skip to content
Snippets Groups Projects
Commit 51c8dcef authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Redefining a class that causes circularity: not just for SBCL.

Also for CCL, ECL, LispWorks, SCL (and probably CMUCL if we didn't punt).
On the other hand, since we now punt on upgrading from ASDF1,
we can safely remove the old uninterned symbol list.
parent e60c95d5
No related branches found
No related tags found
No related merge requests found
...@@ -80,50 +80,38 @@ previously-loaded version of ASDF." ...@@ -80,50 +80,38 @@ previously-loaded version of ASDF."
(when-upgrading () (when-upgrading ()
(let ((redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops. (let ((redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops.
;; NB: it's too late to do anything about functions in UIOP!
;; If you introduce some critically incompatibility there, you must change name.
'(#:component-relative-pathname #:component-parent-pathname ;; component '(#:component-relative-pathname #:component-parent-pathname ;; component
#:source-file-type #:source-file-type
#:find-system #:system-source-file #:system-relative-pathname ;; system #:find-system #:system-source-file #:system-relative-pathname ;; system
#:find-component ;; find-component #:find-component ;; find-component
#:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action
#:component-depends-on #:operation-done-p #:component-depends-on #:component-depends-on #:operation-done-p #:component-depends-on
#:traverse ;; backward-interface #:traverse ;; backward-interface
#:operate ;; operate #:operate ;; operate
#:parse-component-form ;; defsystem #:parse-component-form ;; defsystem
#:apply-output-translations ;; output-translations #:apply-output-translations ;; output-translations
#:process-output-translations-directive #:process-output-translations-directive
#:inherit-source-registry #:process-source-registry ;; source-registry #:inherit-source-registry #:process-source-registry ;; source-registry
#:process-source-registry-directive #:process-source-registry-directive
#:trivial-system-p ;; bundle #:trivial-system-p)) ;; bundle
;; NB: it's too late to do anything about uiop functions! (redefined-classes
)) ;; redefining the classes causes interim circularities
#+sbcl ;; with the old ASDF during upgrade, and many implementations bork
(redefined-classes '((#:compile-concatenated-source-op (#:operation) ()))))
;; redefining causes interim circularities with the old ASDF during upgrade, and SBCL borks
'(#:bundle-op))
(uninterned-symbols
'(#:*asdf-revision* #:around #:asdf-method-combination
#:split #:make-collector #:do-dep #:do-one-dep
#:component-self-dependencies
#:resolve-relative-location-component #:resolve-absolute-location-component
#:output-files-for-system-and-operation))) ; obsolete ASDF-BINARY-LOCATION function
(loop :for name :in redefined-functions (loop :for name :in redefined-functions
:for sym = (find-symbol* name :asdf nil) :do :for sym = (find-symbol* name :asdf nil) :do
(when sym (when sym
;; On CLISP we seem to be unable to fmakunbound and define a function in the same fasl. Sigh. ;; On CLISP we seem to be unable to fmakunbound and define a function in the same fasl. Sigh.
#-clisp (fmakunbound sym))) #-clisp (fmakunbound sym)))
(loop :with asdf = (find-package :asdf) (labels ((asym (x) (multiple-value-bind (s p) (if (consp x) (values (car x) (cadr x)) (values x :asdf))
:for name :in (append #+sbcl redefined-classes uninterned-symbols) (find-symbol* s p nil)))
:for sym = (find-symbol* name :asdf nil) (asyms (l) (mapcar #'asym l)))
:for base-pkg = (and sym (symbol-package sym)) :do (loop* :for (name superclasses slots) :in redefined-classes
(when sym :for sym = (find-symbol* name :asdf nil)
(cond :when (and sym (find-class sym))
((or (eq base-pkg asdf) (not base-pkg)) :do (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots)))))))
(unintern* sym asdf)
(intern* sym asdf))
(t
(unintern* sym base-pkg)
(let ((new (intern* sym base-pkg)))
(shadowing-import new asdf))))))))
;;; Self-upgrade functions ;;; Self-upgrade functions
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment