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

2.26.164: upgrade now works on ABCL! But still not on CLISP.

Also, move some functions from stream to filesystem where they belong.
parent ac799f29
* 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.
......
......@@ -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"))
......
......@@ -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.
......
......@@ -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
......
......@@ -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)))
;;; -*- 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
......
......@@ -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)
......
......@@ -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)
......
......@@ -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*
......
......@@ -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
......
......@@ -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
......
......@@ -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]:*)
......
......@@ -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~%")
......
......@@ -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
......
......@@ -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
......
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