Commit 49ab669e authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.127: upgrade frobbing. Got CLISP much further along.

parent 8ec5317d
...@@ -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.126" ;; to be automatically updated by bin/bump-revision :version "2.26.127" ;; to be automatically updated by bin/bump-revision
: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))))
......
...@@ -29,7 +29,9 @@ ...@@ -29,7 +29,9 @@
;; Internals we'd like to share with the ASDF package, especially for upgrade purposes ;; Internals we'd like to share with the ASDF package, especially for upgrade purposes
#:name #:version #:description #:long-description #:author #:maintainer #:licence #:name #:version #:description #:long-description #:author #:maintainer #:licence
#:defsystem-depends-on #:components-by-name #:components
#:children #:children-by-name #:default-component-class
#:author #:maintainer #:licence #:source-file #:defsystem-depends-on
#:sibling-dependencies #:if-feature #:in-order-to #:inline-methods #:sibling-dependencies #:if-feature #:in-order-to #:inline-methods
#:relative-pathname #:absolute-pathname #:operation-times #:around-compile #:relative-pathname #:absolute-pathname #:operation-times #:around-compile
#:%encoding #:properties #:parent)) #:%encoding #:properties #:parent))
......
...@@ -136,7 +136,7 @@ ...@@ -136,7 +136,7 @@
(component-pathname component) ; eagerly compute the absolute pathname (component-pathname component) ; eagerly compute the absolute pathname
(let ((sysdir (system-source-directory (component-system component)))) ;; requires the previous (let ((sysdir (system-source-directory (component-system component)))) ;; requires the previous
(setf version (normalize-version version sysdir))) (setf version (normalize-version version sysdir)))
(when (and versionp (not (parse-version version nil))) (when (and versionp version (not (parse-version version nil)))
(warn (compatfmt "~@<Invalid version ~S for component ~S~@[ of ~S~]~@:>") (warn (compatfmt "~@<Invalid version ~S for component ~S~@[ of ~S~]~@:>")
version name parent)) version name parent))
(setf (component-version component) version) (setf (component-version component) version)
......
...@@ -12,7 +12,7 @@ ...@@ -12,7 +12,7 @@
;;;; Configure ;;;; Configure
(setf asdf/utility:*asdf-debug-utility* (setf asdf/utility:*asdf-debug-utility*
'(asdf/interface:system-relative-pathname :asdf "contrib/debug.lisp")) '(asdf/system:system-relative-pathname :asdf "contrib/debug.lisp"))
;;;; Hook ASDF into the implementation's REQUIRE and other entry points. ;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
......
;; -*- 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.126: Another System Definition Facility. ;;; This is ASDF 2.26.127: 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>.
......
...@@ -10,6 +10,8 @@ ...@@ -10,6 +10,8 @@
;; and reexported in a different package ;; and reexported in a different package
;; (alternatively the package may be dropped & replaced by one with a new name). ;; (alternatively the package may be dropped & replaced by one with a new name).
#+clisp (declaim (optimize (speed 1)(safety 3)(debug 3)))
(defpackage :asdf/package (defpackage :asdf/package
(:use :common-lisp) (:use :common-lisp)
(:export (:export
...@@ -253,6 +255,10 @@ or when loading the package is optional." ...@@ -253,6 +255,10 @@ or when loading the package is optional."
(when nuke (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s)))) (when nuke (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s))))
(ensure-package-unused p) (ensure-package-unused p)
(delete-package package)))) (delete-package package))))
(defun package-names (package)
(cons (package-name package) (package-nicknames package)))
(defun packages-from-names (names)
(remove-duplicates (remove nil (mapcar #'find-package names)) :from-end t))
(defun fresh-package-name (&key (prefix :%TO-BE-DELETED) (defun fresh-package-name (&key (prefix :%TO-BE-DELETED)
separator separator
(index (random most-positive-fixnum))) (index (random most-positive-fixnum)))
...@@ -260,12 +266,11 @@ or when loading the package is optional." ...@@ -260,12 +266,11 @@ or when loading the package is optional."
:for n = (format nil "~A~@[~A~D~]" prefix (and (plusp i) (or separator "")) i) :for n = (format nil "~A~@[~A~D~]" prefix (and (plusp i) (or separator "")) i)
:thereis (and (not (find-package n)) n))) :thereis (and (not (find-package n)) n)))
(defun rename-package-away (p &rest keys &key prefix &allow-other-keys) (defun rename-package-away (p &rest keys &key prefix &allow-other-keys)
(rename-package (let ((new-name
p (apply 'fresh-package-name :prefix (or prefix (format nil "__~A__" (package-name p))) keys))) (apply 'fresh-package-name
(defun package-names (package) :prefix (or prefix (format nil "__~A__" (package-name p))) keys)))
(cons (package-name package) (package-nicknames package))) (record-fishy (list :rename-away (package-names p) new-name))
(defun packages-from-names (names) (rename-package p new-name))))
(remove-duplicates (remove nil (mapcar #'find-package names)) :from-end t)))
;;; Communicable representation of symbol and package information ;;; Communicable representation of symbol and package information
......
...@@ -4,8 +4,6 @@ ...@@ -4,8 +4,6 @@
(asdf/package:define-package :asdf/system (asdf/package:define-package :asdf/system
(:recycle :asdf :asdf/system) (:recycle :asdf :asdf/system)
(:use :common-lisp :asdf/driver :asdf/upgrade :asdf/component) (:use :common-lisp :asdf/driver :asdf/upgrade :asdf/component)
(:intern #:children #:children-by-name #:default-component-class
#:author #:maintainer #:licence #:source-file #:defsystem-depends-on)
(:export (:export
#:system #:proto-system #:system #:proto-system
#:system-source-file #:system-source-directory #:system-relative-pathname #:system-source-file #:system-source-directory #:system-relative-pathname
......
...@@ -249,6 +249,7 @@ upgrade_methods () { ...@@ -249,6 +249,7 @@ upgrade_methods () {
echo $ASDF_UPGRADE_TEST_METHODS ; return echo $ASDF_UPGRADE_TEST_METHODS ; return
fi fi
cat <<EOF cat <<EOF
'load-asdf-lisp'load-asdf-lisp-clean
'load-asdf-lisp'load-asdf-system 'load-asdf-lisp'load-asdf-system
'load-asdf-lisp'compile-load-asdf 'load-asdf-lisp'compile-load-asdf
'load-asdf-lisp'load-asdf-fasl 'load-asdf-lisp'load-asdf-fasl
......
...@@ -17,7 +17,7 @@ Some constraints: ...@@ -17,7 +17,7 @@ Some constraints:
#:*test-directory* #:*asdf-directory* #:*test-directory* #:*asdf-directory*
#:load-asdf #:maybe-compile-asdf #:load-asdf #:maybe-compile-asdf
#:load-asdf-lisp #:compile-asdf #:load-asdf-fasl #:load-asdf-lisp #:compile-asdf #:load-asdf-fasl
#:compile-load-asdf #:load-asdf-system #:compile-load-asdf #:load-asdf-system #:clean-load-asdf-system
#:register-directory #:load-test-system #:register-directory #:load-test-system
#:with-test #:test-asdf #:debug-asdf #:with-test #:test-asdf #:debug-asdf
#:assert-compare #:assert-compare
...@@ -251,6 +251,14 @@ is bound, write a message and exit on an error. If ...@@ -251,6 +251,14 @@ is bound, write a message and exit on an error. If
(defun register-directory (dir) (defun register-directory (dir)
(pushnew dir (symbol-value (asym :*central-registry*)))) (pushnew dir (symbol-value (asym :*central-registry*))))
(defun clean-asdf-system ()
(let ((fasl (resolve-output "asdf" "build" "asdf.fasl")))
(when (DBG :clean fasl (probe-file fasl)) (delete-file fasl))))
(defun load-asdf-lisp-clean ()
(load-asdf-lisp)
(clean-asdf-system))
(defun load-asdf-system (&rest keys) (defun load-asdf-system (&rest keys)
(quietly (quietly
(register-directory *asdf-directory*) (register-directory *asdf-directory*)
......
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
;; "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.126") (asdf-version "2.26.127")
(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))
...@@ -45,7 +45,7 @@ ...@@ -45,7 +45,7 @@
#:component-depends-on #:input-files #:component-depends-on #:input-files
#:perform-with-restarts #:component-relative-pathname #:perform-with-restarts #:component-relative-pathname
#:system-source-file #:operate #:find-component #:find-system #:system-source-file #:operate #:find-component #:find-system
#:apply-output-translations #:apply-output-translations #:component-self-dependencies
#:system-relative-pathname #:system-relative-pathname
#:inherit-source-registry #:process-source-registry #:inherit-source-registry #:process-source-registry
#:process-source-registry-directive #:source-file-type #:process-source-registry-directive #:source-file-type
...@@ -57,13 +57,15 @@ ...@@ -57,13 +57,15 @@
#:split #:make-collector #:do-dep #:do-one-dep #:split #:make-collector #:do-dep #:do-one-dep
#:resolve-relative-location-component #:resolve-absolute-location-component #:resolve-relative-location-component #:resolve-absolute-location-component
#:output-files-for-system-and-operation))) ; obsolete ASDF-BINARY-LOCATION function #:output-files-for-system-and-operation))) ; obsolete ASDF-BINARY-LOCATION function
(declare (ignorable redefined-functions uninterned-symbols))
(setf *asdf-version* asdf-version)
(when (and existing-asdf (not already-there)) (when (and existing-asdf (not already-there))
(when existing-asdf (push existing-version *upgraded-p*)
(asdf-message "~&; Upgrading ASDF ~@[from version ~A ~]to version ~A~%" (when *asdf-verbose*
existing-version asdf-version) (format *trace-output*
(push existing-version *upgraded-p*)) (compatfmt "~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%")
;;(format t "UPGRADE FROBBING! ~S~%" (list existing-asdf existing-version asdf-version)) ;XXX existing-version asdf-version))
(loop :for name :in (append #-(or clisp ecl) redefined-functions) (loop :for name :in (append #-(or clisp ecl common-lisp) redefined-functions)
:for sym = (find-symbol* name :asdf nil) :do :for sym = (find-symbol* name :asdf nil) :do
(when sym (when sym
;;(format t "Undefining ~S~%" sym);XXX ;;(format t "Undefining ~S~%" sym);XXX
...@@ -84,13 +86,12 @@ ...@@ -84,13 +86,12 @@
(shadowing-import new asdf)))))) (shadowing-import new asdf))))))
;; Note that this massive package destruction makes it impossible ;; Note that this massive package destruction makes it impossible
;; to use asdf/driver on top of an old ASDF on these implementations ;; to use asdf/driver on top of an old ASDF on these implementations
#+(or clisp xcl) #+(or xcl)
(let ((p (find-package :asdf))) (let ((p (find-package :asdf)))
(when p (when p
(do-symbols (s p) (when (home-package-p s p) (nuke-symbol s))) (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s)))
(rename-package-away p :prefix (format nil "~A-~A" :asdf (or existing-version :1.x)) (rename-package-away p :prefix (format nil "~A-~A" :asdf (or existing-version :1.x))
:index 0 :separator "-")))) :index 0 :separator "-"))))))
(setf *asdf-version* asdf-version)))
;;; Upgrade interface ;;; Upgrade interface
......
...@@ -63,8 +63,7 @@ ...@@ -63,8 +63,7 @@
;; but we usually try to do it only for the functions that need it, ;; but we usually try to do it only for the functions that need it,
;; which happens in asdf/upgrade - however, for ECL, we need this hammer, ;; which happens in asdf/upgrade - however, for ECL, we need this hammer,
;; (which causes issues in clisp) ;; (which causes issues in clisp)
#-ecl ;XXX ,@(when (or #-ecl supersede #+(or (and gcl (not gcl-pre2.7))) t) ; XXX
,@(when (or supersede #+(or (and gcl (not gcl-pre2.7))) t)
`((undefine-function ',name))) `((undefine-function ',name)))
#-gcl ; gcl 2.7.0 notinline functions lose secondary return values :-( #-gcl ; gcl 2.7.0 notinline functions lose secondary return values :-(
,@(when (and #+ecl (symbolp name)) ; fails for setf functions on ecl ,@(when (and #+ecl (symbolp name)) ; fails for setf functions on ecl
......
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