From 1f9c4bb952a1f8b19ee9da0f54e95b2b3aa9111a Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 20 May 2012 20:11:29 +0300
Subject: [PATCH] make ENSURE-GENERIC-FUNCTION accept method combination
 arguments

  Previously we only accepted a list designating the method combination, but
  since MOP also specifies a way to grab the actual method combination, we
  should really accept that as well.

  Fixes bug 936513.
---
 NEWS                |    3 +++
 src/pcl/boot.lisp   |   14 ++++++++------
 tests/mop.pure.lisp |    8 ++++++++
 3 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/NEWS b/NEWS
index 04059a8..a3a9a69 100644
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,9 @@ changes relative to sbcl-1.0.57:
     properly.
   * bug fix: functions from EVAL are now on more equal footing with functions
     from COMPILE. (lp#1000783, lp#851170, lp#922408)
+  * bug fix: ENSURE-GENERIC-METHOD-COMBINATION accepts method combination
+    objects as its :METHOD-COMBINATION argument, not just lists designating
+    method combinations. (lp#936513)
 
 changes in sbcl-1.0.57 relative to sbcl-1.0.56:
   * RANDOM enhancements and bug fixes:
diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index 1e1518a..7189a53 100644
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -2199,12 +2199,14 @@ bootstrapping.
            (finalize-inheritance ,gf-class)))
      (remf ,all-keys :generic-function-class)
      (remf ,all-keys :environment)
-     (let ((combin (getf ,all-keys :method-combination '.shes-not-there.)))
-       (unless (eq combin '.shes-not-there.)
-         (setf (getf ,all-keys :method-combination)
-               (find-method-combination (class-prototype ,gf-class)
-                                        (car combin)
-                                        (cdr combin)))))
+     (let ((combin (getf ,all-keys :method-combination)))
+       (etypecase combin
+         (cons
+          (setf (getf ,all-keys :method-combination)
+                (find-method-combination (class-prototype ,gf-class)
+                                         (car combin)
+                                         (cdr combin))))
+         ((or null method-combination))))
     (let ((method-class (getf ,all-keys :method-class '.shes-not-there.)))
       (unless (eq method-class '.shes-not-there.)
         (setf (getf ,all-keys :method-class)
diff --git a/tests/mop.pure.lisp b/tests/mop.pure.lisp
index cb60b25..b35f47d 100644
--- a/tests/mop.pure.lisp
+++ b/tests/mop.pure.lisp
@@ -85,3 +85,11 @@
                (sb-mop:class-direct-superclasses (make-instance 'standard-class))))
 (assert (equal (list (find-class 'sb-mop:funcallable-standard-object))
                (sb-mop:class-direct-superclasses (make-instance 'sb-mop:funcallable-standard-class))))
+
+(with-test (:name :bug-936513)
+  ;; This used to fail as ENSURE-GENERIC-FUNCTION wanted a list specifying
+  ;; the method combination, and didn't accept the actual object
+  (let ((mc (sb-pcl:find-method-combination #'make-instance 'standard nil)))
+    (ensure-generic-function 'make-instance :method-combination mc))
+  ;; Let's make sure the list works too...
+  (ensure-generic-function 'make-instance :method-combination '(standard)))
-- 
1.7.10.4