[armedbear-cvs] r14446 - trunk/abcl/src/org/armedbear/lisp

[rschlatte at common-lisp.net]

Author: rschlatte
Date: Sun Mar 24 11:17:28 2013
New Revision: 14446

Log:
Fix %allocate-funcallable-instance for non-gf funcallable objects

- For subclasses of standard-generic-function, return a
  StandardGenericFunction object; otherwise, create a plain
  FuncallableStandardObject.

- Fixes crash while compiling cl-l10n

Modified:
   trunk/abcl/src/org/armedbear/lisp/FuncallableStandardObject.java

Modified: trunk/abcl/src/org/armedbear/lisp/FuncallableStandardObject.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/FuncallableStandardObject.java	Fri Mar 22 18:25:29 2013	(r14445)
+++ trunk/abcl/src/org/armedbear/lisp/FuncallableStandardObject.java	Sun Mar 24 11:17:28 2013	(r14446)
@@ -188,10 +188,11 @@
         if (! (l instanceof Layout)) {
           return error(new ProgramError("Invalid standard class layout for: " + arg.princToString()));
         }
-        // KLUDGE (rudi 2012-03-17): make (make-instance
-        // 'standard-generic-function) work -- subsequent code expects
-        // the additional slots to be present.
-        return new StandardGenericFunction((Layout)l);
+        if (Symbol.SUBTYPEP.execute(arg, StandardClass.STANDARD_GENERIC_FUNCTION) != NIL) {
+          return new StandardGenericFunction((Layout)l);
+        } else {
+          return new FuncallableStandardObject((Layout)l);
+        }
       }
       return type_error(arg, Symbol.FUNCALLABLE_STANDARD_CLASS);
     }