Commit 6a4215d1 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.156: vastly speed up input-files for compile-op system with a shortcut.

Also, better export some backward internals for swank-asdf.
parent 5be1376d
...@@ -62,7 +62,7 @@ ...@@ -62,7 +62,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.155" ;; to be automatically updated by make bump-version :version "2.26.156" ;; to be automatically updated by make bump-version
:depends-on () :depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8 #+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system. ;; For most purposes, asdf itself specially counts as a builtin system.
......
...@@ -9,7 +9,7 @@ ...@@ -9,7 +9,7 @@
(:export (:export
#:*asdf-verbose* #:*asdf-verbose*
#:operation-error #:compile-error #:compile-failed #:compile-warned #:operation-error #:compile-error #:compile-failed #:compile-warned
#:error-component #:error-operation #:load-sysdef #:error-component #:error-operation
#:component-load-dependencies #:component-load-dependencies
#:enable-asdf-binary-locations-compatibility #:enable-asdf-binary-locations-compatibility
#:operation-forced #:operation-forced
...@@ -116,11 +116,6 @@ ASDF:ENABLE-ASDF-BINARY-LOCATIONS-COMPATIBILITY as documented in the manual; ...@@ -116,11 +116,6 @@ ASDF:ENABLE-ASDF-BINARY-LOCATIONS-COMPATIBILITY as documented in the manual;
call that function where you would otherwise have loaded and configured A-B-L."))) call that function where you would otherwise have loaded and configured A-B-L.")))
;;;; load-sysdef
(defun* load-sysdef (name pathname)
(load-asd pathname :name name))
;;;; run-shell-command ;;;; run-shell-command
;; ;;
;; WARNING! The function below is dysfunctional and deprecated. ;; WARNING! The function below is dysfunctional and deprecated.
......
...@@ -7,9 +7,11 @@ ...@@ -7,9 +7,11 @@
:asdf/system :asdf/component :asdf/operation :asdf/system :asdf/component :asdf/operation
:asdf/find-system :asdf/action :asdf/lisp-action) :asdf/find-system :asdf/action :asdf/lisp-action)
(:export ;; for internal use (:export ;; for internal use
#:load-sysdef #:make-temporary-package
#:%refresh-component-inline-methods #:%refresh-component-inline-methods
#:%resolve-if-component-dep-fails #:%resolve-if-component-dep-fails
#:make-sub-operation)) #:make-sub-operation
#:load-sysdef #:make-temporary-package))
(in-package :asdf/backward-internals) (in-package :asdf/backward-internals)
;;;; Backward compatibility with "inline methods" ;;;; Backward compatibility with "inline methods"
...@@ -70,3 +72,13 @@ ...@@ -70,3 +72,13 @@
(when-upgrade (:when (fboundp 'make-sub-operation)) (when-upgrade (:when (fboundp 'make-sub-operation))
(defun* make-sub-operation (c o dep-c dep-o) (defun* make-sub-operation (c o dep-c dep-o)
(declare (ignore c o dep-c dep-o)) (asdf-upgrade-error))) (declare (ignore c o dep-c dep-o)) (asdf-upgrade-error)))
;;;; load-sysdef
(defun* load-sysdef (name pathname)
(load-asd pathname :name name))
(defun* make-temporary-package ()
(make-package (fresh-package-name :prefix :asdf :index 0) :use '(:cl :asdf/interface)))
...@@ -25,6 +25,7 @@ ...@@ -25,6 +25,7 @@
#:component-build-operation #:component-build-operation
#:module-default-component-class #:module-default-component-class
#:module-components ;; backward-compatibility. DO NOT USE. #:module-components ;; backward-compatibility. DO NOT USE.
#:sub-components
;; Internals we'd like to share with the ASDF package, especially for upgrade purposes ;; Internals we'd like to share with the ASDF package, especially for upgrade purposes
#:name #:version #:description #:long-description #:author #:maintainer #:licence #:name #:version #:description #:long-description #:author #:maintainer #:licence
...@@ -257,3 +258,16 @@ another pathname in a degenerate way.")) ...@@ -257,3 +258,16 @@ another pathname in a degenerate way."))
(defmethod version-satisfies ((cver string) version) (defmethod version-satisfies ((cver string) version)
(version-compatible-p cver version)) (version-compatible-p cver version))
;;; all sub-components (of a given type)
(defun* sub-components (component &key (type t))
(while-collecting (c)
(labels ((recurse (x)
(when (if-let (it (component-if-feature x)) (featurep it) t)
(when (typep x type)
(c x))
(when (typep x 'parent-component)
(map () #'recurse (component-children x))))))
(recurse component))))
...@@ -240,21 +240,22 @@ directive.") ...@@ -240,21 +240,22 @@ directive.")
(: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)
(when directory (setf ensure-directory t)) ;; :directory backward compatibility, until 2014-01-16. ;; :directory backward compatibility, until 2014-01-16: accept directory as well as ensure-directory
(let ((dirp (or directory ensure-directory)))
(if (atom x) (if (atom x)
(resolve-absolute-location x :ensure-directory ensure-directory :wilden wilden) (resolve-absolute-location x :ensure-directory dirp :wilden wilden)
(loop* :with (first . rest) = x (loop* :with (first . rest) = x
:with path = (resolve-absolute-location :with path = (resolve-absolute-location
first :ensure-directory (and (or ensure-directory rest) t) first :ensure-directory (and (or dirp rest) t)
:wilden (and wilden (null rest))) :wilden (and wilden (null rest)))
:for (element . morep) :on rest :for (element . morep) :on rest
:for dir = (and (or morep ensure-directory) t) :for dir = (and (or morep dirp) t)
:for wild = (and wilden (not morep)) :for wild = (and wilden (not morep))
:do (setf path (merge-pathnames* :do (setf path (merge-pathnames*
(resolve-relative-location (resolve-relative-location
element :ensure-directory dir :wilden wild) element :ensure-directory dir :wilden wild)
path)) path))
:finally (return path)))) :finally (return path)))))
(defun* location-designator-p (x) (defun* location-designator-p (x)
(flet ((absolute-component-p (c) (flet ((absolute-component-p (c)
......
...@@ -13,4 +13,4 @@ ...@@ -13,4 +13,4 @@
:asdf/package :asdf/utility :asdf/package :asdf/utility
:asdf/pathname :asdf/stream :asdf/os :asdf/image :asdf/pathname :asdf/stream :asdf/os :asdf/image
:asdf/run-program :asdf/lisp-build :asdf/run-program :asdf/lisp-build
:asdf/configuration)) :asdf/configuration :asdf/backward-driver))
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.26.155: Another System Definition Facility. ;;; This is ASDF 2.26.156: 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>.
......
...@@ -145,13 +145,13 @@ ...@@ -145,13 +145,13 @@
#+(or clozure sbcl) #+(or clozure sbcl)
(defmethod input-files ((o compile-op) (c system)) (defmethod input-files ((o compile-op) (c system))
(declare (ignorable o c)) (declare (ignorable o c))
(when *warnings-file-type*
(unless (builtin-system-p c) (unless (builtin-system-p c)
(loop* :for (sub-o . sub-c) ;; The most correct way to do it would be to use:
:in (traverse-sub-actions ;; (traverse-sub-actions o c :other-systems nil :keep-operation 'compile-op :keep-component 'cl-source-file)
o c :other-systems nil ;; but it's expensive and we don't care too much about file order or ASDF extensions.
:keep-operation 'compile-op :keep-component 'cl-source-file) (loop :for sub :in (sub-components c :type 'cl-source-file)
:append (remove-if-not 'warnings-file-p :nconc (remove-if-not 'warnings-file-p (output-files o sub))))))
(output-files sub-o sub-c)))))
#+sbcl #+sbcl
(defmethod output-files ((o compile-op) (c system)) (defmethod output-files ((o compile-op) (c system))
(unless (builtin-system-p c) (unless (builtin-system-p c)
......
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
;; "2.345.6" would be a development version in the official upstream ;; "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.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 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
(asdf-version "2.26.155") (asdf-version "2.26.156")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil)) (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*) (existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)) (already-there (equal asdf-version existing-version))
......
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