X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Ftest-oodml.lisp;h=6278d73cd64e40f78bd2ef415072328127a3b69f;hp=2fed92172ac1dd7f8f0eabf17ba531e1fbabe8f1;hb=f2e97f7b39c1cf82b6f3d1cec9362e551761549e;hpb=052344686f925a617f74fcd1b83489f2edcf071a diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp index 2fed921..6278d73 100644 --- a/tests/test-oodml.lisp +++ b/tests/test-oodml.lisp @@ -15,11 +15,65 @@ (in-package #:clsql-tests) -#.(clsql:locally-enable-sql-reader-syntax) +(clsql-sys:file-enable-sql-reader-syntax) + +(defmacro has-sql-value-conversion-error (() &body body) + `(let (*debugger-hook*) + (handler-case + (progn ,@body nil) + (clsql-sys::sql-value-conversion-error (c) + (declare (ignore c)) + t)))) (setq *rt-oodml* '( +(deftest :oodml/read-symbol-value/1-into-this-package + (clsql-sys::read-sql-value + (clsql-sys::database-output-sql-as-type 'symbol 'clsql-tests::foo nil nil) + 'symbol nil nil) + clsql-tests::foo) + +(deftest :oodml/read-symbol-value/2-into-another-pacakge + (clsql-sys::read-sql-value + (clsql-sys::database-output-sql-as-type 'symbol 'clsql-sys::foo nil nil) + 'symbol nil nil) + clsql-sys::foo) + +(deftest :oodml/read-symbol-value/3-keyword + (clsql-sys::read-sql-value + (clsql-sys::database-output-sql-as-type 'keyword ':foo nil nil) + 'keyword nil nil) + :foo) + +(deftest :oodml/read-symbol-value/4-keyword-error + (has-sql-value-conversion-error () + (clsql-sys::read-sql-value + (clsql-sys::database-output-sql-as-type 'keyword 'foo nil nil) + 'keyword nil nil)) + T) + +(deftest :oodml/read-symbol-value/5-unknown-type-error-1 + (has-sql-value-conversion-error () + (clsql-sys::read-sql-value + (clsql-sys::database-output-sql-as-type 'bloop 'foo nil nil) + 'bloop nil nil)) + t) + +(deftest :oodml/read-symbol-value/6-unknown-type-error-2 + (has-sql-value-conversion-error () + (clsql-sys::read-sql-value + (clsql-sys::database-output-sql-as-type 'bloop 'foo nil nil) + '(or integer float) nil nil)) + t) + +(deftest :oodml/read-symbol-value/read-list + (clsql-sys::read-sql-value + (clsql-sys::database-output-sql-as-type + 'list '(("status" "new" "open")) nil nil) + 'list nil nil) + (("status" "new" "open"))) + (deftest :oodml/select/1 (with-dataset *ds-employees* (mapcar #'(lambda (e) (slot-value e 'last-name)) @@ -127,7 +181,7 @@ ;; test retrieval of node, derived nodes etc (deftest :oodml/select/12 (with-dataset *ds-nodes* - (length (clsql:select 'node :where [node-id] :flatp t :caching nil))) + (length (clsql:select 'node :where [not [null [node-id]]] :flatp t :caching nil))) 11) (deftest :oodml/select/13 @@ -140,7 +194,7 @@ (deftest :oodml/select/14 (with-dataset *ds-nodes* - (length (clsql:select 'setting :where [setting-id] :flatp t :caching nil))) + (length (clsql:select 'setting :where [not [null [setting-id]]] :flatp t :caching nil))) 4) (deftest :oodml/select/15 @@ -155,7 +209,7 @@ (deftest :oodml/select/16 (with-dataset *ds-nodes* - (length (clsql:select 'user :where [user-id] :flatp t :caching nil))) + (length (clsql:select 'user :where [not [null [user-id]]] :flatp t :caching nil))) 2) (deftest :oodml/select/17 @@ -170,7 +224,7 @@ (deftest :oodml/select/18 (with-dataset *ds-nodes* - (length (clsql:select 'theme :where [theme-id] :flatp t :caching nil))) + (length (clsql:select 'theme :where [not [null [theme-id]]] :flatp t :caching nil))) 2) (deftest :oodml/select/19 @@ -203,7 +257,7 @@ (deftest :oodml/select/22 (with-dataset *ds-nodes* - (let ((a (car (clsql:select 'subloc :where [subloc-id] :flatp t :caching nil)))) + (let ((a (car (clsql:select 'subloc :where [not [null [subloc-id]]] :flatp t :caching nil)))) (values (slot-value a 'node-id) (slot-value a 'subloc-id) @@ -211,6 +265,13 @@ (slot-value a 'loc)))) 10 10 "subloc-1" "a subloc") +(deftest :oodml/select/23 + (with-dataset *ds-artists* + (length (clsql:select 'artist :flatp t :caching nil))) + 0) + + + ;; test retrieval is deferred (deftest :oodm/retrieval/1 (with-dataset *ds-employees* @@ -233,15 +294,15 @@ (deftest :oodm/retrieval/4 (with-dataset *ds-employees* - (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address)) + (every #'(lambda (ea) (typep (slot-value ea 'address) 'address)) (select 'employee-address :flatp t :caching nil))) - (t t t t t)) + t) (deftest :oodm/retrieval/5 (with-dataset *ds-employees* - (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address)) - (select 'deferred-employee-address :flatp t :caching nil))) - (t t t t t)) + (every #'(lambda (ea) (typep (slot-value ea 'address) 'address)) + (select 'deferred-employee-address :flatp t :caching nil))) + t) (deftest :oodm/retrieval/6 (with-dataset *ds-employees* @@ -259,13 +320,21 @@ (with-dataset *ds-employees* (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)) + (10 10 nil nil nil nil)) (deftest :oodm/retrieval/9 (with-dataset *ds-employees* (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)) + (10 10 nil nil nil nil)) + +(deftest :oodm/retrieval/10-slot-columns + (with-dataset *ds-employees* + (mapcar #'title + (select 'employee :flatp t :caching nil + :where [<= [emplid] 3] + :order-by `((,[emplid] :asc))))) + (supplicant :adherent cl-user::novice)) ;; tests update-records-from-instance (deftest :oodml/update-records/1 @@ -299,15 +368,16 @@ ;; tests update-record-from-slot (deftest :oodml/update-records/2 (with-dataset *ds-employees* + ;(start-sql-recording :type :both) (values (employee-email (car (clsql:select 'employee :where [= 1 [slot-value 'employee 'emplid]] :flatp t :caching nil))) - (progn - (setf (slot-value employee1 'email) "lenin-nospam@soviet.org") - (clsql:update-record-from-slot employee1 'email) + (progn + (setf (slot-value employee1 'email) "lenin-nospam@soviet.org") + (clsql:update-record-from-slot employee1 'email) (employee-email (car (clsql:select 'employee :where [= 1 [slot-value 'employee 'emplid]] @@ -546,6 +616,8 @@ (let ((sl (car (clsql:select 'subloc :where [= 10 [slot-value 'subloc 'subloc-id]] :flatp t :caching nil)))) + (unless sl + (error "Couldn't find expected sublocation")) (format nil "~a ~a ~a" (slot-value sl 'subloc-id) (slot-value sl 'title) @@ -568,6 +640,8 @@ (let ((sl (car (clsql:select 'subloc :where [= 10 [slot-value 'subloc 'subloc-id]] :flatp t :caching nil)))) + (unless sl + (error "In psfl: found no sublocation with id = 10")) (format nil "~a ~a ~a" (slot-value sl 'subloc-id) (slot-value sl 'title) @@ -577,6 +651,8 @@ (let ((sl (car (clsql:select 'subloc :where [= 10 [slot-value 'subloc 'subloc-id]] :flatp t :caching nil)))) + (unless sl + (error "Select for modification: Found no sublocation with id = 10")) (setf (slot-value sl 'title) "Altered subloc title") (setf (slot-value sl 'loc) "Altered loc") (clsql:update-record-from-slot sl 'title) @@ -585,9 +661,11 @@ (let ((sl (car (clsql:select 'subloc :where [= 10 [slot-value 'subloc 'subloc-id]] :flatp t :caching nil)))) + (unless sl + (error "Select for next modification: Found no sublocation with id = 10")) (setf (slot-value sl 'title) "subloc-1") (setf (slot-value sl 'loc) "a subloc") - (clsql:update-record-from-slot sl '(title loc)) + (clsql:update-record-from-slots sl '(title loc)) (print-fresh-subloc))))) "10 subloc-1 a subloc" "10 Altered subloc title Altered loc" @@ -614,6 +692,17 @@ ((42.0d0)) ((24.13d0))) +(deftest :oodml/update-records/11 + (with-dataset *ds-artists* + (clsql:update-records-from-instance artist1) + (list (name artist1) (artist_id artist1))) + ("Mogwai" 1)) + +(deftest :oodml/update-records/12 + (with-dataset *ds-artists* + (clsql:update-records-from-instance artist1) + (list (name artist1) (genre artist1))) + ("Mogwai" "Unknown")) ;; tests update-instance-from-records (deftest :oodml/update-instance/1 @@ -752,13 +841,13 @@ (progn (clsql:update-records [node] :av-pairs '(([title] "altered title")) - :where [= [node-id] 9]) + :where [= [node-id] (node-id loc2)]) (clsql:update-slot-from-record loc2 'title) (print-loc loc2)) (progn (clsql:update-records [subloc] :av-pairs '(([loc] "altered loc")) - :where [= [subloc-id] 11]) + :where [= [subloc-id] (subloc-id subloc2)]) (clsql:update-slot-from-record subloc2 'loc) (print-subloc subloc2))))) "9: location-2" "11: second subloc" @@ -808,7 +897,7 @@ (deftest :oodml/cache/1 (with-dataset *ds-employees* - (progn + (let ((*default-caching* t)) (setf (clsql-sys:record-caches *default-database*) nil) (let ((employees (select 'employee))) (every #'(lambda (a b) (eq a b)) @@ -817,19 +906,22 @@ (deftest :oodml/cache/2 (with-dataset *ds-employees* - (let ((employees (select 'employee))) + (let* ((*default-caching* t) + (employees (select 'employee))) (equal employees (select 'employee :flatp t)))) nil) (deftest :oodml/refresh/1 (with-dataset *ds-employees* - (let ((addresses (select 'address))) + (let* ((clsql-sys:*default-caching* t) + (addresses (select 'address))) (equal addresses (select 'address :refresh t)))) t) (deftest :oodml/refresh/2 (with-dataset *ds-employees* - (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t)) + (let* ((clsql-sys:*default-caching* t) + (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")) @@ -847,7 +939,8 @@ (deftest :oodml/refresh/3 (with-dataset *ds-employees* - (let* ((addresses (select 'address :order-by [addressid] :flatp t))) + (let* ((clsql-sys:*default-caching* t) + (addresses (select 'address :order-by [addressid] :flatp t))) (values (equal addresses (select 'address :refresh t :flatp t)) (equal addresses (select 'address :flatp t))))) @@ -855,38 +948,56 @@ (deftest :oodml/refresh/4 (with-dataset *ds-employees* - (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t)) + (let* ((clsql-sys:*default-caching* t) + (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) + 3 4 t t) -(deftest :oodml/uoj/1 +(deftest :oodml/uoj/full-set (with-dataset *ds-employees* (progn - (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid] - :flatp t)) + (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) + (update-objects-joins dea-list :slots 'address :max-len nil) (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)) + t t t t (1 1 2 2 2 3)) + +(deftest :oodml/uoj/batched + (with-dataset *ds-employees* + (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 :slots 'address :max-len 2) + (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 3)) ;; update-object-joins needs to be fixed for multiple keys #+ignore -(deftest :oodml/uoj/2 +(deftest :oodml/uoj/multi-key (progn (clsql:update-objects-joins (list company1)) (mapcar #'(lambda (e) @@ -970,7 +1081,8 @@ (values (let ((inst (make-instance 'theme :title "test-theme" :vars "test-vars" - :doc "test-doc"))) + :doc "test-doc")) + (*print-circle* nil)) (setf (slot-value inst 'title) "alternate-test-theme") (format nil "~a ~a ~a ~a" (or (select [title] :from [node] @@ -1128,5 +1240,3 @@ )) - -#.(clsql:restore-sql-reader-syntax-state)