Commit 9ecc296c authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

1.662: don't tweak the packages when version is unchanged.

Don't try to too clever yet not enough with error while loading foo.asd.
Fix case where CL_SOURCE_REGISTRY=foo:
parent b57c0b62
Loading
Loading
Loading
Loading
+231 −223
Original line number Diff line number Diff line
@@ -58,6 +58,17 @@
;;;; See more at the end of the file.

(eval-when (:load-toplevel :compile-toplevel :execute)
  (let* ((asdf-version
          ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
          (subseq "VERSION:1.662" (1+ (length "VERSION"))))
         (existing-asdf (find-package :asdf))
         (versym '#:*asdf-version*)
         (existing-version (and existing-asdf (find-symbol (string versym) existing-asdf)))
         (redefined-functions
          '(#:perform #:explain #:output-files #:operation-done-p
            #:perform-with-restarts #:component-relative-pathname
            #:system-source-file)))
    (unless (equal asdf-version existing-version)
      (labels ((rename-away (package)
                 (loop :with name = (package-name package)
                   :for i :from 1 :for new = (format nil "~A.~D" name i)
@@ -85,8 +96,10 @@
                        p))
                     (t
                      (make-package name :nicknames nicknames :use use)))))
               (find-sym (symbol package)
                 (find-symbol (string symbol) package))
               (remove-symbol (symbol package)
             (let ((sym (find-symbol (string symbol) package)))
                 (let ((sym (find-sym symbol package)))
                   (when sym
                     (unexport sym package)
                     (unintern sym package))))
@@ -97,12 +110,12 @@
               (ensure-use (package use)
                 (dolist (used (reverse use))
                   (do-external-symbols (sym used)
                 (unless (eq sym (find-symbol (string sym) package))
                     (unless (eq sym (find-sym sym package))
                       (remove-symbol sym package)))
                   (use-package used package)))
               (ensure-fmakunbound (package symbols)
                 (loop :for name :in symbols
               :for sym = (find-symbol (string name) package)
                   :for sym = (find-sym name package)
                   :when sym :do (fmakunbound sym)))
               (ensure-export (package export)
                 (let ((syms (loop :for x :in export :collect
@@ -119,10 +132,6 @@
                   (ensure-export p export)
                   (ensure-fmakunbound p fmakunbound)
                   p)))
    (let ((redefined-functions
           '(#:perform #:explain #:output-files #:operation-done-p
             #:perform-with-restarts #:component-relative-pathname
             #:system-source-file)))
        (ensure-package
         ':asdf-utilities
         :nicknames '(#:asdf-extensions)
@@ -225,7 +234,7 @@
           #:operation-error #:compile-failed #:compile-warned #:compile-error
           #:error-name
           #:error-pathname
         #:missing-definition
           #:load-system-definition-error
           #:error-component #:error-operation
           #:system-definition-error
           #:missing-component
@@ -252,19 +261,14 @@
           #:compute-source-registry
           #:clear-source-registry
           #:ensure-source-registry
         #:process-source-registry)))))
           #:process-source-registry))
        (eval `(defvar ,(intern (string versym) (find-package :asdf)) ,asdf-version))))))

(in-package #:asdf)

;;;; -------------------------------------------------------------------------
;;;; User-visible parameters
;;;;
(defparameter *asdf-version*
  ;; This parameter isn't actually user-visible
  ;; -- please use the exported function ASDF:ASDF-VERSION below.
  ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
  (subseq "VERSION:1.661" (1+ (length "VERSION"))))

(defun asdf-version ()
  "Exported interface to the version of ASDF currently installed. A string.
You can compare this string with e.g.:
@@ -711,13 +715,13 @@ actually-existing directory."
  (:report (lambda (c s)
             (apply #'format s (format-control c) (format-arguments c)))))

(define-condition missing-definition (system-definition-error)
(define-condition load-system-definition-error (system-definition-error)
  ((name :initarg :name :reader error-name)
   (pathname :initarg :pathname :reader error-pathname))
   (pathname :initarg :pathname :reader error-pathname)
   (condition :initarg :condition :reader error-condition))
  (:report (lambda (c s)
             (format s "~@<Definition search function returned a wrong pathname ~A ~
                           in search of a definition for system ~A.~@:>"
                     (error-pathname c) (error-name c)))))
             (format s "~@<Error while trying to load definition for system ~A from pathname ~A: ~A~@:>"
                     (error-name c) (error-pathname c) (error-condition c)))))

(define-condition circular-dependency (system-definition-error)
  ((components :initarg :components :reader circular-dependency-components)))
@@ -1021,8 +1025,11 @@ to `~a` which is not a directory.~@:>"
                   (< (car in-memory) (safe-file-write-date on-disk))))
      (let ((package (make-temporary-package)))
        (unwind-protect
             (with-open-file (asd on-disk :if-does-not-exist nil)
               (if asd
             (handler-bind
                 ((error (lambda (condition)
                           (error 'load-system-definition-error
                                  :name name :pathname on-disk
                                  :condition condition))))
               (let ((*package* package))
                 (asdf-message
                  "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%"
@@ -1030,15 +1037,14 @@ to `~a` which is not a directory.~@:>"
                  ;; ON-DISK), but CMUCL barfs on that.
                  on-disk
                  *package*)
                     (load on-disk))
                   (error 'missing-definition :name name :pathname on-disk)))
                 (load on-disk)))
          (delete-package package))))
    (let ((in-memory (system-registered-p name)))
      (if in-memory
          (progn (if on-disk (setf (car in-memory)
          (progn (when on-disk (setf (car in-memory)
                                     (safe-file-write-date on-disk)))
                 (cdr in-memory))
          (if error-p (error 'missing-component :requires name))))))
          (when error-p (error 'missing-component :requires name))))))

(defun register-system (name system)
  (asdf-message "~&~@<; ~@;registering ~A as ~A~@:>~%" system name)
@@ -2758,8 +2764,8 @@ with a different configuration, so the configuration would be re-read then."
      :with directives = ()
      :with start = 0
      :with end = (length string)
      :for i = (or (position #\: string :start start) end) :do
      (let ((s (subseq string start i)))
      :for pos = (position #\: string :start start) :do
      (let ((s (subseq string start (or pos end))))
        (cond
         ((equal "" s) ; empty element: inherit
          (when inherit
@@ -2770,11 +2776,13 @@ with a different configuration, so the configuration would be re-read then."
          (push `(:tree ,(subseq s 0 (1- (length s)))) directives))
         (t
          (push `(:directory ,s) directives)))
         (setf start (1+ i))
         (when (>= start end)
        (cond
          (pos
           (setf start (1+ pos)))
          (t
           (unless inherit
             (push '(:ignore-inherited-configuration) directives))
           (return `(:source-registry ,@(nreverse directives)))))))))
           (return `(:source-registry ,@(nreverse directives))))))))))

(defun register-asd-directory (directory &key recurse exclude collect)
  (if (not recurse)