r9804: * doc/ref-ooddl.xml: minor changes to syntax and examples entries
[clsql.git] / tests / test-oodml.lisp
index b3ceddee747d5783265dbc9aa4871887c06ae9f6..58de7289d77b8600b230e56b1275b1da6acca9f6 100644 (file)
        
        (deftest :oodml/select/1
            (mapcar #'(lambda (e) (slot-value e 'last-name))
-            (clsql:select 'employee :order-by [last-name] :flatp t))
+            (clsql:select 'employee :order-by [last-name] :flatp t :caching nil))
          ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
           "Stalin" "Trotsky" "Yeltsin"))
 
        (deftest :oodml/select/2
            (mapcar #'(lambda (e) (slot-value e 'name))
-            (clsql:select 'company :flatp t))
+            (clsql:select 'company :flatp t :caching nil))
          ("Widgets Inc."))
 
        (deftest :oodml/select/3
@@ -40,7 +40,8 @@
                                          [slot-value 'company 'companyid]]
                                       [= [slot-value 'company 'name]
                                          "Widgets Inc."]]
-                          :flatp t))
+                          :flatp t
+                          :caching nil))
          (1 1 1 1 1 1 1 1 1 1))
 
        (deftest :oodml/select/4
             (clsql:select 'employee :where [= [slot-value 'employee 'first-name]
                                               "Vladamir"]
                           :flatp t                  
-                          :order-by [last-name]))
+                          :order-by [last-name]
+                          :caching nil))
          ("Vladamir Lenin" "Vladamir Putin"))
 
        (deftest :oodml/select/5
-           (length (clsql:select 'employee :where [married] :flatp t))
+           (length (clsql:select 'employee :where [married] :flatp t :caching nil))
          3)
 
        (deftest :oodml/select/6
-           (let ((a (caar (clsql:select 'address :where [= 1 [addressid]]))))
+           (let ((a (caar (clsql:select 'address :where [= 1 [addressid]] :caching nil))))
              (values
               (slot-value a 'street-number)
               (slot-value a 'street-name)
@@ -68,7 +70,7 @@
          10 "Park Place" "Leningrad" 123)
 
        (deftest :oodml/select/7
-           (let ((a (caar (clsql:select 'address :where [= 2 [addressid]]))))
+           (let ((a (caar (clsql:select 'address :where [= 2 [addressid]] :caching nil))))
              (values
               (slot-value a 'street-number)
               (slot-value a 'street-name)
@@ -78,7 +80,7 @@
 
        (deftest :oodml/select/8 
            (mapcar #'(lambda (e) (slot-value e 'married)) 
-            (clsql:select 'employee :flatp t :order-by [emplid]))
+            (clsql:select 'employee :flatp t :order-by [emplid] :caching nil))
          (t t t nil nil nil nil nil nil nil))
 
        (deftest :oodml/select/9
             (employee-addresses employee2))
          ((t t 2 2 2)))
 
-       ;; :retrieval :immediate should be boundp before accessed
+        (deftest :oodml/select/11 
+         (values (mapcar #'(lambda (x) (slot-value x 'emplid))
+                         (clsql:select 'employee :order-by '(([emplid] :asc)) 
+                                       :flatp t))
+          (mapcar #'(lambda (x) (slot-value x 'emplid))
+          (clsql:select 'employee :order-by '(([emplid] :desc)) 
+                        :flatp t)))
+         (1 2 3 4 5 6 7 8 9 10)
+         (10 9 8 7 6 5 4 3 2 1))
+
+       ;; test retrieval is deferred
        (deftest :oodm/retrieval/1
-           (mapcar #'(lambda (ea) (slot-boundp ea 'address))
-            (select 'employee-address :flatp t))
-         (t t t t t))
+           (every #'(lambda (e) (not (slot-boundp e 'company)))
+            (select 'employee :flatp t :caching nil))
+         t)
 
        (deftest :oodm/retrieval/2
+           (every #'(lambda (e) (not (slot-boundp e 'address)))
+            (select 'deferred-employee-address :flatp t :caching nil))
+         t)
+
+       ;; :retrieval :immediate should be boundp before accessed
+       (deftest :oodm/retrieval/3
+           (every #'(lambda (ea) (slot-boundp ea 'address))
+            (select 'employee-address :flatp t :caching nil))
+         t)
+
+       (deftest :oodm/retrieval/4
            (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
-            (select 'employee-address :flatp t))
+            (select 'employee-address :flatp t :caching nil))
          (t t t t t))
 
+       (deftest :oodm/retrieval/5
+           (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
+            (select 'deferred-employee-address :flatp t :caching nil))
+         (t t t t t))
+
+       (deftest :oodm/retrieval/6
+           (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
+            (select 'employee-address :flatp t :caching nil))
+         t)
+
+       (deftest :oodm/retrieval/7
+           (every #'(lambda (ea) (slot-boundp (slot-value ea 'address) 'addressid))
+            (select 'deferred-employee-address :flatp t :caching nil))
+         t)
+
+       (deftest :oodm/retrieval/8          
+           (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
+            (select 'employee-address :flatp t :order-by [aaddressid] :caching nil))
+         (10 10 nil nil nil))
+
+       (deftest :oodm/retrieval/9
+           (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
+            (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil))
+         (10 10 nil nil nil))
+
        ;; tests update-records-from-instance 
        (deftest :oodml/update-records/1
            (values
               (let ((lenin (car (clsql:select 'employee
                                               :where [= [slot-value 'employee 'emplid]
                                                         1]
-                                              :flatp t))))
+                                              :flatp t
+                                              :caching nil))))
                 (concatenate 'string
                              (first-name lenin)
                              " "
               (let ((lenin (car (clsql:select 'employee
                                               :where [= [slot-value 'employee 'emplid]
                                                         1]
-                                              :flatp t))))
+                                              :flatp t
+                                              :caching nil))))
                 (concatenate 'string
                              (first-name lenin)
                              " "
               (let ((lenin (car (clsql:select 'employee
                                               :where [= [slot-value 'employee 'emplid]
                                                         1]
-                                              :flatp t))))
+                                              :flatp t
+                                              :caching nil))))
                 (concatenate 'string
                              (first-name lenin)
                              " "
             (employee-email
              (car (clsql:select 'employee
                                 :where [= [slot-value 'employee 'emplid] 1]
-                                :flatp t)))
+                                :flatp t
+                                :caching nil)))
             (progn
               (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
               (clsql:update-record-from-slot employee1 'email)
               (employee-email
                (car (clsql:select 'employee
                                   :where [= [slot-value 'employee 'emplid] 1]
-                                  :flatp t))))
+                                  :flatp t
+                                  :caching nil))))
             (progn 
               (setf (slot-value employee1 'email) "lenin@soviet.org")
               (clsql:update-record-from-slot employee1 'email)
               (employee-email
                (car (clsql:select 'employee
                                   :where [= [slot-value 'employee 'emplid] 1]
-                                  :flatp t)))))
+                                  :flatp t
+                                  :caching nil)))))
          "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
 
        ;; tests update-record-from-slots
             (let ((lenin (car (clsql:select 'employee
                                             :where [= [slot-value 'employee 'emplid]
                                                       1]
-                                            :flatp t))))
+                                            :flatp t
+                                            :caching nil))))
               (concatenate 'string
                            (first-name lenin)
                            " "
               (let ((lenin (car (clsql:select 'employee
                                               :where [= [slot-value 'employee 'emplid]
                                                         1]
-                                              :flatp t))))
+                                              :flatp t
+                                              :caching nil))))
                 (concatenate 'string
                              (first-name lenin)
                              " "
               (let ((lenin (car (clsql:select 'employee
                                               :where [= [slot-value 'employee 'emplid]
                                                         1]
-                                              :flatp t))))
+                                              :flatp t
+                                              :caching nil))))
                 (concatenate 'string
                              (first-name lenin)
                              " "
             collect (slot-value e 'last-name))
          ("Lenin" "Stalin" "Trotsky"))
 
+
+      (deftest :oodml/cache/1
+         (progn
+           (setf (clsql-sys:record-caches *default-database*) nil)
+           (let ((employees (select 'employee)))
+             (every #'(lambda (a b) (eq a b))
+                    employees (select 'employee))))
+       t)
+
+       (deftest :oodml/cache/2
+           (let ((employees (select 'employee)))
+             (equal employees (select 'employee :flatp t)))
+         nil)
+       
+       (deftest :oodml/refresh/1
+           (let ((addresses (select 'address)))
+             (equal addresses (select 'address :refresh t)))
+         t)
+
+       (deftest :oodml/refresh/2
+           (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
+                  (city (slot-value (car addresses) 'city)))
+             (clsql:update-records [addr] 
+                              :av-pairs '((city_field "A new city"))
+                              :where [= [addressid] (slot-value (car addresses) 'addressid)])
+             (let* ((new-addresses (select 'address :order-by [addressid] :refresh t :flatp t))
+                    (new-city (slot-value (car addresses) 'city))
+)
+               (clsql:update-records [addr] 
+                                     :av-pairs `((city_field ,city))
+                                     :where [= [addressid] (slot-value (car addresses) 'addressid)])
+               (values (equal addresses new-addresses)
+                       city
+                       new-city)))
+         t "Leningrad" "A new city")
+       
+       (deftest :oodml/refresh/3
+           (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
+             (values
+              (equal addresses (select 'address :refresh t :flatp t))
+              (equal addresses (select 'address :flatp t))))
+         nil nil)
+       
+       (deftest :oodml/refresh/4
+           (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
+                  (*db-auto-sync* t))
+             (make-instance 'address :addressid 1000 :city "A new address city")
+             (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
+               (delete-records :from [addr] :where [= [addressid] 1000]) 
+               (values
+                (length addresses)
+                (length new-addresses)
+                (eq (first addresses) (first new-addresses))
+                (eq (second addresses) (second new-addresses)))))
+         2 3 t t)
+               
+             
+       (deftest :oodml/uoj/1
+           (progn
+             (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by [ea_join aaddressid]
+                                      :flatp t))
+                    (dea-list-copy (copy-seq dea-list))
+                    (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
+               (update-objects-joins dea-list)
+               (values
+                initially-unbound
+                (equal dea-list dea-list-copy)
+                (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
+                (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
+                (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list))))
+         t t t t (1 1 2 2 2))
+       
+       (deftest :oodml/big/1 
+           (let ((objs (clsql:select 'big :order-by [i] :flatp t)))
+             (values
+              (length objs)
+              (do ((i 0 (1+ i))
+                   (max (expt 2 60))
+                   (rest objs (cdr rest)))
+                  ((= i (length objs)) t)
+                (let ((obj (car rest))
+                      (index (1+ i)))
+                  (unless (and (eql (slot-value obj 'i) index)
+                               (eql (slot-value obj 'bi) (truncate max index)))
+                    (print index)
+                    (describe obj)
+                    (return nil))))))
+         555 t)
+
+        (deftest :oodml/db-auto-sync/1 
+            (values
+              (progn 
+                (make-instance 'employee :emplid 20 :groupid 1 
+                               :last-name "Ivanovich")
+                (select [last-name] :from [employee] :where [= [emplid] 20]
+                        :flatp t :field-names nil))
+             (let ((*db-auto-sync* t))
+               (make-instance 'employee :emplid 20 :groupid 1 
+                              :last-name "Ivanovich")
+               (prog1 (select [last-name] :from [employee] :flatp t
+                              :field-names nil 
+                              :where [= [emplid] 20])
+                 (delete-records :from [employee] :where [= [emplid] 20]))))
+          nil ("Ivanovich"))
+
+        (deftest :oodml/db-auto-sync/2
+            (values
+             (let ((instance (make-instance 'employee :emplid 20 :groupid 1 
+                                            :last-name "Ivanovich")))
+               (setf (slot-value instance 'last-name) "Bulgakov")
+               (select [last-name] :from [employee] :where [= [emplid] 20]
+                       :flatp t :field-names nil))
+             (let* ((*db-auto-sync* t)
+                    (instance (make-instance 'employee :emplid 20 :groupid 1 
+                                             :last-name "Ivanovich")))
+               (setf (slot-value instance 'last-name) "Bulgakov")
+               (prog1 (select [last-name] :from [employee] :flatp t
+                              :field-names nil 
+                              :where [= [emplid] 20])
+                 (delete-records :from [employee] :where [= [emplid] 20]))))
+          nil ("Bulgakov"))
+       
+        (deftest :oodml/setf-slot-value/1 
+            (let* ((*db-auto-sync* t)
+                   (instance (make-instance 'employee :emplid 20 :groupid 1)))
+              (prog1 
+                  (setf 
+                   (slot-value instance 'first-name) "Mikhail"
+                   (slot-value instance 'last-name) "Bulgakov")
+                (delete-records :from [employee] :where [= [emplid] 20])))
+          "Bulgakov")
+
        ))
 
 #.(clsql:restore-sql-reader-syntax-state)