From 6a4215d161b8baca9ee3902ad6082cc86c727980 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Sun, 27 Jan 2013 14:00:14 -0500
Subject: [PATCH] 2.26.156: vastly speed up input-files for compile-op system
 with a shortcut.

Also, better export some backward internals for swank-asdf.
---
 asdf.asd                |  2 +-
 backward-interface.lisp |  7 +------
 backward-internals.lisp | 14 +++++++++++++-
 component.lisp          | 14 ++++++++++++++
 configuration.lisp      | 31 ++++++++++++++++---------------
 driver.lisp             |  2 +-
 header.lisp             |  2 +-
 lisp-action.lisp        | 14 +++++++-------
 upgrade.lisp            |  2 +-
 version.lisp-expr       |  2 +-
 10 files changed, 56 insertions(+), 34 deletions(-)

diff --git a/asdf.asd b/asdf.asd
index 2337e0653..2a5ec0c27 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -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.
diff --git a/backward-interface.lisp b/backward-interface.lisp
index 450b453e6..a77703e4b 100644
--- a/backward-interface.lisp
+++ b/backward-interface.lisp
@@ -9,7 +9,7 @@
   (:export
    #:*asdf-verbose*
    #:operation-error #:compile-error #:compile-failed #:compile-warned
-   #:error-component #:error-operation #:load-sysdef
+   #:error-component #:error-operation
    #:component-load-dependencies
    #:enable-asdf-binary-locations-compatibility
    #:operation-forced
@@ -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.
diff --git a/backward-internals.lisp b/backward-internals.lisp
index 79e31e5ed..6caf4d2a8 100644
--- a/backward-internals.lisp
+++ b/backward-internals.lisp
@@ -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
    #:%refresh-component-inline-methods
    #:%resolve-if-component-dep-fails
-   #:make-sub-operation))
+   #:make-sub-operation
+   #: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)))
+
+
diff --git a/component.lisp b/component.lisp
index 663b31b20..3e8c7fd4e 100644
--- a/component.lisp
+++ b/component.lisp
@@ -25,6 +25,7 @@
    #:component-build-operation
    #:module-default-component-class
    #:module-components ;; backward-compatibility. DO NOT USE.
+   #:sub-components
 
    ;; 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))))
diff --git a/configuration.lisp b/configuration.lisp
index 898fe2b47..b9105750d 100644
--- a/configuration.lisp
+++ b/configuration.lisp
@@ -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.
-  (if (atom x)
-      (resolve-absolute-location x :ensure-directory ensure-directory :wilden wilden)
-      (loop* :with (first . rest) = x
-        :with path = (resolve-absolute-location
-                          first :ensure-directory (and (or ensure-directory rest) t)
-                          :wilden (and wilden (null rest)))
-        :for (element . morep) :on rest
-        :for dir = (and (or morep ensure-directory) t)
-        :for wild = (and wilden (not morep))
-        :do (setf path (merge-pathnames*
-                        (resolve-relative-location
-                         element :ensure-directory dir :wilden wild)
-                        path))
-        :finally (return path))))
+  ;; :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 dirp :wilden wilden)
+        (loop* :with (first . rest) = x
+               :with path = (resolve-absolute-location
+                             first :ensure-directory (and (or dirp rest) t)
+                                   :wilden (and wilden (null rest)))
+               :for (element . morep) :on rest
+               :for dir = (and (or morep dirp) t)
+               :for wild = (and wilden (not morep))
+               :do (setf path (merge-pathnames*
+                               (resolve-relative-location
+                                element :ensure-directory dir :wilden wild)
+                               path))
+               :finally (return path)))))
 
 (defun* location-designator-p (x)
   (flet ((absolute-component-p (c)
diff --git a/driver.lisp b/driver.lisp
index 138a99651..950ed7c9d 100644
--- a/driver.lisp
+++ b/driver.lisp
@@ -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/configuration :asdf/backward-driver))
diff --git a/header.lisp b/header.lisp
index e16fb7f2e..d8f53cef0 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.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 <asdf-devel@common-lisp.net>.
diff --git a/lisp-action.lisp b/lisp-action.lisp
index 063b48002..899da7375 100644
--- a/lisp-action.lisp
+++ b/lisp-action.lisp
@@ -145,13 +145,13 @@
 #+(or clozure sbcl)
 (defmethod input-files ((o compile-op) (c system))
   (declare (ignorable o c))
-  (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)))))
+  (when *warnings-file-type*
+    (unless (builtin-system-p 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))))))
 #+sbcl
 (defmethod output-files ((o compile-op) (c system))
   (unless (builtin-system-p c)
diff --git a/upgrade.lisp b/upgrade.lisp
index 0ff92ad26..5f11e470e 100644
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -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))
diff --git a/version.lisp-expr b/version.lisp-expr
index 8c163475d..208d5b743 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -1 +1 @@
-"2.26.155"
+"2.26.156"
-- 
GitLab