diff --git a/TODO b/TODO index fe4b80c05da02fcf4ce3b1690dd5df48cc8a3a47..4c9a66bcddbcfd09a94bc7d5f05105253f8daa22 100644 --- a/TODO +++ b/TODO @@ -1,7 +1,7 @@ * Resolve performance degradation issue reported by stassats and fe[nl]ix ** Is it the warnings feature taking too much resources? ** Is output-files and/or input-files being called too much? Cache it! -* fix upgrade on (abcl, clisp, cmucl) +* fix upgrade on clisp ** Extract minimal test case * Bug found by fe[nl]ix: infinite loop if the definitions in an asd file are not in strict defsystem-depends-on dependency order. Document the issue. diff --git a/asdf-driver.asd b/asdf-driver.asd index 6a393912dd7bf7f9464e107368cab715b5e12b47..c718618ed9024f1144e0a71dd532b220c0ce423e 100644 --- a/asdf-driver.asd +++ b/asdf-driver.asd @@ -22,7 +22,7 @@ that you can't portably construct a complete program without using them." (:file "common-lisp" :depends-on ("package")) (:file "utility" :depends-on ("common-lisp")) (:file "os" :depends-on ("utility")) - (:file "pathname" :depends-on ("utility")) + (:file "pathname" :depends-on ("utility" "os")) (:file "filesystem" :depends-on ("os" "pathname")) (:file "stream" :depends-on ("filesystem")) (:file "image" :depends-on ("stream")) diff --git a/asdf.asd b/asdf.asd index d6b610d78b615ebf593c445c63a87cc47cdc63ef..c34cbda8487413a13b2a32a6df71465ce501a6e4 100644 --- a/asdf.asd +++ b/asdf.asd @@ -66,7 +66,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.26.163" ;; to be automatically updated by make bump-version + :version "2.26.164" ;; to be automatically updated by make bump-version :depends-on () #+asdf3 :encoding #+asdf3 :utf-8 ;; For most purposes, asdf itself specially counts as a builtin system. diff --git a/component.lisp b/component.lisp index 81b1755d15819a261fc914814fd178ac66914556..929b46d9ec79b3b5eea47a71d4635c8b9bb8543e 100644 --- a/component.lisp +++ b/component.lisp @@ -182,7 +182,7 @@ another pathname in a degenerate way.")) (compute-children-by-name m)))) (defclass module (child-component parent-component) - ()) + (#+clisp (components))) ;; backward compatibility during upgrade only ;;;; component pathnames diff --git a/filesystem.lisp b/filesystem.lisp index fd8cf7de3ba08048ec1729e1d70abcc14a837a1b..cfe91494c7f7a56d3990242da7cd2d7431d61f9b 100644 --- a/filesystem.lisp +++ b/filesystem.lisp @@ -19,7 +19,11 @@ #:inter-directory-separator #:split-native-pathnames-string #:getenv-pathname #:getenv-pathnames #:getenv-absolute-directory #:getenv-absolute-directories - #:lisp-implementation-directory #:lisp-implementation-pathname-p)) + #:lisp-implementation-directory #:lisp-implementation-pathname-p + ;; Simple filesystem operations + #:ensure-all-directories-exist + #:rename-file-overwriting-target + #:delete-file-if-exists)) (in-package :asdf/filesystem) ;;; Native namestrings, as seen by the operating system calls rather than Lisp @@ -446,3 +450,19 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible." t)) +;;; Simple filesystem operations +(defun* ensure-all-directories-exist (pathnames) + (dolist (pathname pathnames) + (ensure-directories-exist (translate-logical-pathname pathname)))) + +(defun* rename-file-overwriting-target (source target) + #+clisp ;; But for a bug in CLISP 2.48, we should use :if-exists :overwrite and be atomic + (posix:copy-file source target :method :rename) + #-clisp + (rename-file source target + #+clozure :if-exists #+clozure :rename-and-delete)) + +(defun* delete-file-if-exists (x) + (handler-case (delete-file x) (file-error () nil))) + + diff --git a/header.lisp b/header.lisp index e7fd30f6fb0b20a7c7389519b8c91cbd4fe80e7f..ad8c49bcab9f38b111dab6cd23a13e25fa2b977d 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 2.26.163: Another System Definition Facility. +;;; This is ASDF 2.26.164: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. @@ -54,7 +54,7 @@ (declaim (optimize (speed 1) (safety 3) (debug 3))) (setf ext:*gc-verbose* nil)) -#+(or abcl clisp) ;; cmu +#+clisp (eval-when (:load-toplevel :compile-toplevel :execute) (unless (member :asdf3 *features*) (let* ((existing-version diff --git a/image.lisp b/image.lisp index 3c09319d52e2dd82edc3aee84392e81c44c3e86c..9a6765dd4b5e856e1456453be797f1573b35f322 100644 --- a/image.lisp +++ b/image.lisp @@ -89,6 +89,8 @@ This is designed to abstract away the implementation specific quit forms." (defun* raw-print-backtrace (&key (stream *debug-io*) count) "Print a backtrace, directly accessing the implementation" (declare (ignorable stream count)) + #+abcl + (let ((*debug-io* stream)) (top-level::backtrace-command count)) #+allegro (let ((*terminal-io* stream) (*standard-output* stream) diff --git a/lisp-action.lisp b/lisp-action.lisp index 899da73752f20fa7b05310de9c4ac5f3efb0eae9..80f8b18de9c712eaa3cf85d2addc90adbe766c42 100644 --- a/lisp-action.lisp +++ b/lisp-action.lisp @@ -12,7 +12,7 @@ #:basic-load-op #:basic-compile-op #:compile-op-flags #:compile-op-proclamations #:load-op #:prepare-op #:compile-op #:test-op #:load-source-op #:prepare-source-op #:call-with-around-compile-hook - #:perform-lisp-compilation #:perform-lisp-load-fasl #:perform-lisp-load-source)) + #:perform-lisp-compilation #:perform-lisp-load-fasl #:perform-lisp-load-source #:flags)) (in-package :asdf/lisp-action) diff --git a/lisp-build.lisp b/lisp-build.lisp index 698841266fccc331a2bdf2e87e971db6ca2ae716..6f77e2712e14be0e3ee92c362ce3bddc1785d936 100644 --- a/lisp-build.lisp +++ b/lisp-build.lisp @@ -4,7 +4,7 @@ (asdf/package:define-package :asdf/lisp-build (:recycle :asdf/interface :asdf :asdf/lisp-build) (:use :asdf/common-lisp :asdf/package :asdf/utility - :asdf/pathname :asdf/stream :asdf/os :asdf/image) + :asdf/os :asdf/pathname :asdf/filesystem :asdf/stream :asdf/image) (:export ;; Variables #:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour* diff --git a/pathname.lisp b/pathname.lisp index 7037d4a415e58a9d10b6246682d2da455de1a000..2164caf0402dd644c80948b349e4dfa867f3dbf6 100644 --- a/pathname.lisp +++ b/pathname.lisp @@ -5,7 +5,7 @@ (asdf/package:define-package :asdf/pathname (:recycle :asdf/pathname :asdf) - (:use :asdf/common-lisp :asdf/package :asdf/utility) + (:use :asdf/common-lisp :asdf/package :asdf/utility :asdf/os) (:export ;; Making and merging pathnames, portably #:normalize-pathname-directory-component #:denormalize-pathname-directory-component diff --git a/stream.lisp b/stream.lisp index 082667ec0339e7c8e9f5794d90afd12995129b1b..b6fe78b998c0f6a832024df9160f32a4a2e9cf1f 100644 --- a/stream.lisp +++ b/stream.lisp @@ -19,9 +19,7 @@ #:detect-encoding #:*encoding-detection-hook* #:always-default-encoding #:encoding-external-format #:*encoding-external-format-hook* #:default-encoding-external-format #:*default-encoding* #:*utf-8-external-format* - #:ensure-all-directories-exist - #:rename-file-overwriting-target - #:delete-file-if-exists + ;; Temporary files #:*temporary-directory* #:temporary-directory #:default-temporary-directory #:setup-temporary-directory #:call-with-temporary-file #:with-temporary-file @@ -339,7 +337,7 @@ hopefully, if done consistently, that won't affect program behavior too much.") "Hook for an extension to define a function to automatically detect a file's encoding") (defun* detect-encoding (pathname) - (if (and pathname (not (directory-pathname-p pathname)) (probe-file pathname)) + (if (and pathname (not (directory-pathname-p pathname)) (probe-file* pathname)) (funcall *encoding-detection-hook* pathname) *default-encoding*)) @@ -360,22 +358,6 @@ and implementation-defined external-format's") (funcall *encoding-external-format-hook* encoding)) -;;; Simple filesystem operations -(defun* ensure-all-directories-exist (pathnames) - (dolist (pathname pathnames) - (ensure-directories-exist (translate-logical-pathname pathname)))) - -(defun* rename-file-overwriting-target (source target) - #+clisp ;; But for a bug in CLISP 2.48, we should use :if-exists :overwrite and be atomic - (posix:copy-file source target :method :rename) - #-clisp - (rename-file source target - #+clozure :if-exists #+clozure :rename-and-delete)) - -(defun* delete-file-if-exists (x) - (handler-case (delete-file x) (file-error () nil))) - - ;;; Using temporary files (defun* default-temporary-directory () (or @@ -409,7 +391,7 @@ and implementation-defined external-format's") :for pathname = (pathname (format nil "~A~36R" prefix counter)) :do ;; TODO: on Unix, do something about umask ;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL - ;; TODO: on Unix, use CFFI and mkstemp -- but the master is precisely meant to not depend on CFFI or on anything! Grrrr. + ;; TODO: on Unix, use CFFI and mkstemp -- but asdf/driver is precisely meant to not depend on CFFI or on anything! Grrrr. (with-open-file (stream pathname :direction direction :element-type element-type diff --git a/test/run-tests.sh b/test/run-tests.sh index 6aea13f2dded2b6b0378fb854f62124f93fd0b6c..79650bd4fdadb801ebd3eac2ce945ffec1d8e582 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -282,8 +282,8 @@ extract_tagged_asdf () { } valid_upgrade_test_p () { case "${1}:${2}:${3}" in - abcl:2.0[01][1-9]:*|abcl:2.2[1-2]:*) - : Skip, because it is so damn slow ;; + abcl:1.*|abcl:2.00[0-9]:*|abcl:201[0-7]:*) + : "Skip, because it is so slow." ;; ccl:1.*|ccl:2.0[01]*) : Skip, because ccl broke old asdf ;; clisp:1.??*|clisp:2.00[0-7]:*) diff --git a/test/script-support.lisp b/test/script-support.lisp index eb432522876d0a0ff7e95f363867c578120b81d4..fd8fcf7bcd1b3105845ea34bebaed7db33a1237f 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -430,9 +430,9 @@ is bound, write a message and exit on an error. If (cons (format nil "~{~D~^.~}" ver)) (null "1.0")))))) - (defun test-upgrade (old-method new-method tag) ;; called by run-test (with-test () + (verbose t nil) (when old-method (cond ((string-equal tag "REQUIRE") @@ -444,6 +444,8 @@ is bound, write a message and exit on an error. If (t (format t "Loading old asdf ~A via ~A~%" tag old-method) (funcall old-method tag)))) + (setf (asymval :*asdf-verbose*) t) + (setf (asymval :*verbose-out*) *standard-output*) (format t "Now loading new asdf via method ~A~%" new-method) (funcall new-method) (format t "Testing it~%") diff --git a/upgrade.lisp b/upgrade.lisp index c6718aca6533837ad248b48a82d1bceba77b6229..e2d6a5b917ef361641007654ac8ae9292134684b 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -54,15 +54,22 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ;; "3.4.5.67" would be a development version in the official upstream of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "2.26.163") + (asdf-version "2.26.164") (existing-version (asdf-version))) + (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) (push existing-version *previous-asdf-versions*) (when *asdf-verbose* (format *trace-output* (compatfmt "~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%") - existing-version asdf-version))) - (setf *asdf-version* asdf-version))) + existing-version asdf-version)) + ;; Punt when upgrading from too old a version of ASDF + #+(or abcl clisp cmu) + (when (version< existing-version #+abcl "2.25" #+cmu "2.018" #+clisp "2.27") + (let ((away (format nil "~A-~A" :asdf existing-version))) + (rename-package :asdf away) + (when (or *load-verbose* *asdf-verbose*) + (format *trace-output* "; Renamed package ~A away to ~A~%" :asdf away))))))) (when-upgrading () (let ((redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops. @@ -87,12 +94,12 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO #: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)) - (loop :for name :in (append #-(or clisp ecl) redefined-functions) + (loop :for name :in (append #-(or ecl) redefined-functions) :for sym = (find-symbol* name :asdf nil) :do (when sym (fmakunbound sym))) (loop :with asdf = (find-package :asdf) - :for name :in (append #+(or clisp ecl) redefined-functions uninterned-symbols) ;XXX + :for name :in (append #+(or ecl) redefined-functions uninterned-symbols) ;XXX :for sym = (find-symbol* name :asdf nil) :for base-pkg = (and sym (symbol-package sym)) :do (when sym diff --git a/utility.lisp b/utility.lisp index 370ece0f51381cb3d602d0e136d9c0627af6dd4c..ce3fc62f5ee9fd10b62402d48fa36113d66fff31 100644 --- a/utility.lisp +++ b/utility.lisp @@ -28,7 +28,8 @@ #:match-condition-p #:match-any-condition-p ;; conditions #:call-with-muffled-conditions #:with-muffled-conditions #:load-string #:load-stream - #:parse-version #:unparse-version #:version-compatible-p)) ;; version + #:lexicographic< #:lexicographic<= + #:parse-version #:unparse-version #:version< #:version<= #:version-compatible-p)) ;; version (in-package :asdf/utility) ;;;; Defining functions in a way compatible with hot-upgrade: @@ -314,6 +315,7 @@ instead of a list." ;;; Version handling +(eval-when (:compile-toplevel :load-toplevel :execute) (defun* unparse-version (version-list) (format nil "~{~D~^.~}" version-list)) @@ -344,6 +346,23 @@ in that it doesn't print back to itself, but the list is returned anyway." (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) version-list))) +(defun* lexicographic< (< x y) + (cond ((null y) nil) + ((null x) t) + ((funcall < (car x) (car y)) t) + ((funcall < (car y) (car x)) nil) + (t (lexicographic< < (cdr x) (cdr y))))) + +(defun* lexicographic<= (< x y) + (not (lexicographic< < y x))) + +(defun* version< (version1 version2) + (let ((v1 (parse-version version1 nil)) + (v2 (parse-version version2 nil))) + (lexicographic< '< v1 v2))) + +(defun* version<= (version1 version2) + (not (version< version2 version1))) (defun* version-compatible-p (provided-version required-version) "Is the provided version a compatible substitution for the required-version? @@ -352,14 +371,8 @@ If they are equal, then any later version is compatible, with later being determined by a lexicographical comparison of minor numbers." (let ((x (parse-version provided-version nil)) (y (parse-version required-version nil))) - (labels ((bigger (x y) - (cond ((not y) t) - ((not x) nil) - ((> (car x) (car y)) t) - ((= (car x) (car y)) - (bigger (cdr x) (cdr y)))))) - (and x y (= (car x) (car y)) - (or (not (cdr y)) (bigger (cdr x) (cdr y))))))) + (and x y (= (car x) (car y)) (lexicographic<= '< (cdr y) (cdr x))))) +); eval-when for version support ;;; Condition control diff --git a/version.lisp-expr b/version.lisp-expr index 18c633691214f85c6f474fce8936944b1eda1179..c4c256ece4119c076036fed7bd2553e8ed7772b4 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.26.163" +"2.26.164"