Commit a3b85c8b authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Refactor load-asd to perform a define-op

Split asdf/system-registry away from asdf/find-system: the former defines
the internal *defined-systems* table and the search mechanism, whereas
the latter keeps the find-system methods, but also defines a new
define-op operation, on load-asd will call operate.

Reorder dependencies accordingly.

Have forcing come from the plan, so as to not force again actions from
dependencies that were already performed in a subcall to operate.

Accept asdf.asd from the same version, so asdf.asd doesn't get removed
at the very next call to operate (which may now come implicitly
at the least provocation).
parent a9c22442
......@@ -80,7 +80,7 @@ XCL ?= xcl
header_lisp := header.lisp
driver_lisp := uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp
defsystem_lisp := upgrade.lisp session.lisp component.lisp operation.lisp system.lisp action.lisp find-system.lisp find-component.lisp lisp-action.lisp plan.lisp operate.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp package-inferred-system.lisp output-translations.lisp source-registry.lisp backward-internals.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp
defsystem_lisp := upgrade.lisp session.lisp component.lisp operation.lisp system.lisp system-registry.lisp action.lisp lisp-action.lisp find-component.lisp plan.lisp operate.lisp find-system.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp package-inferred-system.lisp output-translations.lisp source-registry.lisp backward-internals.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp
all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp)
print-% : ; @echo $* = $($*)
......
......@@ -48,16 +48,17 @@
(:file "component" :depends-on ("session"))
(:file "operation" :depends-on ("session"))
(:file "system" :depends-on ("component"))
(:file "system-registry" :depends-on ("system"))
(:file "action" :depends-on ("session" "system" "operation"))
(:file "find-system" :depends-on ("session" "system" "action"))
(:file "find-component" :depends-on ("find-system"))
(:file "lisp-action" :depends-on ("action" "find-system"))
(:file "lisp-action" :depends-on ("action"))
(:file "find-component" :depends-on ("component"))
(:file "plan" :depends-on ("lisp-action" "find-component"))
(:file "operate" :depends-on ("plan"))
(:file "parse-defsystem" :depends-on ("system" "lisp-action" "operate"))
(:file "find-system" :depends-on ("system-registry" "operate"))
(:file "parse-defsystem" :depends-on ("system-registry" "lisp-action" "operate"))
(:file "bundle" :depends-on ("lisp-action" "operate" "parse-defsystem"))
(:file "concatenate-source" :depends-on ("plan" "parse-defsystem" "bundle"))
(:file "package-inferred-system" :depends-on ("find-system" "parse-defsystem"))
(:file "package-inferred-system" :depends-on ("parse-defsystem"))
(:file "output-translations" :depends-on ("operate"))
(:file "source-registry" :depends-on ("find-system"))
(:file "backward-internals" :depends-on ("find-system" "parse-defsystem"))
......
......@@ -2,15 +2,15 @@
;;;; Finding components
(uiop/package:define-package :asdf/find-component
(:recycle :asdf/find-component :asdf)
(:recycle :asdf/find-component :asdf/find-system :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session
:asdf/component :asdf/system :asdf/find-system)
:asdf/component :asdf/system :asdf/system-registry)
(:export
#:find-component
#:resolve-dependency-name #:resolve-dependency-spec
#:resolve-dependency-combination
;; Conditions
#:missing-component #:missing-component-of-version #:retry
#:missing-component #:missing-requires #:missing-parent #:missing-component-of-version #:retry
#:missing-dependency #:missing-dependency-of-version
#:missing-requires #:missing-parent
#:missing-required-by #:missing-version))
......@@ -19,6 +19,10 @@
;;;; Missing component conditions
(with-upgradability ()
(define-condition missing-component (system-definition-error)
((requires :initform "(unnamed)" :reader missing-requires :initarg :requires)
(parent :initform nil :reader missing-parent :initarg :parent)))
(define-condition missing-component-of-version (missing-component)
((version :initform nil :reader missing-version :initarg :version)))
......
This diff is collapsed.
......@@ -4,7 +4,7 @@
(uiop/package:define-package :asdf/footer
(:recycle :asdf/footer :asdf)
(:use :uiop/common-lisp :uiop
:asdf/upgrade :asdf/find-system :asdf/operate :asdf/bundle)
:asdf/upgrade :asdf/system-registry :asdf/operate :asdf/bundle)
;; Happily, all those implementations all have the same module-provider hook interface.
#+(or abcl clasp cmucl clozure ecl mkcl sbcl)
(:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext
......
......@@ -8,7 +8,7 @@
#:loaded-systems ; makes for annoying SLIME completion
#:output-files-for-system-and-operation) ; ASDF-BINARY-LOCATION function we use to detect ABL
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session
:asdf/component :asdf/system :asdf/find-system :asdf/find-component
:asdf/component :asdf/system :asdf/system-registry :asdf/find-system :asdf/find-component
:asdf/operation :asdf/action :asdf/lisp-action
:asdf/output-translations :asdf/source-registry
:asdf/plan :asdf/operate :asdf/parse-defsystem :asdf/bundle :asdf/concatenate-source
......
......@@ -4,8 +4,7 @@
(uiop/package:define-package :asdf/lisp-action
(:recycle :asdf/lisp-action :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session
:asdf/component :asdf/system :asdf/find-system
:asdf/operation :asdf/action)
:asdf/component :asdf/system :asdf/operation :asdf/action)
(:export
#:try-recompiling
#:cl-source-file #:cl-source-file.cl #:cl-source-file.lsp
......
......@@ -5,7 +5,7 @@
set here=%~dp0
set header_lisp=header.lisp
set driver_lisp=uiop\package.lisp + uiop\common-lisp.lisp + uiop\utility.lisp + uiop\version.lisp + uiop\os.lisp + uiop\pathname.lisp + uiop\filesystem.lisp + uiop\stream.lisp + uiop\image.lisp + uiop\lisp-build.lisp + uiop\launch-program.lisp + uiop\run-program.lisp + uiop\configuration.lisp + uiop\backward-driver.lisp + uiop\driver.lisp
set defsystem_lisp=upgrade.lisp + session.lisp + component.lisp + operation.lisp + system.lisp + action.lisp + find-system.lisp + find-component.lisp + lisp-action.lisp + plan.lisp + operate.lisp + parse-defsystem.lisp + bundle.lisp + concatenate-source.lisp + package-inferred-system.lisp + output-translations.lisp + source-registry.lisp + backward-internals.lisp + backward-interface.lisp + interface.lisp + user.lisp + footer.lisp
set defsystem_lisp=upgrade.lisp + session.lisp + component.lisp + operation.lisp + system.lisp + system-registry.lisp + action.lisp + lisp-action.lisp + find-component.lisp + plan.lisp + operate.lisp + find-system.lisp + parse-defsystem.lisp + bundle.lisp + concatenate-source.lisp + package-inferred-system.lisp + output-translations.lisp + source-registry.lisp + backward-internals.lisp + backward-interface.lisp + interface.lisp + user.lisp + footer.lisp
%~d0
cd "%~p0"
......
......@@ -6,7 +6,7 @@ here="$(dirname $0)"
header_lisp="header.lisp"
driver_lisp="uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp"
defsystem_lisp="upgrade.lisp session.lisp component.lisp operation.lisp system.lisp action.lisp find-system.lisp find-component.lisp lisp-action.lisp plan.lisp operate.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp package-inferred-system.lisp output-translations.lisp source-registry.lisp backward-internals.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp"
defsystem_lisp="upgrade.lisp session.lisp component.lisp operation.lisp system.lisp system-registry.lisp action.lisp lisp-action.lisp find-component.lisp plan.lisp operate.lisp find-system.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp package-inferred-system.lisp output-translations.lisp source-registry.lisp backward-internals.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp"
all () {
# Default action: bootstrap asdf.lisp
......
......@@ -4,14 +4,12 @@
(uiop/package:define-package :asdf/operate
(:recycle :asdf/operate :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session
:asdf/component :asdf/system :asdf/operation :asdf/action
:asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/plan)
:asdf/component :asdf/system :asdf/system-registry :asdf/find-component
:asdf/operation :asdf/action :asdf/lisp-action :asdf/plan)
(:export
#:operate #:oos
#:build-op #:make
#:operate #:oos #:build-op #:make
#:load-system #:load-systems #:load-systems*
#:compile-system #:test-system #:require-system
#:module-provide-asdf
#:compile-system #:test-system #:require-system #:module-provide-asdf
#:component-loaded-p #:already-loaded-systems))
(in-package :asdf/operate)
......
......@@ -5,7 +5,7 @@
(:recycle :asdf/package-inferred-system :asdf/package-system :asdf)
(:use :uiop/common-lisp :uiop
:asdf/upgrade :asdf/session
:asdf/component :asdf/system :asdf/find-system :asdf/lisp-action
:asdf/component :asdf/system :asdf/system-registry :asdf/lisp-action
:asdf/parse-defsystem)
(:export
#:package-inferred-system #:sysdef-package-inferred-system-search
......
......@@ -5,8 +5,8 @@
(:recycle :asdf/parse-defsystem :asdf/defsystem :asdf)
(:nicknames :asdf/defsystem) ;; previous name, to be compatible with, in case anyone cares
(:use :uiop/common-lisp :asdf/driver :asdf/upgrade
:asdf/session :asdf/component :asdf/system
:asdf/find-system :asdf/find-component :asdf/action :asdf/lisp-action :asdf/operate)
:asdf/session :asdf/component :asdf/system :asdf/system-registry
:asdf/find-component :asdf/action :asdf/lisp-action :asdf/operate)
(:import-from :asdf/system #:depends-on #:weakly-depends-on)
(:export
#:defsystem #:register-system-definition
......
......@@ -6,8 +6,8 @@
;; that used to live there before 3.2.0.
(:recycle :asdf/plan :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session
:asdf/component :asdf/operation :asdf/action :asdf/lisp-action :asdf/system
:asdf/find-component :asdf/find-system)
:asdf/component :asdf/operation :asdf/action :asdf/lisp-action
:asdf/system :asdf/system-registry :asdf/find-component)
(:export
#:component-operation-time
#:plan #:plan-traversal #:sequential-plan #:*plan-class*
......@@ -48,7 +48,7 @@
(:documentation "Returns the ACTION-STATUS associated to
the action of OPERATION on COMPONENT in the PLAN"))
(defgeneric (setf action-status) (new-status session operation component)
(defgeneric (setf action-status) (new-status plan operation component)
(:documentation "Sets the ACTION-STATUS associated to
the action of OPERATION on COMPONENT in the PLAN"))
......@@ -285,17 +285,7 @@ initialized with SEED."
(values (gethash (cons o c) (visited-actions *asdf-session*)))))
(defgeneric record-dependency (plan operation component)
(:documentation "Record an action as a dependency in the current plan"))
(defmethod record-dependency ((plan null) (operation t) (component t))
(let* ((action (first (visiting-action-list *asdf-session*)))
(parent-operation (action-operation action))
(parent-component (action-component action)))
(when (and parent-operation parent-component)
(unless (and (typep parent-operation 'define-op) (typep parent-component 'system))
(cerror "Invalid recursive use of (OPERATE ~S ~S) while visiting ~S"
operation component action))
(push action (definition-dependencies parent-component))))))
(:documentation "Record an action as a dependency in the current plan")))
;;;; Actual traversal: traverse-action
......@@ -420,15 +410,12 @@ initialized with SEED."
(with-compilation-unit () ;; backward-compatibility.
(call-next-method)))) ;; Going forward, see deferred-warning support in lisp-build.
(defmethod perform-plan ((plan t) &rest keys &key &allow-other-keys)
(apply 'perform-plan (plan-actions plan) keys))
(defmethod perform-plan ((steps list) &key force &allow-other-keys)
(loop :for action :in steps
(defmethod perform-plan ((plan t) &key &allow-other-keys)
(loop :for action :in (plan-actions plan)
:as o = (action-operation action)
:as c = (action-component action)
:when (or force (not (nth-value 1 (compute-action-stamp nil o c))))
:do (perform-with-restarts o c)))
:as c = (action-component action) :do
(unless (nth-value 1 (compute-action-stamp plan o c))
(perform-with-restarts o c))))
(defmethod plan-operates-on-p ((plan plan-traversal) (component-path list))
(plan-operates-on-p (plan-actions plan) component-path))
......
......@@ -4,7 +4,7 @@
(uiop/package:define-package :asdf/source-registry
(:recycle :asdf/source-registry :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system)
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/system :asdf/system-registry)
(:export
#:*source-registry-parameter* #:*default-source-registries*
#:invalid-source-registry
......
This diff is collapsed.
......@@ -2,8 +2,8 @@
;;;; Systems
(uiop/package:define-package :asdf/system
(:recycle :asdf :asdf/system)
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component)
(:recycle :asdf :asdf/system :asdf/find-system)
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session :asdf/component)
(:export
#:system #:proto-system #:undefined-system #:reset-system
#:system-source-file #:system-source-directory #:system-relative-pathname
......@@ -18,6 +18,7 @@
#:mailto #:system-mailto
#:long-name #:system-long-name
#:source-control #:system-source-control
#:coerce-name #:primary-system-name #:coerce-filename
#:find-system #:builtin-system-p)) ;; forward-reference, defined in find-system
(in-package :asdf/system)
......@@ -106,6 +107,33 @@ based on supplied KEYS."
(apply 'reinitialize-instance system keys)))
;;; Canonicalizing system names
(with-upgradability ()
(defun coerce-name (name)
"Given a designator for a component NAME, return the name as a string.
The designator can be a COMPONENT (designing its name; note that a SYSTEM is a component),
a SYMBOL (designing its name, downcased), or a STRING (designing itself)."
(typecase name
(component (component-name name))
(symbol (string-downcase name))
(string name)
(t (sysdef-error (compatfmt "~@<Invalid component designator: ~3i~_~A~@:>") name))))
(defun primary-system-name (name)
"Given a system designator NAME, return the name of the corresponding primary system,
after which the .asd file is named. That's the first component when dividing the name
as a string by / slashes."
(first (split-string (coerce-name name) :separator "/")))
(defun coerce-filename (name)
"Coerce a system designator NAME into a string suitable as a filename component.
The (current) transformation is to replace characters /:\\ each by --,
the former being forbidden in a filename component.
NB: The onus is unhappily on the user to avoid clashes."
(frob-substrings (coerce-name name) '("/" ":" "\\") "--")))
;;;; Pathnames
(with-upgradability ()
......
;;; -*- Lisp -*-
(asdf:defsystem file3-only
:components ((:file "file3")))
(defvar *file3-only-asd-loaded* 0)
(incf *file3-only-asd-loaded*)
(in-package :test-package)
(assert *file3*)
(defparameter *file4* t)
(defpackage :test-asdf-system
(:use :cl :asdf))
(:use :cl :asdf :uiop))
(in-package :test-asdf-system)
(defvar *times-loaded* 0)
(incf *times-loaded*)
;;(format! t "Times that test-asdf.asd was loaded: ~D~%" *times-loaded*)
(defsystem :test-asdf :class package-inferred-system)
......@@ -75,7 +76,10 @@
(defsystem :test-asdf/force
:depends-on (:test-asdf/force1)
:components ((:file "file3")))
:components ((:file "file4")))
(defsystem :test-asdf/force1
;; Importantly, this depends on a system that is NOT defined in the same file,
;; so that we can check that forcing causes one file to be reloaded but not the other.
:depends-on (:file3-only)
:components ((:file "file1")))
;;; -*- Lisp -*-
;;; test to check that the cache doesn't upset error signaling from FIND-SYSTEM
;;; Test to check that the cache doesn't upset error signaling from FIND-SYSTEM
(in-package :asdf-test)
(defparameter *all-systems*
(list
"test-asdf"
"test-asdf/all"
"test-asdf/1"
"test-asdf/2"
"test-asdf/4"
"test-asdf/test9-1"
"test-asdf/test-module-depend"
"test-asdf/test9-2"
"test-asdf/test9-3"
"test-asdf/test-source-directory-1"
"test-asdf/test-source-directory-2"
"test-asdf/bundle-1"
"test-asdf/bundle-2"
"test-asdf/force"
"test-asdf/force1"))
(setf asdf::*asdf-session* nil)
(setf *central-registry* nil)
(asdf::clear-defined-systems)
(defun clear-caches-and-search ()
(setf asdf:*central-registry* nil)
(mapc #'clear-system *all-systems*))
(clear-caches-and-search)
(assert (not (asdf:find-system "test-asdf/force1" nil)))
(multiple-value-bind (ret cond)
(ignore-errors (asdf:find-system "test-asdf/force1" t))
(assert (not ret))
(assert (typep cond 'asdf:missing-component)))
(assert-equal nil (find-system "test-asdf/force1" nil))
(errors missing-component (find-system "test-asdf/force1" t))
......@@ -44,16 +44,14 @@
(progn
(reset-session)
(signals asdf:missing-dependency (def-test-system unloadable-system
:defsystem-depends-on (nonexistent-system)))
(signals missing-dependency (def-test-system unloadable-system
:defsystem-depends-on (nonexistent-system)))
(assert (not (system-registered-p "unloadable-system"))))
(progn
(signals asdf:missing-dependency (find-system "test-defsystem-depends-on-missing-system"))
(assert (typep (asdf::registered-system "test-defsystem-depends-on-missing-system")
'asdf::undefined-system)))
(signals missing-dependency (find-system "test-defsystem-depends-on-missing-system"))
(assert (not (asdf::registered-system "test-defsystem-depends-on-missing-system"))))
(progn
(signals asdf::system-definition-error (find-system "test-defsystem-depends-on-circular"))
(assert (typep (asdf::registered-system "test-defsystem-depends-on-circular")
'asdf::undefined-system)))
(assert (not (asdf::registered-system "test-defsystem-depends-on-circular"))))
......@@ -6,7 +6,9 @@
(require-system 'test-asdf/force)
(assert (component-loaded-p 'test-asdf/force))
(assert-equal (asymval :*file3* :test-package) t)
(assert-equal (asymval :*file4* :test-package) t)
(assert-equal (asymval :*times-loaded* :test-asdf-system) 1)
(assert-equal (asymval :*file3-only-asd-loaded* :asdf-user) 1)
(defparameter file1 (test-fasl "file1"))
(defparameter file1-date (file-write-date file1))
......@@ -19,21 +21,24 @@
(reset-session-visited)
(let ((plan (traverse 'load-op 'test-asdf/force :force t)))
(DBG "Check that :force t forces the current system but not its dependencies" plan)
(assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file3")))
(assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file4")))
(assert (not (asdf::plan-operates-on-p plan '("file3-only" "file3"))))
(assert (not (asdf::plan-operates-on-p plan '("test-asdf/force1" "file1")))))
(reset-session-visited)
(let ((plan (traverse 'load-op 'test-asdf/force :force :all)))
(DBG "Check that :force :all forces the current system and its dependencies" plan)
(assert plan)
(assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file3")))
(assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file4")))
(assert (asdf::plan-operates-on-p plan '("file3-only" "file3")))
(assert (asdf::plan-operates-on-p plan '("test-asdf/force1" "file1"))))
(reset-session-visited)
(let ((plan (traverse 'load-op 'test-asdf/force :force :all :force-not t)))
(DBG "Check that :force-not takes precedence over :force, with t means \"all but current system\"" plan)
(assert plan)
(assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file3")))
(assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file4")))
(assert (not (asdf::plan-operates-on-p plan '("file3-only" "file3"))))
(assert (not (asdf::plan-operates-on-p plan '("test-asdf/force1" "file1")))))
(reset-session-visited)
......@@ -53,11 +58,13 @@
(assert (null plan)))
(reset-session-visited)
(let* ((*immutable-systems* (list-to-hash-set '("test-asdf/force1")))
(plan (traverse 'load-op 'test-asdf/force :force :all :force-not t)))
(let* ((asdf::*immutable-systems* (list-to-hash-set '("test-asdf/force1")))
(plan (traverse 'load-op 'test-asdf/force :force :all)))
(DBG "Check that immutable-systems will block forcing" plan)
(assert plan)
(assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file3")))
(assert (asdf::plan-operates-on-p plan '("test-asdf/force" "file4")))
;; transitively included via force1 test-asdf/only, which blocks the traversal
(assert (not (asdf::plan-operates-on-p plan '("file3-only" "file3"))))
(assert (not (asdf::plan-operates-on-p plan '("test-asdf/force1" "file1")))))
;; unforced, date should stay same
......@@ -78,23 +85,24 @@
(reset-session-visited)
(DBG "Check that load-system will reload")
(setf test-package::*file1* nil)
(assert (not test-package::*file1*))
(load-system 'test-asdf/force1)
;; FIXME: It is unclear why this fails (at least on mkcl even randomly)
#-mkcl
(with-expected-failure (#+(or clasp clisp (and ecl (not ecl-bytecmp))) t)
(assert-equal (get-file-stamp file1) date2)
(assert-equal test-package::*file1* t))
(assert test-package::*file1*)
;; forced, it should be later
(reset-session-visited)
(DBG "Check that force reloading loads again")
(setf test-package::*file3* :reset)
(load-system 'test-asdf/force :force :all)
(assert-compare (>= (get-file-stamp file1) file1-date))
(assert-compare (>= (- (get-file-stamp file1) file1-date) 0))
(assert-equal test-package::*file3* t)
(DBG "Check that test-asdf was loaded only once all along")
(assert-equal (asymval :*times-loaded* :test-asdf-system) 1)
(DBG "Check that test-asdf.asd was loaded each time it was forced")
(assert-equal (asymval :*times-loaded* :test-asdf-system) 3)
(DBG "Check that file3-only.asd was loaded only twice, with the :force :all")
(assert-equal (asymval :*file3-only-asd-loaded* :asdf-user) 2)
(setf test-package::*file3* :reset)
......@@ -104,7 +112,7 @@
(unset-asdf-cache-entry '(find-system "test-asdf/force"))
(touch-file "test-asdf.asd" :timestamp (+ 10000 (get-file-stamp file1)))
(require-system 'test-asdf/force)
(assert-equal (asymval :*times-loaded* :test-asdf-system) 1)
(assert-equal (asymval :*times-loaded* :test-asdf-system) 3)
(assert-equal test-package::*file3* :reset)
(reset-session-visited)
......@@ -112,5 +120,5 @@
(require-system 'test-asdf/force)
;;; Somehow, it loads the system...
(assert-equal (asymval :*times-loaded* :test-asdf-system) 1)
(assert-equal (asymval :*times-loaded* :test-asdf-system) 3)
(assert-equal test-package::*file3* :reset)
......@@ -26,14 +26,14 @@
(current-system-source-file "test-mutual-redefinition-1"))
(assert-pathname-equal
(test-source "test-mutual-redefinition-1.asd")
(current-system-source-file "test-mutual-redefinition-2"))
(current-system-source-file "test-mutual-redefinition-2")))
(with-asdf-session (:override t)
(DBG "loading test-mutual-redefinition-2 in a different cache session")
(load-system 'test-mutual-redefinition-2)
(assert-pathname-equal
(test-source "test-mutual-redefinition-2.asd")
(current-system-source-file "test-mutual-redefinition-1"))
(assert-pathname-equal
(test-source "test-mutual-redefinition-2.asd")
(current-system-source-file "test-mutual-redefinition-2"))))
(with-asdf-session (:override t)
(DBG "loading test-mutual-redefinition-2 in a different cache session")
(load-system 'test-mutual-redefinition-2)
(assert-pathname-equal
(test-source "test-mutual-redefinition-2.asd")
(current-system-source-file "test-mutual-redefinition-2"))
(assert-pathname-equal
(test-source "test-mutual-redefinition-2.asd")
(current-system-source-file "test-mutual-redefinition-1")))
;;; -*- Lisp -*-
(in-package :asdf-test)
(reset-session)
(DBG "Consider a system that does not exist. Loading it fails.")
(assert (null (find-system :this-system-does-not-exist nil)))
(errors missing-component (load-system :this-system-does-not-exist))
......
......@@ -3,6 +3,20 @@
(format! t "~%Using ASDF ~A~%" (asdf-version))
(assert (version< "3.0" (asdf-version))) ;; check that we have a recent enough ASDF
(DBG "Let's define some methods on input-files, to later check what an upgrade does to them.")
(def-test-system "fooey")
(defparameter *ticks* 0)
(defun tick () (incf *ticks*))
(defsystem "foo")
(defmethod input-files :after ((o load-op) (c system)) (tick))
(assert-equal *ticks* 0)
(input-files 'load-op "foo")
(assert-equal *ticks* 1)
(input-files 'load-op "foo")
(assert-equal *ticks* 1) ;; It was cached.
(assert (find-system "fooey" nil))
(DBG "Try load ASDF with an empty configuration")
(initialize-source-registry
'(:source-registry :ignore-inherited-configuration))
......@@ -35,6 +49,7 @@
(error "Should not have issued warning, but did issue:~% ~A" c))))
(clear-system "asdf")
(upgrade-asdf)))
(assert-equal nil (system-source-file (find-system :asdf)))
(DBG "Load ASDF with proper configuration: should find asdf.asd from the source above")
(initialize-source-registry
......@@ -43,27 +58,35 @@
(:directory ,*uiop-directory*)
:ignore-inherited-configuration))
(clear-system "asdf")
(load-system :asdf)
;; This time we found it, but it was skipped because the version was the same
(assert-equal nil (system-source-file (find-system :asdf)))
(with-asdf-session (:override t)
(with-expected-failure (#+xcl t)
;; expected-failure: XCL has trouble with the ASDF upgrade
(load-system :asdf)
(assert-pathname-equal (subpathname *asdf-directory* "asdf.asd")
(system-source-file (find-system :asdf))))
;; But if we cheat on our version, that should work
(setf asdf::*asdf-version* "3.0")
(clear-system "asdf")
(def-test-system "fooey")
(defparameter *ticks* 0)
(defun tick () (incf *ticks*))
(defmethod input-files :after ((load-op operation) (c system)) (tick))
(input-files 'load-op "asdf")
(assert-equal *ticks* 3)
(DBG "Loading from the same version shouldn't have reset methods")
(setf *ticks* 2)
(input-files 'load-op "foo")
(assert-equal *ticks* 3))
(DBG "Loading from an ancient version WILL reset methods")
(assert (find-system "fooey" nil))
(defparameter *current-version* (asdf-version))
(setf asdf::*asdf-version* "2.0" asdf/upgrade::*previous-asdf-versions* '("2.0"))
(assert (asdf/upgrade::upgrading-p))
(clear-system "asdf")
(reset-session)
(with-expected-failure (#+xcl t)
;; expected-failure: XCL has trouble with the ASDF upgrade
(load-system :asdf)
(assert-equal (asdf-version) *current-version*)
(assert-pathname-equal (subpathname *asdf-directory* "asdf.asd")
(system-source-file (find-system :asdf))))
;; Upgrading from an old-enough version redefined away the input-files method!
(setf *ticks* 4)
(input-files 'load-op "asdf")
......
......@@ -255,8 +255,8 @@
;; restarts
asdf/action:accept
asdf/find-component:retry
asdf/find-system:coerce-entry-to-directory
asdf/find-system:remove-entry-from-registry
asdf/system-registry:coerce-entry-to-directory
asdf/system-registry:remove-entry-from-registry
asdf/lisp-action:try-recompiling
;; types
asdf/bundle:user-system
......@@ -272,8 +272,8 @@
;; backward compatibility upgrade only
asdf/backward-interface:on-failure
asdf/backward-interface:on-warnings
asdf/find-system:contrib-sysdef-search
asdf/find-system:sysdef-find-asdf
asdf/system-registry:contrib-sysdef-search
asdf/system-registry:sysdef-find-asdf
;; restart
asdf/session:clear-configuration-and-retry
))
......
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