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 @@
:licence "MIT"
:description "Another System Definition Facility"
: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 ()
#+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system.
......@@ -9,7 +9,7 @@
#:operation-error #:compile-error #:compile-failed #:compile-warned
#:error-component #:error-operation #:load-sysdef
#:error-component #:error-operation
......@@ -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.")))
;;;; load-sysdef
(defun* load-sysdef (name pathname)
(load-asd pathname :name name))
;;;; run-shell-command
;; WARNING! The function below is dysfunctional and deprecated.
......@@ -7,9 +7,11 @@
:asdf/system :asdf/component :asdf/operation
:asdf/find-system :asdf/action :asdf/lisp-action)
(:export ;; for internal use
#:load-sysdef #:make-temporary-package
#:load-sysdef #:make-temporary-package))
(in-package :asdf/backward-internals)
;;;; Backward compatibility with "inline methods"
......@@ -70,3 +72,13 @@
(when-upgrade (:when (fboundp 'make-sub-operation))
(defun* make-sub-operation (c o dep-c dep-o)
(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 @@
#:module-components ;; backward-compatibility. DO NOT USE.
;; Internals we'd like to share with the ASDF package, especially for upgrade purposes
#:name #:version #:description #:long-description #:author #:maintainer #:licence
......@@ -257,3 +258,16 @@ another pathname in a degenerate way."))
(defmethod version-satisfies ((cver string) 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.")
(:ensure-directory boolean)) t) resolve-location))
(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)
(resolve-absolute-location x :ensure-directory ensure-directory :wilden wilden)
(resolve-absolute-location x :ensure-directory dirp :wilden wilden)
(loop* :with (first . rest) = x
: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)))
: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))
:do (setf path (merge-pathnames*
element :ensure-directory dir :wilden wild)
:finally (return path))))
:finally (return path)))))
(defun* location-designator-p (x)
(flet ((absolute-component-p (c)
......@@ -13,4 +13,4 @@
:asdf/package :asdf/utility
:asdf/pathname :asdf/stream :asdf/os :asdf/image
:asdf/run-program :asdf/lisp-build
:asdf/configuration :asdf/backward-driver))
;;; -*- 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:
;;; please mail to <>.
......@@ -145,13 +145,13 @@
#+(or clozure sbcl)
(defmethod input-files ((o compile-op) (c system))
(declare (ignorable o c))
(when *warnings-file-type*
(unless (builtin-system-p c)
(loop* :for (sub-o . sub-c)
:in (traverse-sub-actions
o c :other-systems nil
:keep-operation 'compile-op :keep-component 'cl-source-file)
:append (remove-if-not 'warnings-file-p
(output-files sub-o sub-c)))))
;; The most correct way to do it would be to use:
;; (traverse-sub-actions o c :other-systems nil :keep-operation 'compile-op :keep-component 'cl-source-file)
;; but it's expensive and we don't care too much about file order or ASDF extensions.
(loop :for sub :in (sub-components c :type 'cl-source-file)
:nconc (remove-if-not 'warnings-file-p (output-files o sub))))))
(defmethod output-files ((o compile-op) (c system))
(unless (builtin-system-p c)
......@@ -35,7 +35,7 @@
;; "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.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-version *asdf-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