Commit a3f8080e authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.136: try my very best for clean upgrade on abcl, clisp, cmucl. In the end, punt.

parent 1dfd01f0
...@@ -73,7 +73,7 @@ You can put together sentences using this phrase.")) ...@@ -73,7 +73,7 @@ You can put together sentences using this phrase."))
(defmethod operation-description (operation component) (defmethod operation-description (operation component)
(format nil (compatfmt "~@<~A on ~A~@:>") (format nil (compatfmt "~@<~A on ~A~@:>")
(type-of operation) component)) (type-of operation) component))
(defgeneric* explain (operation component)) (defgeneric* (explain) (operation component))
(defmethod explain ((o operation) (c component)) (defmethod explain ((o operation) (c component))
(asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (operation-description o c))) (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (operation-description o c)))
(define-convenience-action-methods explain (operation component)) (define-convenience-action-methods explain (operation component))
...@@ -110,10 +110,11 @@ You can put together sentences using this phrase.")) ...@@ -110,10 +110,11 @@ You can put together sentences using this phrase."))
(cdr (assoc (type-of o) (component-in-order-to c)))) ; User-specified in-order dependencies (cdr (assoc (type-of o) (component-in-order-to c)))) ; User-specified in-order dependencies
(defmethod component-self-dependencies ((o operation) (c component)) (defmethod component-self-dependencies ((o operation) (c component))
;; NB: result in the same format as component-depends-on
(loop :for (o-spec . c-spec) :in (component-depends-on o c) (loop :for (o-spec . c-spec) :in (component-depends-on o c)
:unless (eq o-spec 'feature) ;; avoid the FEATURE "feature" :unless (eq o-spec 'feature) ;; avoid the FEATURE "feature"
:when (find c c-spec :key #'(lambda (dep) (resolve-dependency-spec c dep))) :when (find c c-spec :key #'(lambda (dep) (resolve-dependency-spec c dep)))
:collect (cons (find-operation o o-spec) c))) :collect (list o-spec c)))
;;;; upward-operation, downward-operation ;;;; upward-operation, downward-operation
;; These together handle actions that propagate along the component hierarchy. ;; These together handle actions that propagate along the component hierarchy.
...@@ -152,7 +153,7 @@ You can put together sentences using this phrase.")) ...@@ -152,7 +153,7 @@ You can put together sentences using this phrase."))
;;;; Inputs, Outputs, and invisible dependencies ;;;; Inputs, Outputs, and invisible dependencies
(defgeneric* (output-files) (operation component)) (defgeneric* (output-files) (operation component))
(defgeneric* (input-files) (operation component)) (defgeneric* (input-files) (operation component))
(defgeneric* operation-done-p (operation component) (defgeneric* (operation-done-p) (operation component)
(:documentation "Returns a boolean, which is NIL if the action is forced to be performed again")) (:documentation "Returns a boolean, which is NIL if the action is forced to be performed again"))
(define-convenience-action-methods output-files (operation component)) (define-convenience-action-methods output-files (operation component))
(define-convenience-action-methods input-files (operation component)) (define-convenience-action-methods input-files (operation component))
...@@ -192,12 +193,13 @@ You can put together sentences using this phrase.")) ...@@ -192,12 +193,13 @@ You can put together sentences using this phrase."))
(declare (ignorable o c)) (declare (ignorable o c))
nil) nil)
(defmethod input-files ((o operation) (c file-component)) (defmethod input-files ((o operation) (c component))
(or (loop :for (dep-o) :in (component-self-dependencies o c) (or (loop :for (dep-o) :in (component-self-dependencies o c)
:append (or (output-files dep-o c) (input-files dep-o c))) :append (or (output-files dep-o c) (input-files dep-o c)))
;; no non-trivial previous operations needed? ;; no non-trivial previous operations needed?
;; I guess we work with the original source file, then ;; I guess we work with the original source file, then
(list (component-pathname c)))) (if-let ((pathname (component-pathname c)))
(and (file-pathname-p pathname) (list pathname)))))
;;;; Done performing ;;;; Done performing
...@@ -247,8 +249,8 @@ in some previous image, or T if it needs to be done.") ...@@ -247,8 +249,8 @@ in some previous image, or T if it needs to be done.")
;;;; Perform ;;;; Perform
(defgeneric* perform-with-restarts (operation component)) (defgeneric* (perform-with-restarts) (operation component))
(defgeneric* perform (operation component)) (defgeneric* (perform) (operation component))
(define-convenience-action-methods perform (operation component)) (define-convenience-action-methods perform (operation component))
(defmethod perform :before ((o operation) (c component)) (defmethod perform :before ((o operation) (c component))
......
...@@ -15,7 +15,7 @@ ...@@ -15,7 +15,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.135" ;; to be automatically updated by make bump-version :version "2.26.136" ;; to be automatically updated by make bump-version
:depends-on () :depends-on ()
:components ((:module "build" :components ((:file "asdf")))) :components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem)))) :in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem))))
......
...@@ -43,7 +43,7 @@ ...@@ -43,7 +43,7 @@
(:documentation "Find the top-level system containing COMPONENT")) (:documentation "Find the top-level system containing COMPONENT"))
(defgeneric* component-pathname (component) (defgeneric* component-pathname (component)
(:documentation "Extracts the pathname applicable for a particular component.")) (:documentation "Extracts the pathname applicable for a particular component."))
(defgeneric* component-relative-pathname (component) (defgeneric* (component-relative-pathname) (component)
(:documentation "Returns a pathname for the component argument intended to be (:documentation "Returns a pathname for the component argument intended to be
interpreted relative to the pathname of that component's parent. interpreted relative to the pathname of that component's parent.
Despite the function's name, the return value may be an absolute Despite the function's name, the return value may be an absolute
...@@ -58,7 +58,7 @@ another pathname in a degenerate way.")) ...@@ -58,7 +58,7 @@ another pathname in a degenerate way."))
;;; Backward compatible way of computing the FILE-TYPE of a component. ;;; Backward compatible way of computing the FILE-TYPE of a component.
;;; TODO: find users, have them stop using that. ;;; TODO: find users, have them stop using that.
(defgeneric* source-file-type (component system)) (defgeneric* (source-file-type) (component system))
(when-upgrade (:when (find-class 'component nil)) (when-upgrade (:when (find-class 'component nil))
(defmethod reinitialize-instance :after ((c component) &rest initargs &key) (defmethod reinitialize-instance :after ((c component) &rest initargs &key)
......
...@@ -47,7 +47,7 @@ ...@@ -47,7 +47,7 @@
;;;; Finding components ;;;; Finding components
(defgeneric* find-component (base path) (defgeneric* (find-component) (base path)
(:documentation "Find a component by resolving the PATH starting from BASE parent")) (:documentation "Find a component by resolving the PATH starting from BASE parent"))
(defgeneric* resolve-dependency-combination (component combinator arguments)) (defgeneric* resolve-dependency-combination (component combinator arguments))
......
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.135: Another System Definition Facility. ;;; This is ASDF 2.26.136: Another System Definition Facility.
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
...@@ -47,20 +47,24 @@ ...@@ -47,20 +47,24 @@
#+xcvb (module ()) #+xcvb (module ())
#+clisp
(in-package :cl-user) (in-package :cl-user)
#+clisp
#+cmu
(eval-when (:load-toplevel :compile-toplevel :execute)
(declaim (optimize (speed 1) (safety 3) (debug 3)))
(setf ext:*gc-verbose* nil))
#+(or abcl clisp cmu)
(eval-when (:load-toplevel :compile-toplevel :execute) (eval-when (:load-toplevel :compile-toplevel :execute)
(unless (member :asdf2.27 *features*) (unless (member :asdf2.27 *features*)
(let ((p (find-package :asdf))) (let* ((existing-version
(when p (when (find-package :asdf)
(rename-package (or (symbol-value (or (find-symbol (string :*asdf-version*) :asdf)
:asdf (find-symbol (string :*asdf-revision*) :asdf)))
(format nil "~A-~A" :asdf (string :1.x))))
(or (symbol-value (and (member :asdf2 *features*) (away (format nil "~A-~A" :asdf existing-version)))
(or (find-symbol (string :*asdf-version*) :asdf) (when existing-version
(find-symbol (string :*asdf-revision*) :asdf)))) (rename-package :asdf away)
:1.x)))
(when *load-verbose* (when *load-verbose*
(format t "; Renamed package ~A away to ~A~%" (format t "; Renamed package ~A away to ~A~%" :asdf away))))))
:asdf (package-name p)))))))
...@@ -16,7 +16,7 @@ ...@@ -16,7 +16,7 @@
#:upgrade-asdf #:cleanup-upgraded-asdf #:*post-upgrade-hook*)) #:upgrade-asdf #:cleanup-upgraded-asdf #:*post-upgrade-hook*))
(in-package :asdf/operate) (in-package :asdf/operate)
(defgeneric* operate (operation component &key &allow-other-keys)) (defgeneric* (operate) (operation component &key &allow-other-keys))
(define-convenience-action-methods (define-convenience-action-methods
operate (operation component &key) operate (operation component &key)
:operation-initargs t ;; backward-compatibility with ASDF1. Yuck. :operation-initargs t ;; backward-compatibility with ASDF1. Yuck.
......
...@@ -169,7 +169,7 @@ and the order is by decreasing length of namestring of the source pathname.") ...@@ -169,7 +169,7 @@ and the order is by decreasing length of namestring of the source pathname.")
(when inherit (when inherit
(process-output-translations (first inherit) :collect collect :inherit (rest inherit)))) (process-output-translations (first inherit) :collect collect :inherit (rest inherit))))
(defun* process-output-translations-directive (directive &key inherit collect) (defun* (process-output-translations-directive) (directive &key inherit collect)
(if (atom directive) (if (atom directive)
(ecase directive (ecase directive
((:enable-user-cache) ((:enable-user-cache)
...@@ -260,7 +260,7 @@ effectively disabling the output translation facility." ...@@ -260,7 +260,7 @@ effectively disabling the output translation facility."
(output-translations) (output-translations)
(initialize-output-translations))) (initialize-output-translations)))
(defun* apply-output-translations (path) (defun* (apply-output-translations) (path)
#+cormanlisp (resolve-symlinks* path) #-cormanlisp #+cormanlisp (resolve-symlinks* path) #-cormanlisp
(etypecase path (etypecase path
(logical-pathname (logical-pathname
......
...@@ -15,7 +15,7 @@ ...@@ -15,7 +15,7 @@
#:merge-pathnames* #:merge-pathnames*
;; Directories ;; Directories
#:pathname-directory-pathname #:pathname-parent-directory-pathname #:pathname-directory-pathname #:pathname-parent-directory-pathname
#:directory-pathname-p #:ensure-directory-pathname #:directory-pathname-p #:ensure-directory-pathname #:file-pathname-p
;; Absolute vs relative pathnames ;; Absolute vs relative pathnames
#:ensure-pathname-absolute #:ensure-pathname-absolute
#:relativize-directory-component #:relativize-pathname-directory #:relativize-directory-component #:relativize-pathname-directory
......
...@@ -365,6 +365,7 @@ of ASDF operation object and a COMPONENT object. The pairs will be ...@@ -365,6 +365,7 @@ of ASDF operation object and a COMPONENT object. The pairs will be
processed in order by OPERATE.")) processed in order by OPERATE."))
(defgeneric* perform-plan (plan &key)) (defgeneric* perform-plan (plan &key))
(defgeneric* plan-operates-on-p (plan component)) (defgeneric* plan-operates-on-p (plan component))
(defgeneric* (traverse) (operation component &key &allow-other-keys))
(define-convenience-action-methods traverse (operation component &key)) (define-convenience-action-methods traverse (operation component &key))
(defparameter *default-plan-class* 'sequential-plan) (defparameter *default-plan-class* 'sequential-plan)
......
...@@ -183,13 +183,13 @@ system names to pathnames of .asd files") ...@@ -183,13 +183,13 @@ system names to pathnames of .asd files")
(defun* environment-source-registry () (defun* environment-source-registry ()
(getenv "CL_SOURCE_REGISTRY")) (getenv "CL_SOURCE_REGISTRY"))
(defgeneric* process-source-registry (spec &key inherit register)) (defgeneric* (process-source-registry) (spec &key inherit register))
(defun* inherit-source-registry (inherit &key register) (defun* (inherit-source-registry) (inherit &key register)
(when inherit (when inherit
(process-source-registry (first inherit) :register register :inherit (rest inherit)))) (process-source-registry (first inherit) :register register :inherit (rest inherit))))
(defun* process-source-registry-directive (directive &key inherit register) (defun* (process-source-registry-directive) (directive &key inherit register)
(destructuring-bind (kw &rest rest) (if (consp directive) directive (list directive)) (destructuring-bind (kw &rest rest) (if (consp directive) directive (list directive))
(ecase kw (ecase kw
((:include) ((:include)
......
...@@ -14,8 +14,8 @@ ...@@ -14,8 +14,8 @@
#:find-system #:builtin-system-p)) ;; forward-reference, defined in find-system #:find-system #:builtin-system-p)) ;; forward-reference, defined in find-system
(in-package :asdf/system) (in-package :asdf/system)
(defgeneric* find-system (system &optional error-p)) (defgeneric* (find-system) (system &optional error-p))
(defgeneric* system-source-file (system) (defgeneric* (system-source-file) (system)
(:documentation "Return the source file in which system is defined.")) (:documentation "Return the source file in which system is defined."))
(defgeneric* builtin-system-p (system)) (defgeneric* builtin-system-p (system))
...@@ -55,7 +55,7 @@ ...@@ -55,7 +55,7 @@
in which the system specification (.asd file) is located." in which the system specification (.asd file) is located."
(pathname-directory-pathname (system-source-file system-designator))) (pathname-directory-pathname (system-source-file system-designator)))
(defun* system-relative-pathname (system name &key type) (defun* (system-relative-pathname) (system name &key type)
(subpathname (system-source-directory system) name :type type)) (subpathname (system-source-directory system) name :type type))
(defmethod component-pathname ((system system)) (defmethod component-pathname ((system system))
......
...@@ -35,22 +35,24 @@ ...@@ -35,22 +35,24 @@
;; "2.345.6" would be a development version in the official upstream ;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
(asdf-version "2.26.135") (asdf-version "2.26.136")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil)) (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*) (existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)) (already-there (equal asdf-version existing-version))
(redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops. (redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops.
'(#:perform #:explain #:output-files #:operation-done-p '(#:component-relative-pathname #:component-parent-pathname ;; component
#:component-parent-pathname #:traverse #:source-file-type
#:component-depends-on #:input-files #:find-system #:system-source-file #:system-relative-pathname ;; system
#:perform-with-restarts #:component-relative-pathname #:find-component ;; find-component
#:system-source-file #:operate #:find-component #:find-system #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action
#:apply-output-translations #:component-self-dependencies #:component-depends-on #:component-self-dependencies #:operation-done-p
#:system-relative-pathname #:traverse ;; plan
#:inherit-source-registry #:process-source-registry #:operate ;; operate
#:process-source-registry-directive #:source-file-type #:apply-output-translations ;; output-translations
#:process-output-translations-directive #:process-output-translations-directive
#:trivial-system-p #:inherit-source-registry #:process-source-registry ;; source-registry
#:process-source-registry-directive
#:trivial-system-p ;; bundle
;; NB: it's too late to do anything about asdf-driver functions! ;; NB: it's too late to do anything about asdf-driver functions!
)) ))
(uninterned-symbols (uninterned-symbols
......
Markdown is supported
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