From 7898553d6a4db09ac85b887bca11b3734d58ea94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 4 Jan 2016 20:40:37 +0100 Subject: [PATCH] mop: fix bug in compute-applicable-methods-using-classes Move computation of args-specializers from #'sort-applicable-methods up to #'std-compute-applicable-methods. Fix suggested by @costanza. Fixes #203. --- src/clos/kernel.lsp | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/clos/kernel.lsp b/src/clos/kernel.lsp index ea0f2a03b..05dd119b9 100644 --- a/src/clos/kernel.lsp +++ b/src/clos/kernel.lsp @@ -221,7 +221,9 @@ ;;; 3. Subclasses of specified classes preserve the slot order in ECL. ;;; (defun std-compute-applicable-methods (gf args) - (sort-applicable-methods gf (applicable-method-list gf args) args)) + (sort-applicable-methods gf + (applicable-method-list gf args) + (mapcar #'class-of args))) (setf (fdefinition 'compute-applicable-methods) #'std-compute-applicable-methods) @@ -264,11 +266,10 @@ classes) t)))) -(defun sort-applicable-methods (gf applicable-list args) +(defun sort-applicable-methods (gf applicable-list args-specializers) (declare (optimize (safety 0) (speed 3))) (with-early-accessors (+standard-method-slots+ +standard-generic-function-slots+) - (let ((f (generic-function-a-p-o-function gf)) - (args-specializers (mapcar #'class-of args))) + (let ((f (generic-function-a-p-o-function gf))) ;; reorder args to match the precedence order (when f (setf args-specializers