From 86e9b31ba3b0348f2cc5c816e80d9109e555be94 Mon Sep 17 00:00:00 2001 From: Kevin Rosenberg Date: Tue, 11 Dec 2007 18:17:43 -0700 Subject: [PATCH] * Version 4.0.3 * sql/metaclasses.lisp: Unify base-table processing by extracting the correct code from initialize-instance :around into the helper function set-view-table-slot. Call that function also in reinitialize-instance :around replacing erroneous code discovered by Josh Feinstein. --- ChangeLog | 8 ++++++++ debian/changelog | 12 ++++++++++++ sql/metaclasses.lisp | 22 ++++++++++------------ 3 files changed, 30 insertions(+), 12 deletions(-) diff --git a/ChangeLog b/ChangeLog index 30e440e..0762a7e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +11 Dec 2007 Kevin Rosenberg + * Version 4.0.3 + * sql/metaclasses.lisp: Unify base-table processing by extracting + the correct code from initialize-instance :around into the helper + function set-view-table-slot. Call that function also in + reinitialize-instance :around replacing erroneous code discovered + by Josh Feinstein. + 17 Nov 2007 Kevin Rosenberg * BUGS: Add note about benefit of using configure file to create Makefiles (suggestion from Joe Corneli) diff --git a/debian/changelog b/debian/changelog index f81654e..4bb803e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,15 @@ +cl-sql (4.0.3-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Tue, 11 Dec 2007 18:14:13 -0700 + +cl-sql (4.0.2-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Tue, 23 Oct 2007 08:01:21 -0600 + cl-sql (4.0.1-1) unstable; urgency=low * New upstream diff --git a/sql/metaclasses.lisp b/sql/metaclasses.lisp index bed60ee..2a0b4b9 100644 --- a/sql/metaclasses.lisp +++ b/sql/metaclasses.lisp @@ -103,6 +103,14 @@ (pop-arg mylist)) newlist)) +(defun set-view-table-slot (class base-table) + (setf (view-table class) + (table-name-from-arg (or (and base-table + (if (listp base-table) + (car base-table) + base-table)) + (class-name class))))) + (defmethod initialize-instance :around ((class standard-db-class) &rest all-keys &key direct-superclasses base-table @@ -122,12 +130,7 @@ direct-superclasses) (remove-keyword-arg all-keys :direct-superclasses))) (call-next-method)) - (setf (view-table class) - (table-name-from-arg (or (and base-table - (if (listp base-table) - (car base-table) - base-table)) - (class-name class)))) + (set-view-table-slot class base-table) (register-metaclass class (nth (1+ (position :direct-slots all-keys)) all-keys)))) @@ -138,12 +141,7 @@ &allow-other-keys) (let ((root-class (find-class 'standard-db-object nil)) (vmc 'standard-db-class)) - (setf (view-table class) - (table-name-from-arg (sql-escape (or (and base-table - (if (listp base-table) - (car base-table) - base-table)) - (class-name class))))) + (set-view-table-slot class base-table) (setf (view-class-qualifier class) (car qualifier)) (if (and root-class (not (equal class root-class))) -- 2.11.4.GIT