Commit 7ce11cfd authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Add support for *immutable-systems*.

Add regression tests for the feature.
Change the meaning of :force-not t to mean "anything but current system".
parent bc660a41
Loading
Loading
Loading
Loading
+2 −2
Original line number Diff line number Diff line
@@ -50,9 +50,9 @@
   (:file "find-system" :depends-on ("system" "cache"))
   (:file "find-component" :depends-on ("find-system"))
   (:file "operation" :depends-on ("upgrade"))
   (:file "action" :depends-on ("find-component" "operation" "cache"))
   (:file "action" :depends-on ("find-component" "operation"))
   (:file "lisp-action" :depends-on ("action"))
   (:file "plan" :depends-on ("lisp-action" "cache"))
   (:file "plan" :depends-on ("lisp-action"))
   (:file "operate" :depends-on ("plan"))
   (:file "output-translations" :depends-on ("operate"))
   (:file "source-registry" :depends-on ("find-system"))
+3 −0
Original line number Diff line number Diff line
@@ -9,6 +9,9 @@ cl-asdf (2:3.1.1-1) unstable; urgency=low
    subclasses of OPERATION implicitly propagate DOWNWARD and SIDEWAY.
    Failure to explicitly inherit from own of the explicitly propagating
    or non-propagating classes will result in a WARNING for now.
  * force-not now takes precedence over force, and systems named in the
    set (represented as an equal hash-table) *immutable-systems* are always
    forced-not, and even their .asd is not refreshed from the filesystem.
  * portability is much improved, with support for the latest GCL, and
    fixes for ABCL, CLISP, ECL, LispWorks, SBCL, XCL, etc.
  * bundle support was refactored; ECL support is fixed;
+11 −7
Original line number Diff line number Diff line
@@ -1723,14 +1723,18 @@ If @var{force} is a list, then it specifies a list of systems that
are forced to be recompiled even if not modified since last compilation.
If @var{force-not} is @code{:all}, then all systems
are forced not to be recompiled even if modified since last compilation.
If @var{force-not} is @code{t}, then only the system being loaded
is forced not to be recompiled even if modified since last compilation,
but other systems are not affected.
If @var{force-not} is @code{t}, then all systems but the system being loaded
are forced not to be recompiled even if modified since last compilation
(note: this was changed in ASDF 3.1.1).
If @var{force-not} is a list, then it specifies a list of systems that
are forced not to be recompiled even if modified since last compilation.

Both @var{force} and @{force-not} apply to systems that are dependencies and were already compiled.
@var{force-not} takes precedences over @var{force},
as it should, really, but unhappily only since 3.1.1.
Both apply to systems that are dependencies and were already compiled.
as it should, really, but unhappily only since ASDF 3.1.1.
Moreover, systems the name of which is member of the set @var{*immutable-systems*}
(represented as an equal hash-table) are always considered @var{forced-not}, and
even their @file{.asd} is not refreshed from the filesystem.

To see what @code{operate} would do, you can use:
@example
@@ -4290,8 +4294,8 @@ with fundamental issues in the original model being fixed.
Timestamps were not propagated at all, and now are.
The internal model of how actions depend on each other
is now both consistent and complete.
The :version and
the :force (system1 .. systemN) feature have been fixed.
The @code{:version} and
the @code{:force (system1 .. systemN)} feature have been fixed.

@item
Performance has been notably improved for large systems
+25 −0
Original line number Diff line number Diff line
@@ -19,6 +19,7 @@
   #:contrib-sysdef-search #:sysdef-find-asdf ;; backward compatibility symbols, functions removed
   #:sysdef-preloaded-system-search #:register-preloaded-system #:*preloaded-systems*
   #:clear-defined-systems #:*defined-systems*
   #:*immutable-systems*
   ;; defined in source-registry, but specially mentioned here:
   #:initialize-source-registry #:sysdef-source-registry-search))
(in-package :asdf/find-system)
@@ -140,6 +141,7 @@ called with an object of type asdf:system."
    (let ((name (coerce-name system)))
      (flet ((try (f) (if-let ((x (funcall f name))) (return-from search-for-system-definition x))))
        (try 'find-system-if-being-defined)
        (try 'sysdef-immutable-system-search)
        (map () #'try *system-definition-search-functions*)
        (try 'sysdef-preloaded-system-search))))

@@ -343,6 +345,25 @@ Going forward, we recommend new users should be using the source-registry.
                         old-version old-pathname version pathname))))
             nil))))) ;; only issue the warning the first time, but always return nil

  (defvar *immutable-systems* nil
    "An hash-set (equal hash-table mapping keys to T) of systems that are immutable,
i.e. already loaded in memory and not to be refreshed from the filesystem.
They will be treated specially by find-system, and passed as :force-not argument to make-plan.

If you deliver an image with many systems precompiled, *and* do not want to check the filesystem
for them every time a user loads an extension, what more risk a problematic upgrade or catastrophic
downgrade, before you dump an image, use:
   (setf asdf::*immutable-systems* (uiop:list-to-hash-set (asdf:already-loaded-systems)))")

  (defun sysdef-immutable-system-search (requested)
    (let ((name (coerce-name requested)))
      (when (and *immutable-systems* (gethash name *immutable-systems*))
        (or (cdr (system-registered-p requested))
            (error 'formatted-system-definition-error
                   :format-control "Requested system ~A is in the *immutable-systems* set, ~
but not loaded in memory"
                   :format-arguments (list name))))))

  (defun locate-system (name)
    "Given a system NAME designator, try to locate where to load the system from.
Returns five values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME
@@ -386,6 +407,10 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
        (restart-case
            (multiple-value-bind (foundp found-system pathname previous previous-time)
                (locate-system name)
              (when (and found-system (eq found-system previous)
                         (or (gethash name *systems-being-defined*)
                             (and *immutable-systems* (gethash name *immutable-systems*))))
                (return found-system))
              (assert (eq foundp (and (or found-system pathname previous) t)))
              (let ((previous-pathname (and previous (system-source-file previous)))
                    (system (or previous found-system)))
+1 −1
Original line number Diff line number Diff line
@@ -103,7 +103,7 @@
   #:*compile-file-warnings-behaviour*
   #:*compile-file-failure-behaviour*
   #:*resolve-symlinks*
   #:*load-system-operation*
   #:*load-system-operation* #:*immutable-systems*
   #:*asdf-verbose* ;; unused. For backward-compatibility only.
   #:*verbose-out*

Loading