X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Ftest-oodml.lisp;h=87d897fb4c743406a441f99687863daff2c68b17;hp=f934e5e7db407db244e5015e70ee38d84894dc42;hb=cc1360674fe8976074b6af9e5a9aab63cb078fc7;hpb=e34a3ace07250c5c55b3f6598459ef7b6d292bdb diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp index f934e5e..87d897f 100644 --- a/tests/test-oodml.lisp +++ b/tests/test-oodml.lisp @@ -50,11 +50,11 @@ " " (slot-value e 'last-name))) (clsql:select 'employee :where [= [slot-value 'employee 'first-name] - "Vladamir"] + "Vladimir"] :flatp t :order-by [last-name] :caching nil)) - ("Vladamir Lenin" "Vladamir Putin")) + ("Vladimir Lenin" "Vladimir Putin")) (deftest :oodml/select/5 (length (clsql:select 'employee :where [married] :flatp t :caching nil)) @@ -110,8 +110,8 @@ (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))) + (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)) @@ -194,7 +194,7 @@ ": " (employee-email lenin)))) (progn - (setf (slot-value employee1 'first-name) "Vladamir" + (setf (slot-value employee1 'first-name) "Vladimir" (slot-value employee1 'last-name) "Lenin" (slot-value employee1 'email) "lenin@soviet.org") (clsql:update-records-from-instance employee1) @@ -209,9 +209,9 @@ (last-name lenin) ": " (employee-email lenin))))) - "Vladamir Lenin: lenin@soviet.org" + "Vladimir Lenin: lenin@soviet.org" "Dimitriy Ivanovich: ivanovich@soviet.org" - "Vladamir Lenin: lenin@soviet.org") + "Vladimir Lenin: lenin@soviet.org") ;; tests update-record-from-slot (deftest :oodml/update-records/2 @@ -270,7 +270,7 @@ ": " (employee-email lenin)))) (progn - (setf (slot-value employee1 'first-name) "Vladamir" + (setf (slot-value employee1 'first-name) "Vladimir" (slot-value employee1 'last-name) "Lenin" (slot-value employee1 'email) "lenin@soviet.org") (clsql:update-record-from-slots employee1 '(first-name last-name email)) @@ -285,9 +285,9 @@ (last-name lenin) ": " (employee-email lenin))))) - "Vladamir Lenin: lenin@soviet.org" + "Vladimir Lenin: lenin@soviet.org" "Dimitriy Ivanovich: ivanovich@soviet.org" - "Vladamir Lenin: lenin@soviet.org") + "Vladimir Lenin: lenin@soviet.org") ;; tests update-instance-from-records (deftest :oodml/update-instance/1 @@ -313,7 +313,7 @@ (slot-value employee1 'email))) (progn (clsql:update-records [employee] - :av-pairs '(([first-name] "Vladamir") + :av-pairs '(([first-name] "Vladimir") ([last-name] "Lenin") ([email] "lenin@soviet.org")) :where [= [emplid] 1]) @@ -324,9 +324,9 @@ (slot-value employee1 'last-name) ": " (slot-value employee1 'email)))) - "Vladamir Lenin: lenin@soviet.org" + "Vladimir Lenin: lenin@soviet.org" "Ivan Petrov: petrov@soviet.org" - "Vladamir Lenin: lenin@soviet.org") + "Vladimir Lenin: lenin@soviet.org") ;; tests update-slot-from-record (deftest :oodml/update-instance/2 @@ -384,7 +384,7 @@ ("Lenin" "Stalin" "Trotsky")) - (deftest oodml/cache/1 + (deftest :oodml/cache/1 (progn (setf (clsql-sys:record-caches *default-database*) nil) (let ((employees (select 'employee))) @@ -392,18 +392,18 @@ employees (select 'employee)))) t) - (deftest oodml/cache/2 + (deftest :oodml/cache/2 (let ((employees (select 'employee))) (equal employees (select 'employee :flatp t))) nil) - (deftest oodml/refresh/1 + (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)) + (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")) @@ -419,15 +419,15 @@ new-city))) t "Leningrad" "A new city") - (deftest oodml/refresh/3 + (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)) + (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))) @@ -440,13 +440,13 @@ 2 3 t t) - (deftest oodml/uoj/1 + (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-object-joins dea-list) + (update-objects-joins dea-list) (values initially-unbound (equal dea-list dea-list-copy) @@ -454,5 +454,179 @@ (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)) + + ;; update-object-joins needs to be fixed for multiple keys + #+ignore + (deftest :oodml/uoj/2 + (progn + (clsql:update-objects-joins (list company1)) + (mapcar #'(lambda (e) + (slot-value e 'ecompanyid)) + (company-employees company1))) + (1 1 1 1 1 1 1 1 1 1)) + + (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") + + (deftest :oodml/float/1 + (let* ((emp1 (car (select 'employee + :where [= [slot-value 'employee 'emplid] + 1] + :flatp t + :caching nil))) + (height (slot-value emp1 'height))) + (prog1 + (progn + (setf (slot-value emp1 'height) 1.0E0) + (clsql:update-record-from-slot emp1 'height) + (= (car (clsql:select [height] :from [employee] + :where [= [emplid] 1] + :flatp t + :field-names nil)) + 1)) + (setf (slot-value emp1 'height) height) + (clsql:update-record-from-slot emp1 'height))) + t) + + (deftest :oodml/float/2 + (let* ((emp1 (car (select 'employee + :where [= [slot-value 'employee 'emplid] + 1] + :flatp t + :caching nil))) + (height (slot-value emp1 'height))) + (prog1 + (progn + (setf (slot-value emp1 'height) 1.0S0) + (clsql:update-record-from-slot emp1 'height) + (= (car (clsql:select [height] :from [employee] + :where [= [emplid] 1] + :flatp t + :field-names nil)) + 1)) + (setf (slot-value emp1 'height) height) + (clsql:update-record-from-slot emp1 'height))) + t) + + (deftest :oodml/float/3 + (let* ((emp1 (car (select 'employee + :where [= [slot-value 'employee 'emplid] + 1] + :flatp t + :caching nil))) + (height (slot-value emp1 'height))) + (prog1 + (progn + (setf (slot-value emp1 'height) 1.0F0) + (clsql:update-record-from-slot emp1 'height) + (= (car (clsql:select [height] :from [employee] + :where [= [emplid] 1] + :flatp t + :field-names nil)) + 1)) + (setf (slot-value emp1 'height) height) + (clsql:update-record-from-slot emp1 'height))) + t) + + (deftest :oodml/float/4 + (let* ((emp1 (car (select 'employee + :where [= [slot-value 'employee 'emplid] + 1] + :flatp t + :caching nil))) + (height (slot-value emp1 'height))) + (prog1 + (progn + (setf (slot-value emp1 'height) 1.0D0) + (clsql:update-record-from-slot emp1 'height) + (= (car (clsql:select [height] :from [employee] + :where [= [emplid] 1] + :flatp t + :field-names nil)) + 1)) + (setf (slot-value emp1 'height) height) + (clsql:update-record-from-slot emp1 'height))) + t) + + (deftest :oodml/float/5 + (let* ((emp1 (car (select 'employee + :where [= [slot-value 'employee 'emplid] + 1] + :flatp t + :caching nil))) + (height (slot-value emp1 'height))) + (prog1 + (progn + (setf (slot-value emp1 'height) 1.0L0) + (clsql:update-record-from-slot emp1 'height) + (= (car (clsql:select [height] :from [employee] + :where [= [emplid] 1] + :flatp t + :field-names nil)) + 1)) + (setf (slot-value emp1 'height) height) + (clsql:update-record-from-slot emp1 'height))) + t) + )) + + + #.(clsql:restore-sql-reader-syntax-state)