From 7ae3daeb3a08d93d16d03a0fb3e4c899f8c6efa1 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Sat, 8 Dec 2012 23:46:43 -0500
Subject: [PATCH] 2.26.11: Some cleanups. Remove MKCL class bundle - we already
 have compiled-file and precompiled-system! Also on MKCL, don't specially load
 asdf-bundle anymore: it's now part of ASDF. Remove a dubious method on
 component-depends-on - let's systematically use make-sub-operation.

---
 asdf.asd  |   2 +-
 asdf.lisp | 179 +++++++++++++++++++-----------------------------------
 2 files changed, 64 insertions(+), 117 deletions(-)

diff --git a/asdf.asd b/asdf.asd
index 71972de4..775446b8 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -14,7 +14,7 @@
   :licence "MIT"
   :description "Another System Definition Facility"
   :long-description "ASDF builds Common Lisp software organized into defined systems."
-  :version "2.26.10" ;; to be automatically updated by bin/bump-revision
+  :version "2.26.11" ;; to be automatically updated by bin/bump-revision
   :depends-on ()
   :components
   ((:file "asdf")))
diff --git a/asdf.lisp b/asdf.lisp
index ab52a84b..edf3030b 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -1,5 +1,5 @@
 ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.26.10: Another System Definition Facility.
