From 388e813f22e5443353299e4058b99747ccb42377 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 7 May 2004 06:15:59 +0000 Subject: [PATCH] r9280: sql/objects.lisp: more framework for supporing immediate retrieval --- ChangeLog | 9 +++++---- sql/objects.lisp | 15 +++++++++++++-- tests/test-oodml.lisp | 10 ++++++++-- 3 files changed, 26 insertions(+), 8 deletions(-) diff --git a/ChangeLog b/ChangeLog index a8ae5fe..eed07eb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,16 +1,17 @@ -7 May 2004 Kevin Rosenberg (kevin@rosenberg.net) +8 May 2004 Kevin Rosenberg (kevin@rosenberg.net) * tests/test-init.lisp: Add non-index fields for testing join class employee-addresss * test/test-oodml.lisp: Add tests for retrieval immediate - + * sql/metaclasses.lisp: Handle differences in direct-slot-definition + values which are now listifed by openmcl 14.2. + * sql/objects.lisp: more framework for supporing immediate retrieval + 7 May 2004 Kevin Rosenberg (kevin@rosenberg.net) * docs/intro.xml: Upload location of a README file * sql/metaclass.lisp: Work-around openmcl's CHANGE-CLASS changing the type-specifier. Use a lisp type of (OR NULL FOO) for a specified-type of FOO unless :db-constraints :not-null. No need to specialize finalize-inheritance for openmcl. - Handle differences in direct-slot-definition values which - are now listify by openmcl 14.2. * tests/test-*.lisp: Rename fields so that joins occur on fields with different names. This ensures that join code is selecting the proper name. diff --git a/sql/objects.lisp b/sql/objects.lisp index e0d2cef..0285ca4 100644 --- a/sql/objects.lisp +++ b/sql/objects.lisp @@ -234,12 +234,18 @@ superclass of the newly-defined View Class." sels (error "No slots of type :base in view-class ~A" (class-name vclass))))) +(defun generate-immediate-joins-list (vclass) + "Returns list of pairs of join slots and their class for a class." + (let ((sels nil)) + (dolist (slotdef (ordered-class-slots vclass)) + (when (and (eq :join (view-class-slot-db-kind slotdef)) + (eq :immediate (gethash :retrieval (view-class-slot-db-info slotdef)))) + (push slotdef sels))) + (cons vclass (list sels)))) -;; ;; Called by 'get-slot-values-from-view' ;; - (defvar *update-context* nil) (defmethod update-slot-from-db ((instance standard-db-object) slotdef value) @@ -854,6 +860,10 @@ superclass of the newly-defined View Class." (apply #'sql-and jc) jc)))))) +;; FIXME: add retrieval immediate for efficiency +;; For example, for (select 'employee-address) in test suite => +;; select addr.*,ea_join.* FROM addr,ea_join WHERE ea_join.aaddressid=addr.addressid\g + (defun find-all (view-classes &rest args &key all set-operation distinct from where group-by having @@ -897,6 +907,7 @@ superclass of the newly-defined View Class." objects)))) (let* ((*db-deserializing* t) (sclasses (mapcar #'find-class view-classes)) + (immediate-joins (mapcar #'generate-immediate-joins-list sclasses)) (sels (mapcar #'generate-selection-list sclasses)) (fullsels (apply #'append sels)) (sel-tables (collect-table-refs where)) diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp index b3cedde..88a7790 100644 --- a/tests/test-oodml.lisp +++ b/tests/test-oodml.lisp @@ -105,15 +105,21 @@ ;; :retrieval :immediate should be boundp before accessed (deftest :oodm/retrieval/1 - (mapcar #'(lambda (ea) (slot-boundp ea 'address)) + (every #'(lambda (ea) (slot-boundp ea 'address)) (select 'employee-address :flatp t)) - (t t t t t)) + t) (deftest :oodm/retrieval/2 (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address)) (select 'employee-address :flatp t)) (t t t t t)) + ;; test retrieval is deferred + (deftest :oodm/retrieval/3 + (every #'(lambda (e) (not (slot-boundp e 'company))) + (select 'employee :flatp t)) + t) + ;; tests update-records-from-instance (deftest :oodml/update-records/1 (values -- 2.34.1