Commit c54a6e37 authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch 'fix-find-definition' into 'master'

Simplify WITH-UPGRADABILITY

See merge request asdf/asdf!142
parents 1c997636 7b4a25ca
...@@ -132,7 +132,7 @@ Use it in FORMAT control strings as ~/asdf-action:format-action/" ...@@ -132,7 +132,7 @@ Use it in FORMAT control strings as ~/asdf-action:format-action/"
;;;; Detection of circular dependencies ;;;; Detection of circular dependencies
(with-upgradability () (with-upgradability ()
(defun (action-valid-p) (operation component) (defun action-valid-p (operation component)
"Is this action valid to include amongst dependencies?" "Is this action valid to include amongst dependencies?"
;; If either the operation or component was resolved to nil, the action is invalid. ;; If either the operation or component was resolved to nil, the action is invalid.
;; :if-feature will invalidate actions on components for which the features don't apply. ;; :if-feature will invalidate actions on components for which the features don't apply.
......
...@@ -19,6 +19,8 @@ cl-asdf (2:3.3.5-1) unstable; urgency=low IN PROGRESS ...@@ -19,6 +19,8 @@ cl-asdf (2:3.3.5-1) unstable; urgency=low IN PROGRESS
* Fixes for feature handling from Eric Timmons. * Fixes for feature handling from Eric Timmons.
* Replaced some of the internals of `parse-defsystem` with generic functions to * Replaced some of the internals of `parse-defsystem` with generic functions to
enable modular extension. Thanks to Eric Timmons. enable modular extension. Thanks to Eric Timmons.
* Faré provided more graceful upgrade capabilities, fixing bugs with upgrading
support for local package nicknames, and with upgrading ABCL.
cl-asdf (2:3.3.4-1) unstable; urgency=low cl-asdf (2:3.3.4-1) unstable; urgency=low
Bug fix release: Bug fix release:
......
...@@ -116,13 +116,16 @@ Upgrade test: ...@@ -116,13 +116,16 @@ Upgrade test:
- l: [abcl, ccl, clasp, clisp, cmucl, ecl, sbcl] - l: [abcl, ccl, clasp, clisp, cmucl, ecl, sbcl]
IMAGE_TAG: latest IMAGE_TAG: latest
Upgrade test known failure: # No more tests are known to fail. But leave commented out in case it needs to
extends: .Upgrade test template # be resurrected.
parallel:
matrix: # Upgrade test known failure:
- l: [abcl] # extends: .Upgrade test template
IMAGE_TAG: latest # parallel:
allow_failure: true # matrix:
# - l: []
# IMAGE_TAG: latest
# allow_failure: true
.REQUIRE upgrade test template: .REQUIRE upgrade test template:
extends: .Upgrade test template extends: .Upgrade test template
...@@ -137,15 +140,18 @@ REQUIRE upgrade test: ...@@ -137,15 +140,18 @@ REQUIRE upgrade test:
ASDF_UPGRADE_TEST_TAGS: REQUIRE ASDF_UPGRADE_TEST_TAGS: REQUIRE
parallel: parallel:
matrix: matrix:
- l: [ccl, clasp, clisp, cmucl, ecl, sbcl] - l: [abcl, ccl, clasp, clisp, cmucl, ecl, sbcl]
IMAGE_TAG: latest IMAGE_TAG: latest
REQUIRE upgrade test known failure: # No more tests are known to fail. But leave commented out in case it needs to
extends: .REQUIRE upgrade test template # be resurrected.
variables:
ASDF_UPGRADE_TEST_TAGS: REQUIRE # REQUIRE upgrade test known failure:
parallel: # extends: .REQUIRE upgrade test template
matrix: # variables:
- l: abcl # ASDF_UPGRADE_TEST_TAGS: REQUIRE
IMAGE_TAG: latest # parallel:
allow_failure: true # matrix:
# - l: []
# IMAGE_TAG: latest
# allow_failure: true
...@@ -194,7 +194,7 @@ and the order is by decreasing length of namestring of the source pathname.") ...@@ -194,7 +194,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)
...@@ -287,7 +287,7 @@ effectively disabling the output translation facility." ...@@ -287,7 +287,7 @@ effectively disabling the output translation facility."
;; Top-level entry-point to _use_ output-translations ;; Top-level entry-point to _use_ output-translations
(defun* (apply-output-translations) (path) (defun apply-output-translations (path)
(etypecase path (etypecase path
(logical-pathname (logical-pathname
path) path)
......
...@@ -148,7 +148,8 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~ ...@@ -148,7 +148,8 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~
;; Given a form used as :version specification, in the context of a system definition ;; Given a form used as :version specification, in the context of a system definition
;; in a file at PATHNAME, for given COMPONENT with given PARENT, normalize the form ;; in a file at PATHNAME, for given COMPONENT with given PARENT, normalize the form
;; to an acceptable ASDF-format version. ;; to an acceptable ASDF-format version.
(defun* (normalize-version) (form &key pathname component parent) (fmakunbound 'normalize-version) ;; signature changed between 2.27 and 2.31
(defun normalize-version (form &key pathname component parent)
(labels ((invalid (&optional (continuation "using NIL instead")) (labels ((invalid (&optional (continuation "using NIL instead"))
(warn (compatfmt "~@<Invalid :version specifier ~S~@[ for component ~S~]~@[ in ~S~]~@[ from file ~S~]~@[, ~A~]~@:>") (warn (compatfmt "~@<Invalid :version specifier ~S~@[ for component ~S~]~@[ in ~S~]~@[ from file ~S~]~@[, ~A~]~@:>")
form component parent pathname continuation)) form component parent pathname continuation))
...@@ -293,11 +294,11 @@ COMPONENTS is a list of the explicitly defined children descriptions. ...@@ -293,11 +294,11 @@ COMPONENTS is a list of the explicitly defined children descriptions.
SERIAL-P is non-NIL if each child in COMPONENTS should depend on the previous SERIAL-P is non-NIL if each child in COMPONENTS should depend on the previous
children.")) children."))
(defun* stable-union (s1 s2 &key (test #'eql) (key 'identity)) (defun stable-union (s1 s2 &key (test #'eql) (key 'identity))
(append s1 (append s1
(remove-if #'(lambda (e2) (member (funcall key e2) (funcall key s1) :test test)) s2))) (remove-if #'(lambda (e2) (member (funcall key e2) (funcall key s1) :test test)) s2)))
(defun* (parse-component-form) (parent options &key previous-serial-components) (defun parse-component-form (parent options &key previous-serial-components)
(destructuring-bind (destructuring-bind
(type name &rest rest &key (type name &rest rest &key
(builtin-system-p () bspp) (builtin-system-p () bspp)
......
...@@ -224,7 +224,7 @@ to be meaningful, or could it just as well have been done in another Lisp image? ...@@ -224,7 +224,7 @@ to be meaningful, or could it just as well have been done in another Lisp image?
;;;; Visiting dependencies of an action and computing action stamps ;;;; Visiting dependencies of an action and computing action stamps
(with-upgradability () (with-upgradability ()
(defun* (map-direct-dependencies) (operation component fun) (defun map-direct-dependencies (operation component fun)
"Call FUN on all the valid dependencies of the given action in the given plan" "Call FUN on all the valid dependencies of the given action in the given plan"
(loop :for (dep-o-spec . dep-c-specs) :in (component-depends-on operation component) (loop :for (dep-o-spec . dep-c-specs) :in (component-depends-on operation component)
:for dep-o = (find-operation operation dep-o-spec) :for dep-o = (find-operation operation dep-o-spec)
...@@ -234,7 +234,7 @@ to be meaningful, or could it just as well have been done in another Lisp image? ...@@ -234,7 +234,7 @@ to be meaningful, or could it just as well have been done in another Lisp image?
:when (action-valid-p dep-o dep-c) :when (action-valid-p dep-o dep-c)
:do (funcall fun dep-o dep-c)))) :do (funcall fun dep-o dep-c))))
(defun* (reduce-direct-dependencies) (operation component combinator seed) (defun reduce-direct-dependencies (operation component combinator seed)
"Reduce the direct dependencies to a value computed by iteratively calling COMBINATOR "Reduce the direct dependencies to a value computed by iteratively calling COMBINATOR
for each dependency action on the dependency's operation and component and an accumulator for each dependency action on the dependency's operation and component and an accumulator
initialized with SEED." initialized with SEED."
...@@ -243,7 +243,7 @@ initialized with SEED." ...@@ -243,7 +243,7 @@ initialized with SEED."
#'(lambda (dep-o dep-c) (setf seed (funcall combinator dep-o dep-c seed)))) #'(lambda (dep-o dep-c) (setf seed (funcall combinator dep-o dep-c seed))))
seed) seed)
(defun* (direct-dependencies) (operation component) (defun direct-dependencies (operation component)
"Compute a list of the direct dependencies of the action within the plan" "Compute a list of the direct dependencies of the action within the plan"
(reverse (reduce-direct-dependencies operation component #'acons nil))) (reverse (reduce-direct-dependencies operation component #'acons nil)))
...@@ -527,7 +527,7 @@ Update the VISITED-ACTIONS table with the known status, but don't add anything t ...@@ -527,7 +527,7 @@ Update the VISITED-ACTIONS table with the known status, but don't add anything t
:do (collect-action-dependencies plan (action-operation action) (action-component action))) :do (collect-action-dependencies plan (action-operation action) (action-component action)))
(plan-actions plan))) (plan-actions plan)))
(defun* (required-components) (system &rest keys &key (goal-operation 'load-op) &allow-other-keys) (defun required-components (system &rest keys &key (goal-operation 'load-op) &allow-other-keys)
"Given a SYSTEM and a GOAL-OPERATION (default LOAD-OP), traverse the dependencies and "Given a SYSTEM and a GOAL-OPERATION (default LOAD-OP), traverse the dependencies and
return a list of the components involved in building the desired action." return a list of the components involved in building the desired action."
(with-asdf-session (:override t) (with-asdf-session (:override t)
......
...@@ -233,11 +233,11 @@ after having found a .asd file? True by default.") ...@@ -233,11 +233,11 @@ after having found a .asd file? True by default.")
(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)
......
...@@ -186,10 +186,11 @@ the primary one." ...@@ -186,10 +186,11 @@ the primary one."
(slot-value (find-system (primary-system-name system)) (slot-value (find-system (primary-system-name system))
slot-name)))) slot-name))))
(defmacro define-system-virtual-slot-reader (slot-name) (defmacro define-system-virtual-slot-reader (slot-name)
`(defun* ,(intern (concatenate 'string (string :system-) (let ((name (intern (strcat (string :system-) (string slot-name)))))
(string slot-name))) `(progn
(system) (fmakunbound ',name) ;; These were gf from defgeneric before 3.3.2.11
(system-virtual-slot-value system ',slot-name))) (declaim (notinline ,name))
(defun ,name (system) (system-virtual-slot-value system ',slot-name)))))
(defmacro define-system-virtual-slot-readers () (defmacro define-system-virtual-slot-readers ()
`(progn ,@(mapcar (lambda (slot-name) `(progn ,@(mapcar (lambda (slot-name)
`(define-system-virtual-slot-reader ,slot-name)) `(define-system-virtual-slot-reader ,slot-name))
...@@ -214,7 +215,7 @@ the primary one." ...@@ -214,7 +215,7 @@ the primary one."
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)
"Given a SYSTEM, and a (Unix-style relative path) NAME of a file (or directory) of given TYPE, "Given a SYSTEM, and a (Unix-style relative path) NAME of a file (or directory) of given TYPE,
return the absolute pathname of a corresponding file under that system's source code pathname." return the absolute pathname of a corresponding file under that system's source code pathname."
(subpathname (system-source-directory system) name :type type)) (subpathname (system-source-directory system) name :type type))
......
...@@ -434,33 +434,36 @@ extract_all_tagged_asdf () { ...@@ -434,33 +434,36 @@ extract_all_tagged_asdf () {
} }
valid_upgrade_test_p () { valid_upgrade_test_p () {
case "${1}:${2}:${3}" in case "${1}:${2}:${3}" in
# It's damn slow. Also, for some reason, we punt on anything earlier than 2.25, # It's damn slow. Also, we punt on anything 2.26 or earlier.
# and only need to test it once, below for 2.24. abcl:1.*|abcl:2.[01]*|abcl:2.2[0-5]:*) : ;;
abcl:1.*|abcl:2.00[0-9]:*|abcl:201[0-9]:*|abcl:2.2[0-3]:*) : ;;
# ccl fasl numbering broke loading of old asdf 2.0
ccl:2.0[01]*|ccl:2.2[0-6]*) : ;;
# Allegro ships with versions 3*, so give up testing 2 # Allegro ships with versions 3*, so give up testing 2
# Also, unpatched Allegro 10 has bug updating from 2.26 and before # Also, unpatched Allegro 10 has bug updating from 2.26 and before
allegro*:[12].*) : ;; allegro*:[12].*) : ;;
# My old ubuntu 10.04LTS clisp 2.44.1 came wired in # ccl fasl numbering broke loading of old asdf 2.0. 2.27 has trouble with deferred-warnings.
ccl:2.[01]*|ccl:2.2[0-7]*) : ;;
# clasp only since 3.1.4.3
clasp:2.*|clasp:3.0*|clasp:3.1.[0-4]*) : ;;
# CLISP: My old ubuntu 10.04LTS clisp 2.44.1 came wired in
# with an antique ASDF 1.374 from CLC that can't be downgraded. # with an antique ASDF 1.374 from CLC that can't be downgraded.
# More recent CLISPs work. # More recent CLISPs work.
# 2.00[0-7] use UID, which fails on some old CLISPs. # 2.00[0-7] use UID, which fails on some old CLISPs.
# Note that for the longest time, CLISP has included 2.011 in its distribution. # Note that for the longest time, CLISP has included 2.011 in its source repository.
# Now its hg repository includes 3.0.2.29, but clisp hasn't released in many years(!) # Now its hg repository includes 3.x, but clisp hasn't released in many years(!)
# We don't punt on upgrade anymore, so we can go at it! # We don't punt on upgrade anymore, so we can go at it!
#clisp:2.00[0-7]:*|clisp:1.*|clisp:2.0[01]*|clisp:2.2[0-5]:*) : ;; #clisp:2.00[0-7]:*|clisp:1.*|clisp:2.0[01]*|clisp:2.2[0-5]:*) : ;;
# CMUCL has problems with 2.32 and earlier because of # CMUCL has problems with 3.2.1 and earlier because of
# the redefinition of system's superclass component. # the redefinition of system's superclass component.
cmucl:1.*|cmucl:2.[012]*|cmucl:2.3[012]*) : ;; cmucl:1.*|cmucl:2.*|cmucl:3.[012]*) : ;;
# Skip many ECL tests, for various ASDF issues # Skip many ECL tests, for various ASDF issues
ecl*:1.*|ecl*:2.0[01]*|ecl*:2.20:*) : ;; ecl*:1.*|ecl*:2.0[01]*|ecl*:2.20:*) : ;;
# GCL 2.7.0 from late November 2013 is required, with ASDF 3.1.2 # GCL 2.7.0 from late November 2013 is required, with ASDF 3.1.2
gcl:REQUIRE:*|gcl:1.*|gcl:2.*|gcl:3.0*) : ;; gcl:REQUIRE:*|gcl:1.*|gcl:2.*|gcl:3.0*|gcl:3.1.[0-3]*) : ;;
# LispWorks is broken at ASDF 3.0.3, but can upgrade from earlier and later ASDFs. # LispWorks is broken at ASDF 3.0.3, but can upgrade from earlier and later ASDFs.
lispworks:3.0.3:*) : ;; lispworks:1*|lispworks:2.[0-2]*|lispworks:2.3[0-2]*|lispworks:3.0.3:*) : ;;
# MKCL is only supported starting with specific versions 2.24, 2.26.x, 3.0.3.0.x, so skip. # MKCL is only supported starting with specific versions 2.24, 2.26.x, 3.0.3.0.x, so skip.
mkcl:[12]*|mkcl:3.0*) : ;; mkcl:[12]*|mkcl:3.0*) : ;;
# SBCL won't run ASDF 1 anymore
sbcl:1*) : ;;
# XCL support starts with ASDF 2.014.2 # XCL support starts with ASDF 2.014.2
# — It also dies during upgrade trying to show the backtrace. # — It also dies during upgrade trying to show the backtrace.
xcl:1.*|xcl:2.00*|xcl:2.01[0-4]:*|xcl:*) : ;; xcl:1.*|xcl:2.00*|xcl:2.01[0-4]:*|xcl:*) : ;;
......
...@@ -62,7 +62,7 @@ ...@@ -62,7 +62,7 @@
:package-local-nicknames-test-1 :package-local-nicknames-test-1
:package-local-nicknames-test-2)) :package-local-nicknames-test-2))
(let ((*package* (find-package p))) (let ((*package* (find-package p)))
(let ((alist (uiop/package:package-local-nicknames :package-local-nicknames-test-1))) (let ((alist (uiop/package*:package-local-nicknames :package-local-nicknames-test-1)))
(assert (equal (cons (case-lisp-string "L") (find-package :cl)) (assert (equal (cons (case-lisp-string "L") (find-package :cl))
(assoc (case-lisp-string "L") alist :test 'string=))) (assoc (case-lisp-string "L") alist :test 'string=)))
(assert (equal (cons +nn-sname+ (find-package +pkg-sname+)) (assert (equal (cons +nn-sname+ (find-package +pkg-sname+))
...@@ -95,28 +95,28 @@ ...@@ -95,28 +95,28 @@
(define-test test-package-local-nicknames-nickname-removal (define-test test-package-local-nicknames-nickname-removal
(reset-test-packages) (reset-test-packages)
(assert (= 2 (length (uiop/package:package-local-nicknames :package-local-nicknames-test-1)))) (assert (= 2 (length (uiop/package*:package-local-nicknames :package-local-nicknames-test-1))))
(assert (uiop/package:remove-package-local-nickname :l :package-local-nicknames-test-1)) (assert (uiop/package*:remove-package-local-nickname :l :package-local-nicknames-test-1))
(assert (= 1 (length (uiop/package:package-local-nicknames :package-local-nicknames-test-1)))) (assert (= 1 (length (uiop/package*:package-local-nicknames :package-local-nicknames-test-1))))
(let ((*package* (find-package :package-local-nicknames-test-1))) (let ((*package* (find-package :package-local-nicknames-test-1)))
(assert (not (find-package :l))))) (assert (not (find-package :l)))))
(define-test test-package-local-nicknames-nickname-removal-char (define-test test-package-local-nicknames-nickname-removal-char
#+ignore (declare (optimize (debug 3) (speed 0))) #+ignore (declare (optimize (debug 3) (speed 0)))
(reset-test-packages) (reset-test-packages)
(assert (= 2 (length (uiop/package:package-local-nicknames :package-local-nicknames-test-1)))) (assert (= 2 (length (uiop/package*:package-local-nicknames :package-local-nicknames-test-1))))
(assert (uiop/package:remove-package-local-nickname (if (eq (readtable-case *readtable*) :preserve) #\l #\L) (assert (uiop/package*:remove-package-local-nickname (if (eq (readtable-case *readtable*) :preserve) #\l #\L)
:package-local-nicknames-test-1)) :package-local-nicknames-test-1))
(assert (= 1 (length (uiop/package:package-local-nicknames :package-local-nicknames-test-1)))) (assert (= 1 (length (uiop/package*:package-local-nicknames :package-local-nicknames-test-1))))
(let ((*package* (find-package :package-local-nicknames-test-1))) (let ((*package* (find-package :package-local-nicknames-test-1)))
(assert (not (find-package :l))))) (assert (not (find-package :l)))))
(define-test test-package-local-nicknames-nickname-removal-readd-another-package-equality (define-test test-package-local-nicknames-nickname-removal-readd-another-package-equality
(reset-test-packages) (reset-test-packages)
(assert (uiop/package:remove-package-local-nickname :l :package-local-nicknames-test-1)) (assert (uiop/package*:remove-package-local-nickname :l :package-local-nicknames-test-1))
(assert (eq (find-package :package-local-nicknames-test-1) (assert (eq (find-package :package-local-nicknames-test-1)
(uiop/package:add-package-local-nickname :l :package-local-nicknames-test-2 (uiop/package*:add-package-local-nickname :l :package-local-nicknames-test-2
:package-local-nicknames-test-1))) :package-local-nicknames-test-1)))
(let ((*package* (find-package :package-local-nicknames-test-1))) (let ((*package* (find-package :package-local-nicknames-test-1)))
(let ((cl (find-package :l)) (let ((cl (find-package :l))
......
...@@ -16,7 +16,10 @@ ...@@ -16,7 +16,10 @@
;; The 3.3 series provides the asdf3.3 feature, meaning users can rely on ;; The 3.3 series provides the asdf3.3 feature, meaning users can rely on
;; all its new features (proper phase separation) as well as earlier features. ;; all its new features (proper phase separation) as well as earlier features.
"3.3.1" ;; (2017-11-14) bug fixes, second and latest in 3.3 series "3.3.4" ;; (2020-02-14) bug fixes, fifth and latest in 3.3 series
"3.3.3" ;; (2019-03-27) bug fixes, fourth in 3.3 series
"3.3.2" ;; (2018-05-04) bug fixes, third in 3.3 series
"3.3.1" ;; (2017-11-14) bug fixes, second in 3.3 series, SBCL has been stuck there for years
"3.3.0" ;; (2017-10-06) first in 3.3 series "3.3.0" ;; (2017-10-06) first in 3.3 series
;; The 3.2 series provides the asdf3.2 feature, meaning users can rely on ;; The 3.2 series provides the asdf3.2 feature, meaning users can rely on
...@@ -133,9 +136,10 @@ Use at a given tag, put it under build/asdf-${tag}.lisp" ...@@ -133,9 +136,10 @@ Use at a given tag, put it under build/asdf-${tag}.lisp"
:allegro_64_s :allegromodern_64_s :allegro8_64_s :allegromodern8_64_s) :allegro_64_s :allegromodern_64_s :allegro8_64_s :allegromodern8_64_s)
(version<= "2.27" tag)) (version<= "2.27" tag))
;; CCL fasl numbering broke loading of old asdf 2.0, and the punting for 2.26 fails, ;; CCL fasl numbering broke loading of old asdf 2.0, the punting for 2.26 fails, and
;; but who cares since CCL has always been shipping recent versions of ASDF. ;; 2.27 enables deferred-warnings then the new UIOP causes confusion with its changed format.
((:ccl) (version<= "2.27" tag)) ;; But who cares since CCL has always been shipping recent versions of ASDF.
((:ccl) (version<= "2.32" tag))
;; CLASP is only supported as of 3.1.4.3 ;; CLASP is only supported as of 3.1.4.3
((:clasp) (version<= "3.1.4.3" tag)) ((:clasp) (version<= "3.1.4.3" tag))
...@@ -149,9 +153,9 @@ Use at a given tag, put it under build/asdf-${tag}.lisp" ...@@ -149,9 +153,9 @@ Use at a given tag, put it under build/asdf-${tag}.lisp"
;; However, whether we punt or don't punt, these should all work. ;; However, whether we punt or don't punt, these should all work.
((:clisp) t) ((:clisp) t)
;; CMUCL has problems with 2.32 and earlier because of ;; CMUCL has problems with 3.2.1 and earlier because of the redefinition of
;; the redefinition of system's superclass component. ;; some classes that causes its subtype to answer NIL when it shouldn't.
((:cmucl) (version<= "2.33" tag)) ((:cmucl) (version<= "3.3.0" tag))
;; Skip many ECL tests, for various ASDF issues ;; Skip many ECL tests, for various ASDF issues
((:ecl :ecl_bytecodes) (version<= "2.21" tag)) ((:ecl :ecl_bytecodes) (version<= "2.21" tag))
...@@ -161,14 +165,20 @@ Use at a given tag, put it under build/asdf-${tag}.lisp" ...@@ -161,14 +165,20 @@ Use at a given tag, put it under build/asdf-${tag}.lisp"
;; against anything but the latest release. ;; against anything but the latest release.
((:gcl) (version<= "3.1.4" tag)) ((:gcl) (version<= "3.1.4" tag))
;; LispWorks is fine, but ASDF 3.0.3 has a bug and can't be loaded. ;; LispWorks is fine, but ASDF 3.0.3 can't be loaded due to a bug it has a bug,
((:lispworks) (not (equal "3.0.3" tag))) ;; while 2.27 to 2.32 use system:pid-exit-status that doesn't exist anymore in LispWorks 7.
((:lispworks) (and (version<= "2.33" tag) (not (equal "3.0.3" tag))))
;; MKCL is only supported starting with specific versions 2.24, 2.26.x, 3.0.3.0.x, so skip. ;; MKCL is only supported starting with specific versions 2.24, 2.26.x, 3.0.3.0.x, so skip.
((:mkcl) (version<= "3.1.2" tag)) ;; The bundle support also changed a lot in 3.2.0 and this breaks upgrading from 3.1.
((:mkcl) (version<= "3.2.0" tag))
;; all clear on these implementations ;; SBCL fails to load ASDF as a system 1.369 because ASDF 1.369's builtin
((:sbcl :scl) t) ;; asdf-binary-locations gets confused when SBCL_HOME is not set by SBCL anymore.
((:sbcl) (version<= "2.000" tag))
;; SCL is all good.
((:scl) (version<= "2.000" tag))
;; XCL support starts with ASDF 2.014.2 ;; XCL support starts with ASDF 2.014.2
;; — It also dies during upgrade trying to show the backtrace. ;; — It also dies during upgrade trying to show the backtrace.
...@@ -196,6 +206,7 @@ Use the preferred lisp implementation" ...@@ -196,6 +206,7 @@ Use the preferred lisp implementation"
(extract-tagged-asdf tag) (extract-tagged-asdf tag)
(run-test-lisp description (run-test-lisp description
`((load "test/script-support.lisp") `((load "test/script-support.lisp")
(asdf-test::debug-asdf)
(asdf-test::test-upgrade ,@method ,tag)) (asdf-test::test-upgrade ,@method ,tag))
:lisp lisp :log log)) :lisp lisp :log log))
description)) description))
......
...@@ -215,7 +215,7 @@ directive.") ...@@ -215,7 +215,7 @@ directive.")
(declaim (ftype (function (t &key (:directory boolean) (:wilden boolean) (declaim (ftype (function (t &key (:directory boolean) (:wilden boolean)
(:ensure-directory boolean)) t) resolve-location)) (:ensure-directory boolean)) t) resolve-location))
(defun* (resolve-location) (x &key ensure-directory wilden directory) (defun resolve-location (x &key ensure-directory wilden directory)
"Resolve location designator X into a PATHNAME" "Resolve location designator X into a PATHNAME"
;; :directory backward compatibility, until 2014-01-16: accept directory as well as ensure-directory ;; :directory backward compatibility, until 2014-01-16: accept directory as well as ensure-directory
(loop :with dirp = (or directory ensure-directory) (loop :with dirp = (or directory ensure-directory)
......
...@@ -2,18 +2,21 @@ ...@@ -2,18 +2,21 @@
;;;; Re-export all the functionality in UIOP ;;;; Re-export all the functionality in UIOP
(uiop/package:define-package :uiop/driver (uiop/package:define-package :uiop/driver
(:nicknames :uiop :asdf/driver) ;; asdf/driver is obsolete (uiop isn't); (:nicknames :uiop ;; Official name we recommend should be used for all references to uiop symbols.
;; but asdf/driver is still used by swap-bytes, static-vectors. :asdf/driver) ;; DO NOT USE, a deprecated name, not supported anymore.
;; We should remove the name :asdf/driver at some point,
;; but not until it has been eradicated from Quicklisp for a year or two.
;; The last known user was cffi (PR merged in May 2020).
(:use :uiop/common-lisp) (:use :uiop/common-lisp)
;; NB: not reexporting uiop/common-lisp ;; NB: We are not reexporting uiop/common-lisp
;; which include all of CL with compatibility modifications on select platforms, ;; which include all of CL with compatibility modifications on select platforms,
;; that could cause potential conflicts for packages that would :use (cl uiop) ;; because that would cause potential conflicts for packages that
;; or :use (closer-common-lisp uiop), etc. ;; might want to :use (:cl :uiop) or :use (:closer-common-lisp :uiop), etc.
(:use-reexport (:use-reexport
:uiop/package :uiop/utility :uiop/version :uiop/package* :uiop/utility :uiop/version
:uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image
:uiop/launch-program :uiop/run-program :uiop/launch-program :uiop/run-program
:uiop/lisp-build :uiop/configuration :uiop/backward-driver)) :uiop/lisp-build :uiop/configuration :uiop/backward-driver))
;; Provide both lowercase and uppercase, to satisfy more people. ;; Provide both lowercase and uppercase, to satisfy more implementations.
(provide "uiop") (provide "UIOP") (provide "uiop") (provide "UIOP")
...@@ -662,7 +662,7 @@ possibly in a different process. Otherwise just call THUNK." ...@@ -662,7 +662,7 @@ possibly in a different process. Otherwise just call THUNK."
(defvar *compile-check* nil (defvar *compile-check* nil
"A hook for user-defined compile-time invariants") "A hook for user-defined compile-time invariants")
(defun* (compile-file*) (input-file &rest keys (defun compile-file* (input-file &rest keys
&key (compile-check *compile-check*) output-file warnings-file &key (compile-check *compile-check*) output-file warnings-file
#+clisp lib-file #+(or clasp ecl mkcl) object-file #+sbcl emit-cfasl #+clisp lib-file #+(or clasp ecl mkcl) object-file #+sbcl emit-cfasl
&allow-other-keys) &allow-other-keys)
......
...@@ -4,39 +4,40 @@ ...@@ -4,39 +4,40 @@
;; See https://bugs.launchpad.net/asdf/+bug/485687 ;; See https://bugs.launchpad.net/asdf/+bug/485687
;; ;;
;; CAUTION: The definition of the UIOP/PACKAGE package MUST NOT CHANGE,
;; NOT NOW, NOT EVER, NOT UNDER ANY CIRCUMSTANCE. NEVER.
;; ... and the same goes for UIOP/PACKAGE-LOCAL-NICKNAMES.
;;
;; The entire point of UIOP/PACKAGE is to address the fact that the CL standard
;; *leaves it unspecified what happens when a package is redefined incompatibly*.
;; For instance, SBCL 1.4.2 will signal a full WARNING when this happens,
;; throwing a wrench in upgrading code with ASDF itself, while continuing to
;; export old symbols it now shouldn't as it also exports new ones,
;; causing problems with code that relies on the new/current exports.
;; CLISP and CCL also exports both sets of symbols, though without any WARNING.
;; ABCL 1.6.1 will plainly ignore the new definition.
;; Other implementations may do whatever they want and change their behavior at any time.
;; ***Using DEFPACKAGE twice with different definitions is nasal-demon territory.***
;;
;; Thus we define UIOP/PACKAGE:DEFINE-PACKAGE with which packages can be defined
;; in an upgrade-friendly way: the new definition is authoritative, and
;; the package will define and export exactly those symbols in the new definition,
;; no more and no fewer, whereas it is well-defined what happens to previous symbols.
;; However, for obvious bootstrap reasons, we cannot use DEFINE-PACKAGE
;; to define UIOP/PACKAGE itself, only DEFPACKAGE.
;; Therefore, unlike the other packages in ASDF, UIOP/PACKAGE is immutable,
;; now and forever. It is frozen for the aeons to come, like the CL package itself,
;; to the same exact state it was defined at its inception, in ASDF 2.27 in 2013.
;; The same goes for UIOP/PACKAGE-LOCAL-NICKNAMES, that we use internally.
;;
;; If you ever must define new symbols in this file, you can and must
;; export them from a different package, possibly defined in the same file,
;; say a package UIOP/PACKAGE* defined at the end of this file with DEFINE-PACKAGE,
;; that might use :import-from to import the symbols from UIOP/PACKAGE,
;; if you must somehow define them in UIOP/PACKAGE.
;;; package local nicknames feature. Can't be deferred until common-lisp.lisp, (defpackage :uiop/package ;;; THOU SHALT NOT modify this definition, EVER. See explanations above.
;;; where most such features are set.
;;; ABCL and CCL already define this feature appropriately.
;;; Seems to be unconditionally present for SBCL, ACL, and clasp
;;; Don't know about ecl, or others
(eval-when (:load-toplevel :compile-toplevel :execute)
;; abcl pushes :package-local-nicknames without UIOP interfering,
;; and Lispworks will do so
#+(or sbcl clasp)
(pushnew :package-local-nicknames *features*)