From 5f73d4d761132cbceb1dd06c2f54fb7632a78b8a Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Sat, 8 Jun 2013 10:36:55 +0200
Subject: [PATCH] 3.0.1.4: factor MAKE-PLAN out of TRAVERSE.

For consistency, MAKE-PLAN always returns a plan.
For backward compatibility, TRAVERSE always returns a list of actions.
OPERATE now calls MAKE-PLAN, not TRAVERSE anymore.
Happily, no one in quicklisp defines *useful* methods on TRAVERSE.
Thanks to foom for suggesting this cleanup.
---
 action.lisp              | 17 +++++++++++------
 asdf.asd                 |  2 +-
 header.lisp              |  2 +-
 operate.lisp             |  6 +++---
 plan.lisp                | 24 ++++++++++++++++++------
 test/script-support.lisp |  2 +-
 upgrade.lisp             |  2 +-
 version.lisp-expr        |  2 +-
 8 files changed, 37 insertions(+), 20 deletions(-)

diff --git a/action.lisp b/action.lisp
index 6f464665..0c975f7e 100644
--- a/action.lisp
+++ b/action.lisp
@@ -38,17 +38,22 @@
 ;;;; Convenience methods
 (with-upgradability ()
   (defmacro define-convenience-action-methods
-      (function (operation component &optional keyp)
-       &key if-no-operation if-no-component operation-initargs)
+      (function formals &key if-no-operation if-no-component operation-initargs)
     (let* ((rest (gensym "REST"))
            (found (gensym "FOUND"))
+           (keyp (equal (last formals) '(&key)))
+           (formals-no-key (if keyp (butlast formals) formals))
+           (len (length formals-no-key))
+           (prefix (subseq formals 0 (- len 2)))
+           (operation (nth (- len 2) formals))
+           (component (nth (- len 1) formals))
            (more-args (when keyp `(&rest ,rest &key &allow-other-keys))))
       (flet ((next-method (o c)
                (if keyp
-                   `(apply ',function ,o ,c ,rest)
-                   `(,function ,o ,c))))
+                   `(apply ',function ,@prefix ,o ,c ,rest)
+                   `(,function ,@prefix ,o ,c))))
         `(progn
-           (defmethod ,function ((,operation symbol) ,component ,@more-args)
+           (defmethod ,function (,@prefix (,operation symbol) ,component ,@more-args)
              (if ,operation
                  ,(next-method
                    (if operation-initargs ;backward-compatibility with ASDF1's operate. Yuck.
@@ -56,7 +61,7 @@
                        `(make-operation ,operation))
                    `(or (find-component () ,component) ,if-no-component))
                  ,if-no-operation))
-           (defmethod ,function ((,operation operation) ,component ,@more-args)
+           (defmethod ,function (,@prefix (,operation operation) ,component ,@more-args)
              (if (typep ,component 'component)
                  (error "No defined method for ~S on ~/asdf-action:format-action/"
                         ',function (cons ,operation ,component))
diff --git a/asdf.asd b/asdf.asd
index eb16c317..67b445cb 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -74,7 +74,7 @@
   :licence "MIT"
   :description "Another System Definition Facility"
   :long-description "ASDF builds Common Lisp software organized into defined systems."
-  :version "3.0.1.3" ;; to be automatically updated by make bump-version
+  :version "3.0.1.4" ;; 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/header.lisp b/header.lisp
index d75114ff..2b59d8f6 100644
--- a/header.lisp
+++ b/header.lisp
@@ -1,5 +1,5 @@
 ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
-;;; This is ASDF 3.0.1.3: Another System Definition Facility.
+;;; This is ASDF 3.0.1.4: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
diff --git a/operate.lisp b/operate.lisp
index 004632ad..8bd54ea8 100644
--- a/operate.lisp
+++ b/operate.lisp
@@ -86,10 +86,10 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
       (error 'missing-component-of-version :requires component :version version)))
 
   (defmethod operate ((operation operation) (component component)
-                      &rest keys &key &allow-other-keys)
-    (let ((plan (apply 'traverse operation component keys)))
+                      &rest keys &key plan-class &allow-other-keys)
+    (let ((plan (apply 'make-plan plan-class operation component keys)))
       (apply 'perform-plan plan keys)
-      (values operation plan)))
+      (values operation (plan-actions plan) plan)))
 
   (defun oos (operation component &rest args &key &allow-other-keys)
     (apply 'operate operation component args))
diff --git a/plan.lisp b/plan.lisp
index bdf26513..7b7caa75 100644
--- a/plan.lisp
+++ b/plan.lisp
@@ -20,7 +20,7 @@
    #:visit-dependencies #:compute-action-stamp #:traverse-action
    #:circular-dependency #:circular-dependency-actions
    #:call-while-visiting-action #:while-visiting-action
-   #:traverse #:plan-actions #:perform-plan #:plan-operates-on-p
+   #:make-plan #:traverse #:plan-actions #:perform-plan #:plan-operates-on-p
    #:planned-p #:index #:forced #:forced-not #:total-action-count
    #:planned-action-count #:planned-output-action-count #:visited-actions
    #:visiting-action-set #:visiting-action-list #:plan-actions-r
@@ -342,6 +342,8 @@ the action of OPERATION on COMPONENT in the PLAN"))
     ((actions-r :initform nil :accessor plan-actions-r)))
 
   (defgeneric plan-actions (plan))
+  (defmethod plan-actions ((plan list))
+    plan)
   (defmethod plan-actions ((plan sequential-plan))
     (reverse (plan-actions-r plan)))
 
@@ -358,6 +360,11 @@ the action of OPERATION on COMPONENT in the PLAN"))
 
 ;;;; high-level interface: traverse, perform-plan, plan-operates-on-p
 (with-upgradability ()
+  (defgeneric make-plan (plan-class operation component &key &allow-other-keys)
+    (:documentation
+     "Generate and return a plan for performing OPERATION on COMPONENT."))
+  (define-convenience-action-methods make-plan (plan-class operation component &key))
+
   (defgeneric* (traverse) (operation component &key &allow-other-keys)
     (:documentation
      "Generate and return a plan for performing OPERATION on COMPONENT.
@@ -372,20 +379,25 @@ processed in order by OPERATE."))
 
   (defvar *default-plan-class* 'sequential-plan)
 
-  (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys)
+  (defmethod make-plan (plan-class (o operation) (c component) &rest keys &key &allow-other-keys)
     (let ((plan (apply 'make-instance
                        (or plan-class *default-plan-class*)
-                       :system (component-system c) (remove-plist-key :plan-class keys))))
+                       :system (component-system c) keys)))
       (traverse-action plan o c t)
-      (plan-actions plan)))
+      plan))
 
-  (defmethod perform-plan :around (plan &key)
-    (declare (ignorable plan))
+  (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys)
+    (plan-actions (apply 'make-plan plan-class o c keys)))
+
+  (defmethod perform-plan :around ((plan t) &key)
     (let ((*package* *package*)
           (*readtable* *readtable*))
       (with-compilation-unit () ;; backward-compatibility.
         (call-next-method))))   ;; Going forward, see deferred-warning support in lisp-build.
 
+  (defmethod perform-plan ((plan t) &rest keys &key &allow-other-keys)
+    (apply 'perform-plan (plan-actions plan) keys))
+
   (defmethod perform-plan ((steps list) &key force &allow-other-keys)
     (loop* :for (o . c) :in steps
            :when (or force (not (nth-value 1 (compute-action-stamp nil o c))))
diff --git a/test/script-support.lisp b/test/script-support.lisp
index ea471638..84df1f85 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -559,7 +559,7 @@ is bound, write a message and exit on an error.  If
   `(apply (asym :register-system-definition) ',name :pathname ,*test-directory*
           :source-file nil ',rest))
 
-(defun in-plan-p (plan x) (member x plan :key (asym :action-path) :test 'equal))
+(defun in-plan-p (plan x) (member x (acall :plan-actions plan) :key (asym :action-path) :test 'equal))
 
 (defmacro test-load-systems (&rest x)
   `(do-test-load-systems ',x))
diff --git a/upgrade.lisp b/upgrade.lisp
index cba4b396..700746f9 100644
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
          ;; "3.4.5.67" would be a development version in the official upstream of 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
-         (asdf-version "3.0.1.3")
+         (asdf-version "3.0.1.4")
          (existing-version (asdf-version)))
     (setf *asdf-version* asdf-version)
     (when (and existing-version (not (equal asdf-version existing-version)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 57757f6c..b61ff923 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -1 +1 @@
-"3.0.1.3"
+"3.0.1.4"
-- 
GitLab