+;;; This is ASDF 2.26.11: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
@@ -118,7 +118,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.10")
+         (asdf-version "2.26.11")
          (existing-asdf (find-class 'component nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
@@ -2074,12 +2074,6 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
 (defmacro with-component-being-visited ((o c) &body body)
   `(call-with-component-being-visited ,o ,c #'(lambda () ,@body)))
 
-(defmethod component-depends-on ((op-spec symbol) (c component))
-  ;; Note: we go from op-spec to operation via make-instance
-  ;; to allow for specialization through defmethod's, even though
-  ;; it's a detour in the default case below.
-  (component-depends-on (make-instance op-spec) c))
-
 (defmethod component-depends-on ((o operation) (c component))
   (cdr (assoc (type-of o) (component-in-order-to c))))
 
@@ -2099,8 +2093,8 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
         ;; original source file, then
         (list (component-pathname c)))))
 
-(defmethod input-files ((operation operation) (c module))
-  (declare (ignorable operation c))
+(defmethod input-files ((o operation) (c module))
+  (declare (ignorable o c))
   nil)
 
 (defmethod component-operation-time ((o operation) (c component))
@@ -2471,8 +2465,8 @@ Returns two values:
           (:error (error 'compile-warned :component c :operation operation))
           (:ignore nil))))))
 
-(defmethod output-files ((operation compile-op) (c cl-source-file))
-  (declare (ignorable operation))
+(defmethod output-files ((o compile-op) (c cl-source-file))
+  (declare (ignorable o))
   (let* ((p (lispize-pathname (component-pathname c)))
          (f (compile-file-pathname ;; fasl
              p #+mkcl :fasl-p #+mkcl t #+ecl :type #+ecl :fasl))
@@ -2483,25 +2477,25 @@ Returns two values:
     #+mkcl (list o f)
     #-(or ecl mkcl) (list f)))
 
-(defmethod perform ((operation compile-op) (c static-file))
-  (declare (ignorable operation c))
+(defmethod perform ((o compile-op) (c static-file))
+  (declare (ignorable o c))
   nil)
 
-(defmethod output-files ((operation compile-op) (c static-file))
-  (declare (ignorable operation c))
+(defmethod output-files ((o compile-op) (c static-file))
+  (declare (ignorable o c))
   nil)
 
-(defmethod input-files ((operation compile-op) (c static-file))
-  (declare (ignorable operation))
+(defmethod input-files ((o compile-op) (c static-file))
+  (declare (ignorable o))
   nil)
 
-(defmethod operation-description ((operation compile-op) component)
-  (declare (ignorable operation))
-  (format nil (compatfmt "~@<compiling ~3i~_~A~@:>") component))
+(defmethod operation-description ((o compile-op) (c component))
+  (declare (ignorable o))
+  (format nil (compatfmt "~@<compiling ~3i~_~A~@:>") c))
 
-(defmethod operation-description ((operation compile-op) (component module))
-  (declare (ignorable operation))
-  (format nil (compatfmt "~@<compiled ~3i~_~A~@:>") component))
+(defmethod operation-description ((o compile-op) (c module))
+  (declare (ignorable o))
+  (format nil (compatfmt "~@<compiled ~3i~_~A~@:>") c))
 
 
 ;;;; -------------------------------------------------------------------------
@@ -2530,33 +2524,31 @@ Returns two values:
 	     :unless (string= (pathname-type i) "fas")
 	     :collect (compile-file-pathname (lispize-pathname i)))))
 
-(defmethod perform ((operation load-op) (c static-file))
-  (declare (ignorable operation c))
+(defmethod perform ((o load-op) (c static-file))
+  (declare (ignorable o c))
   nil)
 
-(defmethod output-files ((operation operation) (c component))
-  (declare (ignorable operation c))
+(defmethod output-files ((o operation) (c component))
+  (declare (ignorable o c))
   nil)
 
-(defmethod component-depends-on ((operation load-op) (c component))
-  (declare (ignorable operation))
+(defmethod component-depends-on ((o load-op) (c component))
+  (declare (ignorable o))
   (cons (list 'compile-op (component-name c))
         (call-next-method)))
 
-(defmethod operation-description ((operation load-op) component)
-  (declare (ignorable operation))
+(defmethod operation-description ((o load-op) component)
+  (declare (ignorable o))
   (format nil (compatfmt "~@<loading ~3i~_~A~@:>")
           component))
 
-(defmethod operation-description ((operation load-op) (component cl-source-file))
-  (declare (ignorable operation))
-  (format nil (compatfmt "~@<loading FASL for ~3i~_~A~@:>")
-          component))
+(defmethod operation-description ((o load-op) (c cl-source-file))
+  (declare (ignorable o))
+  (format nil (compatfmt "~@<loading FASL for ~3i~_~A~@:>") c))
 
-(defmethod operation-description ((operation load-op) (component module))
-  (declare (ignorable operation))
-  (format nil (compatfmt "~@<loaded ~3i~_~A~@:>")
-          component))
+(defmethod operation-description ((o load-op) (c module))
+  (declare (ignorable o))
+  (format nil (compatfmt "~@<loaded ~3i~_~A~@:>") c))
 
 ;;;; -------------------------------------------------------------------------
 ;;;; load-source-op
@@ -2568,29 +2560,27 @@ Returns two values:
   (call-with-around-compile-hook
    c #'(lambda () (load (component-pathname c) :external-format (component-external-format c)))))
 
-(defmethod perform ((operation load-source-op) (c static-file))
-  (declare (ignorable operation c))
+(defmethod perform ((o load-source-op) (c static-file))
+  (declare (ignorable o c))
   nil)
 
-(defmethod output-files ((operation load-source-op) (c component))
-  (declare (ignorable operation c))
+(defmethod output-files ((o load-source-op) (c component))
+  (declare (ignorable o c))
   nil)
 
 ;;; FIXME: We simply copy load-op's dependencies.  This is Just Not Right.
 (defmethod component-depends-on ((o load-source-op) (c component))
-  (declare (ignorable o))
-  (loop :with what-would-load-op-do = (component-depends-on 'load-op c)
+  (loop :with what-would-load-op-do = (component-depends-on (make-sub-operation o 'load-op) c)
     :for (op . co) :in what-would-load-op-do
     :when (eq op 'load-op) :collect (cons 'load-source-op co)))
 
-(defmethod operation-description ((operation load-source-op) component)
-  (declare (ignorable operation))
-  (format nil (compatfmt "~@<Loading source of ~3i~_~A~@:>")
-          component))
+(defmethod operation-description ((o load-source-op) c)
+  (declare (ignorable o))
+  (format nil (compatfmt "~@<Loading source of ~3i~_~A~@:>") c))
 
-(defmethod operation-description ((operation load-source-op) (component module))
-  (declare (ignorable operation))
-  (format nil (compatfmt "~@<Loaded source of ~3i~_~A~@:>") component))
+(defmethod operation-description ((o load-source-op) (c module))
+  (declare (ignorable o))
+  (format nil (compatfmt "~@<Loaded source of ~3i~_~A~@:>") c))
 
 
 ;;;; -------------------------------------------------------------------------
@@ -4531,8 +4521,8 @@ with a different configuration, so the configuration would be re-read then."
         (remove-keys '(type monolithic name-suffix)
                      (slot-value instance 'original-initargs))))
 
-(defmethod bundle-op-build-args :around ((op lib-op))
-  (declare (ignorable op))
+(defmethod bundle-op-build-args :around ((o lib-op))
+  (declare (ignorable o))
   (let ((args (call-next-method)))
     (remf args :ld-flags)
     args))
@@ -4543,13 +4533,12 @@ with a different configuration, so the configuration would be re-read then."
   (declare (ignorable o c))
   (not *force-load-p*))
 
-(defun gather-components (op-type system &key filter-system filter-type include-self)
+(defun gather-components (operation system &key filter-system filter-type include-self)
   ;; This function creates a list of components,
   ;; matched together with an operation.
   ;; This list may be restricted to sub-components of SYSTEM
   ;; if GATHER-ALL = NIL (default), and it may include the system itself.
-  (let* ((operation (make-instance op-type))
-         (*force-load-p* t)
+  (let* ((*force-load-p* t)
          (tree (traverse (make-sub-operation operation 'load-op) system)))
     (append
      (loop :for (op . component) :in tree
@@ -4581,8 +4570,7 @@ with a different configuration, so the configuration would be re-read then."
 ;;; Gather the static libraries of all components.
 ;;;
 (defmethod bundle-sub-operations ((o monolithic-bundle-op) c)
-  (declare (ignorable o))
-  (gather-components 'lib-op c :filter-type 'system :include-self t))
+  (gather-components (make-sub-operation o 'lib-op) c :filter-type 'system :include-self t))
 
 ;;;
 ;;; STATIC LIBRARIES
@@ -4591,12 +4579,11 @@ with a different configuration, so the configuration would be re-read then."
 ;;; and, if monolithic, also of systems and subsystems.
 ;;;
 (defmethod bundle-sub-operations ((o lib-op) c)
-  (gather-components 'compile-op c
+  (gather-components (make-sub-operation o 'compile-op) c
                      :filter-system (and (not (bundle-op-monolithic-p o)) c)
                      :filter-type '(not system)))
 (defmethod bundle-sub-operations ((o monolithic-lib-op) c)
-  (declare (ignorable o))
-  (gather-components 'compile-op c
+  (gather-components (make-sub-operation o 'compile-op) c
                      :filter-system nil
                      :filter-type '(not system)))
 ;;;
@@ -4728,30 +4715,24 @@ with a different configuration, so the configuration would be re-read then."
 ;;;
 
 (defclass compiled-file (component)
-  ((type :initform nil)))
+  ((type :initform #-(or ecl mkcl) (fasl-type) #+(or ecl mkcl) "fasb")))
 
 (defmethod trivial-system-p ((s module))
   (every #'(lambda (c) (typep c 'compiled-file)) (module-components s)))
 
-(defmethod component-relative-pathname ((component compiled-file))
-  (coerce-pathname
-   (or (slot-value component 'relative-pathname)
-       (component-name component))
-   :type (fasl-type)
-   :defaults (component-parent-pathname component)))
-
 (defmethod output-files (o (c compiled-file))
   (declare (ignore o c))
   nil)
 (defmethod input-files (o (c compiled-file))
-  (declare (ignore o c))
-  nil)
-(defmethod perform ((o load-op) (c compiled-file))
   (declare (ignore o))
   (load (component-pathname c)))
-(defmethod perform ((o load-fasl-op) (c compiled-file))
+(defmethod perform ((o load-op) (c compiled-file))
   (declare (ignore o))
   (load (component-pathname c)))
+(defmethod perform ((o load-source-op) (c compiled-file))
+  (perform (make-sub-operation o 'load-op) c))
+(defmethod perform ((o load-fasl-op) (c compiled-file))
+  (perform (make-sub-operation o 'load-op) c))
 (defmethod perform (o (c compiled-file))
   (declare (ignore o c))
   nil)
@@ -4980,16 +4961,15 @@ using WRITE-SEQUENCE and a sensibly sized buffer." ; copied from xcvb-driver
 ;;; dependencies of this bundle.
 ;;;
 
-(defun mkcl-bundle-sub-operations (sys)
-  (gather-components 'compile-op sys
+(defun mkcl-bundle-sub-operations (op sys)
+  (gather-components (make-sub-operation op 'compile-op) sys
 		     :filter-system sys
 		     :filter-type '(not system)))
 
-(defun files-to-bundle (sys)
-  (loop :for (op . comp) :in (mkcl-bundle-sub-operations sys)
-    :for sub-files = (output-files op comp)
-    :when sub-files
-    :collect (first sub-files)))
+(defun files-to-bundle (operation system)
+  (loop :for (o . c) :in (mkcl-bundle-sub-operations operation system)
+    :for sub-files = (output-files o c)
+    :when sub-files :collect (first sub-files)))
 
 (defmethod component-depends-on ((o bundle-op) (c system))
   (cons `(compile-op ,(component-name c)) (call-next-method)))
@@ -5005,7 +4985,7 @@ using WRITE-SEQUENCE and a sensibly sized buffer." ; copied from xcvb-driver
     (list static-lib-name fasl-bundle-name)))
 
 (defmethod perform ((o bundle-op) (c system))
-  (let* ((object-files (files-to-bundle c))
+  (let* ((object-files (files-to-bundle o c))
 	 (output (output-files o c)))
     (ensure-directories-exist (first output))
     (when (bundle-op-do-static-library-p o)
@@ -5018,47 +4998,14 @@ using WRITE-SEQUENCE and a sensibly sized buffer." ; copied from xcvb-driver
 (defun bundle-system (system &rest args &key force (verbose t) version &allow-other-keys)
   (declare (ignore force verbose version))
   (apply #'operate 'bundle-op system args))
-
-;;;
-;;; BUNDLED FILES
-;;;
-;;; This component can be used to distribute ASDF libraries in bundled form.
-;;;
-
-(defclass bundle (component) ())
-
-(defmethod source-file-type ((c bundle) (s system))
-  "fasb")
-
-(defmethod perform ((o load-op) (c bundle))
-  (load (component-pathname c)))
-
-(defmethod perform (o (c bundle))
-  (declare (ignore o))
-  nil)
-
-;; The ability to load a fasb bundle is separate from
-;; the ability to build a fasb bundle, so this is somewhat unrelated to what is above.
 );mkcl
 
 
-
 ;;;; -----------------------------------------------------------------
 ;;;; Done!
 (when *load-verbose*
   (asdf-message ";; ASDF, version ~a~%" (asdf-version)))
 
-#+mkcl
-(handler-case
-    (progn
-      (load-sysdef "asdf-bundle"
-                   (subpathname (translate-logical-pathname #P"CONTRIB:")
-                                "asdf-bundle/asdf-bundle.asd"))
-      (load-system "asdf-bundle"))
-  (error (e)
-    (format *error-output*
-            "~&;;; ASDF: Failed to load package 'asdf-bundle'!~%;;; ~A~%" e)))
-
 #+allegro
 (eval-when (:compile-toplevel :execute)
   (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
-- 
GitLab