Changeset 13939

Timestamp:

05/22/12 13:39:13 (12 years ago)

Author:

Mark Evenson

Message:

Fixes ticket #199: CL-METHOD failure for &AUX arguments.

DEFGENERIC specified with &AUX arguments now signals an error.

Removed badly conceived BUGS.AUX.1 test which blew up the stack due to
recursively referencing itself in the &AUX init form.

Location:

trunk/abcl

Files:

• src/org/armedbear/lisp/clos.lisp (modified) (2 diffs)
• test/lisp/abcl/bugs.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/clos.lisp

@@ -1404 +1404 @@
     (setf options (nreverse options)
           methods (nreverse methods))
+    ;;; Since DEFGENERIC currently shares its argument parsing with
+    ;;; DEFMETHOD, we perform this check here.
+    (when (find '&aux lambda-list)
+      (error 'program-error
+             :format-control "&AUX is not allowed in a generic function lambda list: ~S"
+             :format-arguments (list lambda-list)))
     `(prog1
        (%defgeneric
@@ -1982 +1988 @@
             (exact (null (intersection lambda-list
                                        '(&rest &optional &key
-                                         &allow-other-keys &aux)))))
-       (if exact
+                                         &allow-other-keys))))
+            (no-aux (null (some 
+                           (lambda (method) 
+                             (find '&aux (std-slot-value method 'sys::lambda-list)))
+                           (sys:%generic-function-methods gf)))))
+       (if (and exact
+                no-aux)
            (cond
              ((= number-required 1)

trunk/abcl/test/lisp/abcl/bugs.lisp

@@ -116 +116 @@
 
 ;;; http://trac.common-lisp.net/armedbear/ticket/199
-(deftest bugs.clos.aux.1 
-    ;;; XXX possible collision with previously defined names
-    (progn
-      (defclass room ()
-        ((decorators :reader room-decorators)))
-      (defgeneric decorators (room))
-      (defmethod decorators ((room room) 
-                             &aux (d (decorators room)))
-        d)
-      (decorators (make-instance 'room)))
-  t)
-
-(deftest bugs.aux.1
+(deftest bugs.clos.aux.1
     ((lambda (a &aux (b (+ a 1))) 
        b)