r9243: add :target-slot support

diff --git a/tests/test-fddl.lisp b/tests/test-fddl.lisp
index 4315f88ae19a3fade918ae0a08d9b838537aa55c..e84bdad2b1fade6c49a95116deb7f7ac2d44876a 100644 (file)
--- a/tests/test-fddl.lisp
+++ b/tests/test-fddl.lisp
@@ -28,7 +28,7 @@
            (sort (mapcar #'string-downcase
                          (clsql:list-tables :owner *test-database-user*))
                  #'string<))
-  "address" "company" "employee" "type_table")
+  "address" "company" "employee" "employee_address" "type_table")
 
 ;; create a table, test for its existence, drop it and test again 
 (deftest :fddl/table/2

diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp
index 1134c913193a35001b362ae711ad12d6c791186c..380710491473a926f1198e0455bb921c36d3afdd 100644 (file)
--- a/tests/test-fdml.lisp
+++ b/tests/test-fdml.lisp
@@ -289,14 +289,14 @@
 
 (deftest :fdml/select/15
     (multiple-value-bind (rows field-names)
-       (clsql:select [emplid] [street-number] [street-name] [city_field] [zip] 
+       (clsql:select [addressid] [street-number] [street-name] [city_field] [zip] 
         :from [address]
-        :where [= 1 [emplid]])
+        :where [= 1 [addressid]])
       (values
        rows
        (mapcar #'string-downcase field-names)))
   ((1 10 "Park Place" "Leningrad" 123))
-  ("emplid" "street_number" "street_name" "city_field" "zip"))
+  ("addressid" "street_number" "street_name" "city_field" "zip"))
 
 (deftest :fdml/select/16
     (clsql:select [emplid] :from [employee] :where [= 1 [emplid]]
@@ -352,17 +352,17 @@
    "Josef Stalin" "Leon Trotsky" "Boris Yeltsin"))
 
 (deftest :fdml/loop/2
-    (loop for (emplid)
+    (loop for (addressid)
       being each tuple in
-      [select [emplid] :from [address] :order-by [emplid]]
-     collect emplid)
+      [select [addressid] :from [address] :order-by [addressid]]
+     collect addressid)
   (1 2))
 
 (deftest :fdml/loop/3
-    (loop for emplid
+    (loop for addressid
       being each tuple in
-      [select [emplid] :from [address] :order-by [emplid]]
-      collect emplid)
+      [select [addressid] :from [address] :order-by [addressid]]
+      collect addressid)
   (1 2))
 
 ;; starts a transaction deletes a record and then rolls back the deletion 

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index 489b4875dbc07ab4e2205f8c5f946330cd192fdc..f4268d7f32326713a81a4d14844057c238e43ec1 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -65,7 +65,8 @@
     :type (string 100)
     :initarg :email)
    (companyid
-    :type integer)
+    :type integer
+    :initarg :companyid)
    (company
     :accessor employee-company
     :db-kind :join
@@ -74,14 +75,23 @@
                          :foreign-key companyid
                          :set nil))
    (managerid
-    :type integer)
+    :type integer
+    :initarg :managerid)
    (manager
     :accessor employee-manager
     :db-kind :join
     :db-info (:join-class employee
                          :home-key managerid
                          :foreign-key emplid
-                         :set nil)))
+                         :set nil))
+   (addresses
+    :accessor employee-addresses
+    :db-kind :join
+    :db-info (:join-class employee-address
+                         :home-key emplid
+                         :foreign-key emplid
+                         :target-slot address
+                         :set t)))
   (:base-table employee))
 
 (def-view-class company ()
@@ -99,7 +109,8 @@
     :type (string 100)
     :initarg :name)
    (presidentid
-    :type integer)
+    :type integer
+    :initarg :presidentid)
    (president
     :reader president
     :db-kind :join
@@ -118,11 +129,11 @@
 
 
 (def-view-class address ()
-  ((emplid
+  ((addressid
     :db-kind :key
     :db-constraints :not-null
     :type integer
-    :initarg :emplid)
+    :initarg :addressid)
    (street-number
     :type integer
     :initarg :street-number)
@@ -141,6 +152,18 @@
     :void-value 0
     :initarg :postal-code)))
 
+;; many employees can reside at many addressess
+(def-view-class employee-address ()
+  ((emplid :type integer
+          :initarg :emplid)
+   (addressid :type integer
+             :initarg :addressid)
+   (address :db-kind :join
+           :db-info (:join-class address
+                                 :home-key addressid
+                                 :foreign-key addressid
+                                 :retrieval :immediate))))
+
 (defun test-connect-to-database (db-type spec)
   (when (db-backend-has-create/destroy-db? db-type)
     (ignore-errors (destroy-database spec :database-type db-type))
@@ -177,6 +200,11 @@
 (defparameter employee10 nil)
 (defparameter address1 nil)
 (defparameter address2 nil)
+(defparameter employee-address1 nil)
+(defparameter employee-address2 nil)
+(defparameter employee-address3 nil)
+(defparameter employee-address4 nil)
+(defparameter employee-address5 nil)
 
 (defun test-initialise-database ()
   (test-basic-initialize)
@@ -187,118 +215,153 @@
           :warn)))
     (clsql:create-view-from-class 'employee)
     (clsql:create-view-from-class 'company)
-    (clsql:create-view-from-class 'address))
-
-  (setf company1 (make-instance 'company
-                  :companyid 1
-                  :groupid 1
-                  :name "Widgets Inc.")
-       employee1 (make-instance 'employee
-                   :emplid 1
-                   :groupid 1
-                   :married t 
-                   :height (1+ (random 1.00))
-                   :birthday (clsql-base:get-time)
-                   :first-name "Vladamir"
-                   :last-name "Lenin"
-                   :email "lenin@soviet.org")
-       employee2 (make-instance 'employee
-                   :emplid 2
-                   :groupid 1
-                   :height (1+ (random 1.00))
-                   :married t 
-                   :birthday (clsql-base:get-time)
-                   :first-name "Josef"
-                   :last-name "Stalin"
-                   :email "stalin@soviet.org")
-       employee3 (make-instance 'employee
-                   :emplid 3
-                   :groupid 1
-                   :height (1+ (random 1.00))
-                   :married t 
-                   :birthday (clsql-base:get-time)
-                   :first-name "Leon"
-                   :last-name "Trotsky"
-                   :email "trotsky@soviet.org")
-       employee4 (make-instance 'employee
-                   :emplid 4
-                   :groupid 1
-                   :height (1+ (random 1.00))
-                   :married nil
-                   :birthday (clsql-base:get-time)
-                   :first-name "Nikita"
-                   :last-name "Kruschev"
-                   :email "kruschev@soviet.org")
-       
-       employee5 (make-instance 'employee
-                   :emplid 5
-                   :groupid 1
-                   :married nil
-                   :height (1+ (random 1.00))
-                   :birthday (clsql-base:get-time)
-                   :first-name "Leonid"
-                   :last-name "Brezhnev"
-                   :email "brezhnev@soviet.org")
-
-       employee6 (make-instance 'employee
-                   :emplid 6
-                   :groupid 1
-                   :married nil
-                   :height (1+ (random 1.00))
-                   :birthday (clsql-base:get-time)
-                   :first-name "Yuri"
-                   :last-name "Andropov"
-                   :email "andropov@soviet.org")
-       employee7 (make-instance 'employee
-                   :emplid 7
-                   :groupid 1
-                   :height (1+ (random 1.00))
-                   :married nil
-                   :birthday (clsql-base:get-time)
-                   :first-name "Konstantin"
-                   :last-name "Chernenko"
-                   :email "chernenko@soviet.org")
-       employee8 (make-instance 'employee
-                   :emplid 8
-                   :groupid 1
-                   :height (1+ (random 1.00))
-                   :married nil
-                   :birthday (clsql-base:get-time)
-                   :first-name "Mikhail"
-                   :last-name "Gorbachev"
-                   :email "gorbachev@soviet.org")
-       employee9 (make-instance 'employee
-                   :emplid 9
-                   :groupid 1 
-                   :married nil
-                   :height (1+ (random 1.00))
-                   :birthday (clsql-base:get-time)
-                   :first-name "Boris"
-                   :last-name "Yeltsin"
-                   :email "yeltsin@soviet.org")
-       employee10 (make-instance 'employee
-                    :emplid 10
-                    :groupid 1
-                    :married nil
-                    :height (1+ (random 1.00))
-                    :birthday (clsql-base:get-time)
-                    :first-name "Vladamir"
-                    :last-name "Putin"
-                    :email "putin@soviet.org")
-
-       address1 (make-instance 'address
-                               :emplid 1
-                               :street-number 10
-                               :street-name "Park Place"
-                               :city "Leningrad"
-                               :postal-code 123)
+    (clsql:create-view-from-class 'address)
+    (clsql:create-view-from-class 'employee-address))
 
-       address2 (make-instance 'address
-                               :emplid 2))
-  
+  (let ((*update-records-on-make-instance* t))
+    (setf company1 (make-instance 'company
+                                 :presidentid 1
+                                 :companyid 1
+                                 :groupid 1
+                                 :name "Widgets Inc.")
+         employee1 (make-instance 'employee
+                                  :emplid 1
+                                  :groupid 1
+                                  :married t 
+                                  :height (1+ (random 1.00))
+                                  :birthday (clsql-base:get-time)
+                                  :first-name "Vladamir"
+                                  :last-name "Lenin"
+                                  :email "lenin@soviet.org"
+                                  :companyid 1)
+         employee2 (make-instance 'employee
+                                  :emplid 2
+                                  :groupid 1
+                                  :height (1+ (random 1.00))
+                                  :married t 
+                                  :birthday (clsql-base:get-time)
+                                  :first-name "Josef"
+                                  :last-name "Stalin"
+                                  :email "stalin@soviet.org"
+                                  :managerid 1
+                                  :companyid 1)
+         employee3 (make-instance 'employee
+                                  :emplid 3
+                                  :groupid 1
+                                  :height (1+ (random 1.00))
+                                  :married t 
+                                  :birthday (clsql-base:get-time)
+                                  :first-name "Leon"
+                                  :last-name "Trotsky"
+                                  :email "trotsky@soviet.org"
+                                  :managerid 1
+                                  :companyid 1)
+         employee4 (make-instance 'employee
+                                  :emplid 4
+                                  :groupid 1
+                                  :height (1+ (random 1.00))
+                                  :married nil
+                                  :birthday (clsql-base:get-time)
+                                  :first-name "Nikita"
+                                  :last-name "Kruschev"
+                                  :email "kruschev@soviet.org"
+                                  :managerid 1
+                                  :companyid 1)
+         employee5 (make-instance 'employee
+                                  :emplid 5
+                                  :groupid 1
+                                  :married nil
+                                  :height (1+ (random 1.00))
+                                  :birthday (clsql-base:get-time)
+                                  :first-name "Leonid"
+                                  :last-name "Brezhnev"
+                                  :email "brezhnev@soviet.org"
+                                  :managerid 1
+                                  :companyid 1)
+         employee6 (make-instance 'employee
+                                  :emplid 6
+                                  :groupid 1
+                                  :married nil
+                                  :height (1+ (random 1.00))
+                                  :birthday (clsql-base:get-time)
+                                  :first-name "Yuri"
+                                  :last-name "Andropov"
+                                  :email "andropov@soviet.org"
+                                  :managerid 1
+                                  :companyid 1)
+         employee7 (make-instance 'employee
+                                  :emplid 7
+                                  :groupid 1
+                                  :height (1+ (random 1.00))
+                                  :married nil
+                                  :birthday (clsql-base:get-time)
+                                  :first-name "Konstantin"
+                                  :last-name "Chernenko"
+                                  :email "chernenko@soviet.org"
+                                  :managerid 1
+                                  :companyid 1)
+         employee8 (make-instance 'employee
+                                  :emplid 8
+                                  :groupid 1
+                                  :height (1+ (random 1.00))
+                                  :married nil
+                                  :birthday (clsql-base:get-time)
+                                  :first-name "Mikhail"
+                                  :last-name "Gorbachev"
+                                  :email "gorbachev@soviet.org"
+                                  :managerid 1
+                                  :companyid 1)
+         employee9 (make-instance 'employee
+                                  :emplid 9
+                                  :groupid 1 
+                                  :married nil
+                                  :height (1+ (random 1.00))
+                                  :birthday (clsql-base:get-time)
+                                  :first-name "Boris"
+                                  :last-name "Yeltsin"
+                                  :email "yeltsin@soviet.org"
+                                  :managerid 1
+                                  :companyid 1)
+         employee10 (make-instance 'employee
+                                   :emplid 10
+                                   :groupid 1
+                                   :married nil
+                                   :height (1+ (random 1.00))
+                                   :birthday (clsql-base:get-time)
+                                   :first-name "Vladamir"
+                                   :last-name "Putin"
+                                   :email "putin@soviet.org"
+                                   :managerid 1
+                                   :companyid 1)
+         address1 (make-instance 'address
+                                 :addressid 1
+                                 :street-number 10
+                                 :street-name "Park Place"
+                                 :city "Leningrad"
+                                 :postal-code 123)
+         address2 (make-instance 'address
+                                 :addressid 2)
+         employee-address1 (make-instance 'employee-address
+                                          :emplid 1
+                                          :addressid 1)
+         employee-address2 (make-instance 'employee-address
+                                          :emplid 2
+                                          :addressid 2)
+         employee-address3 (make-instance 'employee-address
+                                          :emplid 3
+                                          :addressid 1)
+         employee-address4 (make-instance 'employee-address
+                                          :emplid 1
+                                          :addressid 2)
+         employee-address5 (make-instance 'employee-address
+                                          :emplid 3
+                                          :addressid 2)
+         ))
+    
   ;; sleep to ensure birthdays are no longer at current time
-  (sleep 2) 
-
+  (sleep 1) 
+  
+  #||
   ;; Lenin manages everyone
   (clsql:add-to-relation employee2 'manager employee1)
   (clsql:add-to-relation employee3 'manager employee1)
@@ -322,7 +385,10 @@
   (clsql:add-to-relation company1 'employees employee10)
   ;; Lenin is president of Widgets Inc.
   (clsql:add-to-relation company1 'president employee1)
-  ;; store these instances 
+  ||#
+  
+  ;; store these instances
+  #||
   (clsql:update-records-from-instance employee1)
   (clsql:update-records-from-instance employee2)
   (clsql:update-records-from-instance employee3)
@@ -335,7 +401,9 @@
   (clsql:update-records-from-instance employee10)
   (clsql:update-records-from-instance company1)
   (clsql:update-records-from-instance address1)
-  (clsql:update-records-from-instance address2))
+  (clsql:update-records-from-instance address2)
+  ||#
+  )
 
 (defvar *error-count* 0)
 (defvar *error-list* nil)

diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp
index 39d7eea3f5e40fdb9d80c8eed5801805146e087b..7e69d6e3c51b84b30f60fdd36de15ffe3fe72f6f 100644 (file)
--- a/tests/test-oodml.lisp
+++ b/tests/test-oodml.lisp
@@ -59,7 +59,7 @@
   3)
 
 (deftest :oodml/select/6
-    (let ((a (caar (clsql:select 'address :where [= 1 [emplid]]))))
+    (let ((a (caar (clsql:select 'address :where [= 1 [addressid]]))))
       (values
        (slot-value a 'street-number)
        (slot-value a 'street-name)
@@ -68,7 +68,7 @@
   10 "Park Place" "Leningrad" 123)
 
 (deftest :oodml/select/7
-    (let ((a (caar (clsql:select 'address :where [= 2 [emplid]]))))
+    (let ((a (caar (clsql:select 'address :where [= 2 [addressid]]))))
       (values
        (slot-value a 'street-number)
        (slot-value a 'street-name)
@@ -81,6 +81,27 @@
               (clsql:select 'employee :flatp t :order-by [emplid]))
   (t t t nil nil nil nil nil nil nil))
 
+(deftest :oodml/select/9
+    (mapcar #'(lambda (pair)
+               (list
+                (typep (car pair) 'address)
+                (typep (cdr pair) 'employee-address)
+                (slot-value (car pair) 'addressid)
+                (slot-value (cdr pair) 'addressid)))
+     (employee-addresses employee1))
+  ((t t 1 1) (t t 2 2)))
+
+(deftest :oodml/select/10
+    (mapcar #'(lambda (pair)
+               (list
+                (typep (car pair) 'address)
+                (typep (cdr pair) 'employee-address)
+                (slot-value (car pair) 'addressid)
+                (slot-value (cdr pair) 'addressid)))
+     (employee-addresses employee2))
+  ((t t 2 2)))
+
+
 ;; tests update-records-from-instance 
 (deftest :oodml/update-records/1
     (values