Skip to content
Snippets Groups Projects
Commit 184a5a0d authored by Raymond Toy's avatar Raymond Toy
Browse files

Update to asdf 3.1.7.

parent ee6b86bf
No related branches found
No related tags found
No related merge requests found
;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*- ;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
;;; This is ASDF 3.1.6.9: Another System Definition Facility. ;;; This is ASDF 3.1.7: 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>.
...@@ -3762,7 +3762,7 @@ Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE." ...@@ -3762,7 +3762,7 @@ Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE."
(when eof (return))) (when eof (return)))
(loop (loop
:with buffer-size = (or buffer-size 8192) :with buffer-size = (or buffer-size 8192)
:for buffer = (make-array (list buffer-size) :element-type (or element-type 'character)) :with buffer = (make-array (list buffer-size) :element-type (or element-type 'character))
:for end = (read-sequence buffer input) :for end = (read-sequence buffer input)
:until (zerop end) :until (zerop end)
:do (write-sequence buffer output :end end) :do (write-sequence buffer output :end end)
...@@ -6138,25 +6138,26 @@ possibly in a different process. Otherwise just call THUNK." ...@@ -6138,25 +6138,26 @@ possibly in a different process. Otherwise just call THUNK."
"This function provides a portable wrapper around COMPILE-FILE. "This function provides a portable wrapper around COMPILE-FILE.
It ensures that the OUTPUT-FILE value is only returned and It ensures that the OUTPUT-FILE value is only returned and
the file only actually created if the compilation was successful, the file only actually created if the compilation was successful,
even though your implementation may not do that, and including even though your implementation may not do that. It also checks an optional
an optional call to an user-provided consistency check function COMPILE-CHECK; user-provided consistency function COMPILE-CHECK to determine success;
it will call this function if not NIL at the end of the compilation it will call this function if not NIL at the end of the compilation
with the arguments sent to COMPILE-FILE*, except with :OUTPUT-FILE TMP-FILE with the arguments sent to COMPILE-FILE*, except with :OUTPUT-FILE TMP-FILE
where TMP-FILE is the name of a temporary output-file. where TMP-FILE is the name of a temporary output-file.
It also checks two flags (with legacy british spelling from ASDF1), It also checks two flags (with legacy british spelling from ASDF1),
*COMPILE-FILE-FAILURE-BEHAVIOUR* and *COMPILE-FILE-WARNINGS-BEHAVIOUR* *COMPILE-FILE-FAILURE-BEHAVIOUR* and *COMPILE-FILE-WARNINGS-BEHAVIOUR*
with appropriate implementation-dependent defaults, with appropriate implementation-dependent defaults,
and if a failure (respectively warnings) are reported by COMPILE-FILE and if a failure (respectively warnings) are reported by COMPILE-FILE,
with consider it an error unless the respective behaviour flag it will consider that an error unless the respective behaviour flag
is one of :SUCCESS :WARN :IGNORE. is one of :SUCCESS :WARN :IGNORE.
If WARNINGS-FILE is defined, deferred warnings are saved to that file. If WARNINGS-FILE is defined, deferred warnings are saved to that file.
On ECL or MKCL, it creates both the linkable object and loadable fasl files. On ECL or MKCL, it creates both the linkable object and loadable fasl files.
On implementations that erroneously do not recognize standard keyword arguments, On implementations that erroneously do not recognize standard keyword arguments,
it will filter them appropriately." it will filter them appropriately."
#+(or clasp ecl) (when (and object-file (equal (compile-file-type) (pathname object-file))) #+(or clasp ecl)
(format t "Whoa, some funky ASDF upgrade switched ~S calling convention for ~S and ~S~%" (when (and object-file (equal (compile-file-type) (pathname object-file)))
'compile-file* output-file object-file) (format t "Whoa, some funky ASDF upgrade switched ~S calling convention for ~S and ~S~%"
(rotatef output-file object-file)) 'compile-file* output-file object-file)
(rotatef output-file object-file))
(let* ((keywords (remove-plist-keys (let* ((keywords (remove-plist-keys
`(:output-file :compile-check :warnings-file `(:output-file :compile-check :warnings-file
#+clisp :lib-file #+(or clasp ecl mkcl) :object-file) keys)) #+clisp :lib-file #+(or clasp ecl mkcl) :object-file) keys))
...@@ -6167,7 +6168,7 @@ it will filter them appropriately." ...@@ -6167,7 +6168,7 @@ it will filter them appropriately."
(object-file (object-file
(unless (use-ecl-byte-compiler-p) (unless (use-ecl-byte-compiler-p)
(or object-file (or object-file
#+ecl(compile-file-pathname output-file :type :object) #+ecl (compile-file-pathname output-file :type :object)
#+clasp (compile-file-pathname output-file :output-type :object)))) #+clasp (compile-file-pathname output-file :output-type :object))))
#+mkcl #+mkcl
(object-file (object-file
...@@ -6845,7 +6846,7 @@ previously-loaded version of ASDF." ...@@ -6845,7 +6846,7 @@ previously-loaded version of ASDF."
;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5. ;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5.
;; "3.4.5.0.8" would be your eighth local modification of official release 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 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(asdf-version "3.1.6.9") (asdf-version "3.1.7")
(existing-version (asdf-version))) (existing-version (asdf-version)))
(setf *asdf-version* asdf-version) (setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-version))) (when (and existing-version (not (equal asdf-version existing-version)))
...@@ -8363,6 +8364,7 @@ The class needs to be updated for ASDF 3.1 and specify appropriate propagation m ...@@ -8363,6 +8364,7 @@ The class needs to be updated for ASDF 3.1 and specify appropriate propagation m
;;;; Done performing ;;;; Done performing
(with-upgradability () (with-upgradability ()
(defgeneric component-operation-time (operation component)) ;; ASDF4: hide it behind plan-action-stamp (defgeneric component-operation-time (operation component)) ;; ASDF4: hide it behind plan-action-stamp
(defgeneric (setf component-operation-time) (time operation component))
(define-convenience-action-methods component-operation-time (operation component)) (define-convenience-action-methods component-operation-time (operation component))
   
(defgeneric mark-operation-done (operation component)) ;; ASDF4: hide it behind (setf plan-action-stamp) (defgeneric mark-operation-done (operation component)) ;; ASDF4: hide it behind (setf plan-action-stamp)
...@@ -9798,15 +9800,22 @@ after having found a .asd file? True by default.") ...@@ -9798,15 +9800,22 @@ after having found a .asd file? True by default.")
(defun collect-sub*directories-asd-files (defun collect-sub*directories-asd-files
(directory &key (exclude *default-source-registry-exclusions*) collect (directory &key (exclude *default-source-registry-exclusions*) collect
(recurse-beyond-asds *recurse-beyond-asds*) ignore-cache) (recurse-beyond-asds *recurse-beyond-asds*) ignore-cache)
(collect-sub*directories (let ((visited (make-hash-table :test 'equalp)))
directory (collect-sub*directories
#'(lambda (dir) directory
(unless (and (not ignore-cache) (process-source-registry-cache directory collect)) #'(lambda (dir)
(let ((asds (collect-asds-in-directory dir collect))) (unless (and (not ignore-cache) (process-source-registry-cache directory collect))
(or recurse-beyond-asds (not asds))))) (let ((asds (collect-asds-in-directory dir collect)))
#'(lambda (x) (or recurse-beyond-asds (not asds)))))
(not (member (car (last (pathname-directory x))) exclude :test #'equal))) #'(lambda (x) ; x will be a directory pathname
(constantly nil))) (and
(not (member (car (last (pathname-directory x))) exclude :test #'equal))
(flet ((pathname-key (x)
(namestring (truename* x))))
(let ((visitedp (gethash (pathname-key x) visited)))
(if visitedp nil
(setf (gethash (pathname-key x) visited) t))))))
(constantly nil))))
   
(defun validate-source-registry-directive (directive) (defun validate-source-registry-directive (directive)
(or (member directive '(:default-registry)) (or (member directive '(:default-registry))
...@@ -10592,10 +10601,10 @@ for all the linkable object files associated with the system or its dependencies ...@@ -10592,10 +10601,10 @@ for all the linkable object files associated with the system or its dependencies
(format nil "~A~@[~A~]" (component-name c) (slot-value o 'name-suffix)))) (format nil "~A~@[~A~]" (component-name c) (slot-value o 'name-suffix))))
(type (bundle-pathname-type bundle-type))) (type (bundle-pathname-type bundle-type)))
(values (list (subpathname (component-pathname c) name :type type)) (values (list (subpathname (component-pathname c) name :type type))
(eq (type-of o) (coerce-class (component-build-operation c) (eq (class-of o) (coerce-class (component-build-operation c)
:package :asdf/interface :package :asdf/interface
:super 'operation :super 'operation
:error nil))))))) :error nil)))))))
   
(defmethod output-files ((o bundle-op) (c system)) (defmethod output-files ((o bundle-op) (c system))
(bundle-output-files o c)) (bundle-output-files o c))
......
This diff is collapsed.
This diff is collapsed.
No preview for this file type
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment