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 @@
:licence "MIT"
:description "Another System Definition Facility"
: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 ()
:components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem))))
......
......@@ -29,7 +29,9 @@
;; Internals we'd like to share with the ASDF package, especially for upgrade purposes
#: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
#:relative-pathname #:absolute-pathname #:operation-times #:around-compile
#:%encoding #:properties #:parent))
......
......@@ -136,7 +136,7 @@
(component-pathname component) ; eagerly compute the absolute pathname
(let ((sysdir (system-source-directory (component-system component)))) ;; requires the previous
(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~]~@:>")
version name parent))
(setf (component-version component) version)
......
......@@ -12,7 +12,7 @@
;;;; Configure
(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.
......
;; -*- 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:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -10,6 +10,8 @@
;; and reexported in a different package
;; (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
(:use :common-lisp)
(:export
......@@ -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))))
(ensure-package-unused p)
(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)
separator
(index (random most-positive-fixnum)))
......@@ -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)
:thereis (and (not (find-package n)) n)))
(defun rename-package-away (p &rest keys &key prefix &allow-other-keys)
(rename-package
p (apply 'fresh-package-name :prefix (or prefix (format nil "__~A__" (package-name p))) keys)))
(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)))
(let ((new-name
(apply 'fresh-package-name
:prefix (or prefix (format nil "__~A__" (package-name p))) keys)))
(record-fishy (list :rename-away (package-names p) new-name))
(rename-package p new-name))))
;;; Communicable representation of symbol and package information
......
......@@ -4,8 +4,6 @@
(asdf/package:define-package :asdf/system
(:recycle :asdf :asdf/system)
(: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
#:system #:proto-system
#:system-source-file #:system-source-directory #:system-relative-pathname
......
......@@ -249,6 +249,7 @@ upgrade_methods () {
echo $ASDF_UPGRADE_TEST_METHODS ; return
fi
cat <<EOF
'load-asdf-lisp'load-asdf-lisp-clean
'load-asdf-lisp'load-asdf-system
'load-asdf-lisp'compile-load-asdf
'load-asdf-lisp'load-asdf-fasl
......
......@@ -17,7 +17,7 @@ Some constraints:
#:*test-directory* #:*asdf-directory*
#:load-asdf #:maybe-compile-asdf
#: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
#:with-test #:test-asdf #:debug-asdf
#:assert-compare
......@@ -251,6 +251,14 @@ is bound, write a message and exit on an error. If
(defun register-directory (dir)
(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)
(quietly
(register-directory *asdf-directory*)
......
......@@ -35,7 +35,7 @@
;; "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.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-version *asdf-version*)
(already-there (equal asdf-version existing-version))
......@@ -45,7 +45,7 @@
#:component-depends-on #:input-files
#:perform-with-restarts #:component-relative-pathname
#:system-source-file #:operate #:find-component #:find-system
#:apply-output-translations
#:apply-output-translations #:component-self-dependencies
#:system-relative-pathname
#:inherit-source-registry #:process-source-registry
#:process-source-registry-directive #:source-file-type
......@@ -57,13 +57,15 @@
#:split #:make-collector #:do-dep #:do-one-dep
#:resolve-relative-location-component #:resolve-absolute-location-component
#: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 existing-asdf
(asdf-message "~&; Upgrading ASDF ~@[from version ~A ~]to version ~A~%"
existing-version asdf-version)
(push existing-version *upgraded-p*))
;;(format t "UPGRADE FROBBING! ~S~%" (list existing-asdf existing-version asdf-version)) ;XXX
(loop :for name :in (append #-(or clisp ecl) redefined-functions)
(push existing-version *upgraded-p*)
(when *asdf-verbose*
(format *trace-output*
(compatfmt "~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%")
existing-version asdf-version))
(loop :for name :in (append #-(or clisp ecl common-lisp) redefined-functions)
:for sym = (find-symbol* name :asdf nil) :do
(when sym
;;(format t "Undefining ~S~%" sym);XXX
......@@ -84,13 +86,12 @@
(shadowing-import new asdf))))))
;; Note that this massive package destruction makes it impossible
;; to use asdf/driver on top of an old ASDF on these implementations
#+(or clisp xcl)
#+(or xcl)
(let ((p (find-package :asdf)))
(when p
(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))
:index 0 :separator "-"))))
(setf *asdf-version* asdf-version)))
:index 0 :separator "-"))))))
;;; Upgrade interface
......
......@@ -63,8 +63,7 @@
;; 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 causes issues in clisp)
#-ecl ;XXX
,@(when (or supersede #+(or (and gcl (not gcl-pre2.7))) t)
,@(when (or #-ecl supersede #+(or (and gcl (not gcl-pre2.7))) t) ; XXX
`((undefine-function ',name)))
#-gcl ; gcl 2.7.0 notinline functions lose secondary return values :-(
,@(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