From ae3b26b18ec33a570752bbfb584171781210f97c Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Mon, 24 Mar 2014 16:16:03 -0400
Subject: [PATCH] Merge some fixes back from the fare-3.1 branch: * override
 for prepare-op is on component-depends-on, not perform. * coerce-class must
 be defined after call-function, and accept *package* for now.

---
 action.lisp       |  1 -
 operate.lisp      |  2 +-
 uiop/utility.lisp | 58 ++++++++++++++++++++++++-----------------------
 3 files changed, 31 insertions(+), 30 deletions(-)

diff --git a/action.lisp b/action.lisp
index 4600edd8..2c1b4471 100644
--- a/action.lisp
+++ b/action.lisp
@@ -56,7 +56,6 @@
            (component 'component)
            (opix (position operation formals))
            (coix (position component formals))
-
            (prefix (subseq formals 0 opix))
            (suffix (subseq formals (1+ coix) len))
            (more-args (when keyp `(&rest ,rest &key &allow-other-keys))))
diff --git a/operate.lisp b/operate.lisp
index 1df546ae..74aa5c53 100644
--- a/operate.lisp
+++ b/operate.lisp
@@ -110,7 +110,7 @@ or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken.
 The default operation may change in the future if we implement a
 component-directed strategy for how to load or compile systems.")
 
-  (defmethod perform ((o prepare-op) (s system))
+  (defmethod component-depends-on ((o prepare-op) (s system))
     `((,*load-system-operation* ,@(component-sideway-dependencies s))))
 
   (defclass build-op (non-propagating-operation) ()
diff --git a/uiop/utility.lisp b/uiop/utility.lisp
index 1d362da6..aac6a3a6 100644
--- a/uiop/utility.lisp
+++ b/uiop/utility.lisp
@@ -331,34 +331,6 @@ the two results passed to STRCAT always reconstitute the original string"
         (when x (c +crlf+) (c +lf+) (c +cr+) (values x nil)))))
 
 
-;;; CLOS
-(with-upgradability ()
-  (defun coerce-class (class &key (package :cl) (super t) (error 'error))
-    "Coerce CLASS to a class that is subclass of SUPER if specified,
-or invoke ERROR handler as per CALL-FUNCTION.
-
-A keyword designates the name a symbol, which when found in PACKAGE, designates a class.
-A string is read as a symbol while in PACKAGE, the symbol designates a class.
-
-A class object designates itself.
-NIL designates itself (no class).
-A symbol otherwise designates a class by name."
-    (let* ((normalized
-             (typecase class
-              (keyword (find-symbol* class package nil))
-              (string (symbol-call :uiop :safe-read-from-string class :package package))
-              (t class)))
-           (found
-             (etypecase normalized
-               ((or standard-class built-in-class) normalized)
-               ((or null keyword) nil)
-               (symbol (find-class normalized nil nil)))))
-      (or (and found
-               (or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super))
-               found)
-          (call-function error "Can't coerce ~S to a ~@[class~;subclass of ~:*~S]" class super)))))
-
-
 ;;; stamps: a REAL or a boolean where NIL=-infinity, T=+infinity
 (eval-when (#-lispworks :compile-toplevel :load-toplevel :execute)
   (deftype stamp () '(or real boolean)))
@@ -457,6 +429,36 @@ When CALL-NOW-P is true, also call the function immediately."
     (when call-now-p (call-function hook))))
 
 
+;;; CLOS
+(with-upgradability ()
+  (defun coerce-class (class &key (package :cl) (super t) (error 'error))
+    "Coerce CLASS to a class that is subclass of SUPER if specified,
+or invoke ERROR handler as per CALL-FUNCTION.
+
+A keyword designates the name a symbol, which when found in either PACKAGE, designates a class.
+-- for backward compatibility, *PACKAGE* is also accepted for now, but this may go in the future.
+A string is read as a symbol while in PACKAGE, the symbol designates a class.
+
+A class object designates itself.
+NIL designates itself (no class).
+A symbol otherwise designates a class by name."
+    (let* ((normalized
+             (typecase class
+              (keyword (or (find-symbol* class package nil)
+                           (find-symbol* class *package* nil)))
+              (string (symbol-call :uiop :safe-read-from-string class :package package))
+              (t class)))
+           (found
+             (etypecase normalized
+               ((or standard-class built-in-class) normalized)
+               ((or null keyword) nil)
+               (symbol (find-class normalized nil nil)))))
+      (or (and found
+               (or (eq super t) (#-cormanlisp subtypep #+cormanlisp cl::subclassp found super))
+               found)
+          (call-function error "Can't coerce ~S to a ~@[class~;subclass of ~:*~S]" class super)))))
+
+
 ;;; Hash-tables
 (with-upgradability ()
   (defun ensure-gethash (key table default)
-- 
GitLab