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
......@@ -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)
......
Supports Markdown
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