SBCL calculating key-slots and finalize-inheritance

Nathan Bird <[email protected]> Fri, 15 Jun 2007 16:20:25 -0400
Newsgroups gmane.lisp.clsql.devel
Message-ID <[email protected]>
This is a multi-part message in MIME format.
--------------050402030201060200040200
Content-Type: text/plain; charset=ISO-8859-1
Content-Transfer-Encoding: 7bit

I hit a weird bug the other day where compiling a file of a bunch of
def-view-class(es). The problem is that the key-slots slot on the
standard-db-class for some of the view-classes aren't being filled
properly.

Most of it works fine but there are several classes that have identical
column lists/slot definitions. These tables in the database were all
created via another macro elsewhere to hold similar but logically
distinct data. After compilation, the first one in the file has the
correct key-slots, but the rest are empty. Recompiling the file fills
the key-slots for all of them correctly, but putting the file in my .asd
twice didn't appear to be a good solution.

The solution I found (patch attached) is to do the same for SBCL as is
being done for allegro in this case: calculate the key-slots in
FINALIZE-INHERITANCE :AFTER. This makes some amount of sense, but I
don't know why it doesn't work from the INITIALIZE-INSTANCE :AROUND  so
this may still be missing something.

With this patch it works for me in sbcl 1.0.5 and 1.0.6.

Nathan Bird

--------------050402030201060200040200
Content-Type: text/plain;
 name="sbcl-finalize-inheritance.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="sbcl-finalize-inheritance.patch"

Thu Jun  7 17:00:09 EDT 2007  Nathan Bird <[email protected]>
  * Set the key-slots :after FINALIZE-INHERITANCE for sbcl
diff -rN -u old-clsql/sql/metaclasses.lisp new-clsql/sql/metaclasses.lisp
--- old-clsql/sql/metaclasses.lisp	2007-06-15 11:59:00.000000000 -0400
+++ new-clsql/sql/metaclasses.lisp	2007-06-15 11:59:00.000000000 -0400
@@ -192,13 +192,13 @@
       (setq all-slots (remove-if #'not-db-col all-slots))
       (setq all-slots (stable-sort all-slots #'string< :key #'car))
       (setf (object-definition class) all-slots))
-    #-allegro
+    #-(or sbcl allegro)
     (setf (key-slots class) (remove-if-not (lambda (slot)
 					     (eql (slot-value slot 'db-kind)
 						  :key))
 					   (ordered-class-slots class)))))
 
-#+allegro
+#+(or sbcl allegro)
 (defmethod finalize-inheritance :after ((class standard-db-class))
   (setf (key-slots class) (remove-if-not (lambda (slot)
 					   (eql (slot-value slot 'db-kind)


--------------050402030201060200040200
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

_______________________________________________
CLSQL-Devel mailing list
[email protected]
http://lists.b9.com/mailman/listinfo/clsql-devel

--------------050402030201060200040200--