Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 2929636)
Fix NO-APPLICABLE-METHOD.
authorStas Boukarev <stassats@gmail.com>
Sat, 22 Feb 2014 13:33:48 +0000 (17:33 +0400)
committerPhilipp Marek <philipp@marek.priv.at>
Sun, 23 Feb 2014 08:48:55 +0000 (09:48 +0100)
Its lambda-list should be (generic-function &rest function-arguments), not
(generic-function function-arguments).

Its value should be returned at the call site of the generic function.

Fixes #278.

src/c/clos/accessor.d patch | blob | blame | history
src/c/gfun.d patch | blob | blame | history
src/clos/fixup.lsp patch | blob | blame | history
src/clos/kernel.lsp patch | blob | blame | history

diff --git a/src/c/clos/accessor.d b/src/c/clos/accessor.d
index fff0d8d..afb34d4 100644 (file)
--- a/src/c/clos/accessor.d
+++ b/src/c/clos/accessor.d
@@ -22,7 +22,7 @@
 static void
 no_applicable_method(cl_env_ptr env, cl_object gfun, cl_object args)
 {
-       env->values[0] = _ecl_funcall3(@'no-applicable-method', gfun, args);
+       env->values[0] = cl_apply(3, @'no-applicable-method', gfun, args);
 }
 
 static cl_object
diff --git a/src/c/gfun.d b/src/c/gfun.d
index 6ed5754..165fb54 100644 (file)
--- a/src/c/gfun.d
+++ b/src/c/gfun.d
@@ -173,11 +173,8 @@ generic_compute_applicable_method(cl_env_ptr env, cl_object frame, cl_object gf)
                methods = _ecl_funcall3(@'compute-applicable-methods',
                                        gf, arglist);
                unlikely_if (methods == ECL_NIL) {
-                       cl_object func = _ecl_funcall3(@'no-applicable-method',
-                                                      gf, arglist);
-                       frame->frame.base[0] = OBJNULL;
-                       env->values[1] = ECL_NIL;
-                       return func;
+                        env->values[1] = ECL_NIL;
+                        return methods;
                }
        }
        methods = clos_compute_effective_method_function(gf, GFUN_COMB(gf), methods);
@@ -192,10 +189,8 @@ restricted_compute_applicable_method(cl_env_ptr env, cl_object frame, cl_object
        cl_object arglist = frame_to_list(frame);
        cl_object methods = clos_std_compute_applicable_methods(gf, arglist);
        unlikely_if (methods == ECL_NIL) {
-               cl_object func = _ecl_funcall3(@'no-applicable-method', gf, arglist);
-               frame->frame.base[0] = OBJNULL;
                env->values[1] = ECL_NIL;
-               return func;
+               return methods;
        }
        methods = clos_std_compute_effective_method(gf, GFUN_COMB(gf), methods);
        env->values[1] = ECL_T;
@@ -231,7 +226,7 @@ _ecl_standard_dispatch(cl_object frame, cl_object gf)
                 frame = new_frame;
        }
 #endif
-       
+
        vector = fill_spec_vector(cache->keys, frame, gf);
        e = ecl_search_cache(cache);
        if (e->key != OBJNULL) {
@@ -251,7 +246,11 @@ _ecl_standard_dispatch(cl_object frame, cl_object gf)
                        e->value = func;
                }
        }
-       func = _ecl_funcall3(func, frame, ECL_NIL);
+        if (func == ECL_NIL)
+                func = cl_apply(3, @'no-applicable-method', gf, frame);
+        else
+                func = _ecl_funcall3(func, frame, ECL_NIL);
+
        /* Only need to close the copy */
 #if !defined(ECL_USE_VARARG_AS_POINTER)
        if (frame == (cl_object)&frame_aux)
diff --git a/src/clos/fixup.lsp b/src/clos/fixup.lsp
index 31715f9..defa5f6 100644 (file)
--- a/src/clos/fixup.lsp
+++ b/src/clos/fixup.lsp
@@ -236,9 +236,10 @@ their lambda lists ~A and ~A are not congruent."
 ;;; ----------------------------------------------------------------------
 ;;; Error messages
 
-(defmethod no-applicable-method (gf args)
-  (error "No applicable method for ~S with arguments of types~{~& ~A~}" 
-        (generic-function-name gf)
+(defmethod no-applicable-method (gf &rest args)
+  (error "No applicable method for ~S with ~
+          ~:[no arguments~;arguments of types ~:*~{~& ~A~}~]."
+         (generic-function-name gf)
          (mapcar #'type-of args)))
 
 (defmethod no-next-method (gf method &rest args)
diff --git a/src/clos/kernel.lsp b/src/clos/kernel.lsp
index 2d4c6bc..08884e8 100644 (file)
--- a/src/clos/kernel.lsp
+++ b/src/clos/kernel.lsp
@@ -135,7 +135,7 @@
                  (setf method-list
                        (compute-applicable-methods generic-function args))
                  (unless method-list
-                   (no-applicable-methods generic-function args)))
+                   (apply #'no-applicable-method generic-function args)))
                (funcall (compute-effective-method-function
                          generic-function
                          (generic-function-method-combination generic-function)
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)