Changeset 13762 for trunk/abcl/src/org/armedbear/lisp/clos.lisp

Timestamp:

01/11/12 21:07:07 (11 years ago)

Author:

rschlatte

Message:

Fix short-method-combination object creation

... fixes a number of failing ANSI tests.

File:

• trunk/abcl/src/org/armedbear/lisp/clos.lisp (modified) (2 diffs)

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

@@ -838 +838 @@
 ;;; StandardClass.java, but we cannot use make-instance and slot-value
 ;;; yet.
-(defun make-short-method-combination (&key name documentation operator identity-with-one-argument)
-  (let ((instance (std-allocate-instance (find-class 'short-method-combination))))
-    (when name (setf (std-slot-value instance 'sys::name) name))
-    (when documentation
-      (setf (std-slot-value instance 'documentation) documentation))
-    (when operator (setf (std-slot-value instance 'operator) operator))
-    (when identity-with-one-argument
-      (setf (std-slot-value instance 'identity-with-one-argument)
-            identity-with-one-argument))
-    instance))
 
 (defun make-long-method-combination (&key name documentation lambda-list
@@ -934 +924 @@
           (getf (cddr whole) :operator name)))
     `(progn
-       (setf (get ',name 'method-combination-object)
-             (make-short-method-combination
-              :name ',name
-              :operator ',operator
-              :identity-with-one-argument ',identity-with-one-arg
-              :documentation ',documentation))
-       ',name)))
+       ;; Class short-method-combination is defined in StandardClass.java.
+       (let ((instance (std-allocate-instance
+                        (find-class 'short-method-combination))))
+         (setf (std-slot-value instance 'sys::name) ',name)
+         (setf (std-slot-value instance 'documentation) ',documentation)
+         (setf (std-slot-value instance 'operator) ',operator)
+         (setf (std-slot-value instance 'identity-with-one-argument)
+               ',identity-with-one-arg)
+         (setf (get ',name 'method-combination-object) instance)
+         ',name))))
 
 (defmacro define-method-combination (&whole form name &rest args)