Loading asdf.lisp +231 −223 Original line number Diff line number Diff line Loading @@ -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) Loading Loading @@ -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)))) Loading @@ -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 Loading @@ -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) Loading Loading @@ -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 Loading @@ -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.: Loading Loading @@ -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))) Loading Loading @@ -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~@:>~%" Loading @@ -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) Loading Loading @@ -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 Loading @@ -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) Loading Loading
asdf.lisp +231 −223 Original line number Diff line number Diff line Loading @@ -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) Loading Loading @@ -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)))) Loading @@ -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 Loading @@ -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) Loading Loading @@ -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 Loading @@ -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.: Loading Loading @@ -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))) Loading Loading @@ -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~@:>~%" Loading @@ -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) Loading Loading @@ -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 Loading @@ -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) Loading