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

Expand all tabs. Will make SBCL happier.

parent a9ff4e6f
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
(:use :uiop/common-lisp :uiop :asdf/upgrade) (:use :uiop/common-lisp :uiop :asdf/upgrade)
(:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp (:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp
#:set-asdf-cache-entry #:unset-asdf-cache-entry #:consult-asdf-cache #:set-asdf-cache-entry #:unset-asdf-cache-entry #:consult-asdf-cache
#:do-asdf-cache #:normalize-namestring #:do-asdf-cache #:normalize-namestring
#:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache*)) #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache*))
(in-package :asdf/cache) (in-package :asdf/cache)
......
...@@ -107,10 +107,10 @@ ...@@ -107,10 +107,10 @@
(and (typep c 'missing-dependency) (and (typep c 'missing-dependency)
(eq (missing-required-by c) component) (eq (missing-required-by c) component)
(equal (missing-requires c) name)))) (equal (missing-requires c) name))))
(unless (component-parent component) (unless (component-parent component)
(let ((name (coerce-name name))) (let ((name (coerce-name name)))
(unset-asdf-cache-entry `(find-system ,name)) (unset-asdf-cache-entry `(find-system ,name))
(unset-asdf-cache-entry `(locate-system ,name)))))))) (unset-asdf-cache-entry `(locate-system ,name))))))))
(defun resolve-dependency-spec (component dep-spec) (defun resolve-dependency-spec (component dep-spec)
......
...@@ -6,7 +6,7 @@ extern int sample_function(); ...@@ -6,7 +6,7 @@ extern int sample_function();
int sample_function() int sample_function()
{ {
return 42; return 42;
} }
") ")
...@@ -16,6 +16,6 @@ extern MKCL_DLLEXPORT int sample_function(void); ...@@ -16,6 +16,6 @@ extern MKCL_DLLEXPORT int sample_function(void);
int sample_function(void) int sample_function(void)
{ {
return 42; return 42;
} }
") ")
...@@ -6,7 +6,7 @@ extern int always_7(); ...@@ -6,7 +6,7 @@ extern int always_7();
int always_7() int always_7()
{ {
return 7; return 7;
} }
") ")
...@@ -16,6 +16,6 @@ extern MKCL_DLLEXPORT int always_7(void); ...@@ -16,6 +16,6 @@ extern MKCL_DLLEXPORT int always_7(void);
int always_7(void) int always_7(void)
{ {
return 7; return 7;
} }
") ")
...@@ -6,7 +6,7 @@ extern int always_42(); ...@@ -6,7 +6,7 @@ extern int always_42();
int always_42() int always_42()
{ {
return 6*always_7(); return 6*always_7();
} }
") ")
...@@ -16,6 +16,6 @@ extern MKCL_DLLEXPORT int always_42(void); ...@@ -16,6 +16,6 @@ extern MKCL_DLLEXPORT int always_42(void);
int always_42(void) int always_42(void)
{ {
return 6*always_7(); return 6*always_7();
} }
") ")
...@@ -580,7 +580,7 @@ when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPA ...@@ -580,7 +580,7 @@ when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPA
"if MAYBE-SUBPATH is a pathname that is under BASE-PATHNAME, return a pathname object that "if MAYBE-SUBPATH is a pathname that is under BASE-PATHNAME, return a pathname object that
when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH." when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH."
(let ((sub (when maybe-subpath (pathname maybe-subpath))) (let ((sub (when maybe-subpath (pathname maybe-subpath)))
(base (when base-pathname (ensure-absolute-pathname (pathname base-pathname))))) (base (when base-pathname (ensure-absolute-pathname (pathname base-pathname)))))
(or (and base (subpathp sub base)) sub))) (or (and base (subpathp sub base)) sub)))
(defun call-with-enough-pathname (maybe-subpath defaults-pathname thunk) (defun call-with-enough-pathname (maybe-subpath defaults-pathname thunk)
......
...@@ -79,26 +79,26 @@ previously-loaded version of ASDF." ...@@ -79,26 +79,26 @@ 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! ;; NB: it's too late to do anything about functions in UIOP!
;; If you introduce some critically incompatibility there, you must change name. ;; 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
#:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies ;; plan #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies ;; plan
#: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
(redefined-classes (redefined-classes
;; redefining the classes causes interim circularities ;; 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
'((#:compile-concatenated-source-op (#:operation) ())))) '((#:compile-concatenated-source-op (#:operation) ()))))
(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
...@@ -106,12 +106,12 @@ previously-loaded version of ASDF." ...@@ -106,12 +106,12 @@ previously-loaded version of ASDF."
;; 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)))
(labels ((asym (x) (multiple-value-bind (s p) (if (consp x) (values (car x) (cadr x)) (values x :asdf)) (labels ((asym (x) (multiple-value-bind (s p) (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 (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots)))))))
;;; Self-upgrade functions ;;; Self-upgrade functions
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment