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

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
No related branches found
No related tags found
No related merge requests found
......@@ -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
))
......
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