X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Ftest-oodml.lisp;h=2dbca892a89b72336f1c5bdd3543147cac1d7aeb;hb=23efde4775da296d92ac599803284a470fcc13de;hp=f67cb0026bcb17574c6a1928ee1a61019d5e7e46;hpb=826219febc484eba8125546a1acc2ddaef326db1;p=clsql.git diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp index f67cb00..2dbca89 100644 --- a/tests/test-oodml.lisp +++ b/tests/test-oodml.lisp @@ -367,28 +367,22 @@ (deftest :oodml/update-records/4 (flet ((print-fresh-node () (let ((base (car (clsql:select 'node - :where [= [slot-value 'node 'node-id] - 1] - :flatp t - :caching nil)))) + :where [= 1 [slot-value 'node 'node-id]] + :flatp t :caching nil)))) (format nil "~a ~a" (slot-value base 'node-id) (slot-value base 'title))))) (values (print-fresh-node) (let ((base (car (clsql:select 'node - :where [= [slot-value 'node 'node-id] - 1] - :flatp t - :caching nil)))) + :where [= 1 [slot-value 'node 'node-id]] + :flatp t :caching nil)))) (setf (slot-value base 'title) "Altered title") (clsql:update-records-from-instance base) (print-fresh-node)) (let ((base (car (clsql:select 'node - :where [= [slot-value 'node 'node-id] - 1] - :flatp t - :caching nil)))) + :where [= 1 [slot-value 'node 'node-id]] + :flatp t :caching nil)))) (setf (slot-value base 'title) "Bare node") (clsql:update-records-from-instance base) (print-fresh-node)))) @@ -396,13 +390,42 @@ "1 Altered title" "1 Bare node") + (deftest :oodml/update-records/4-slots ;just like 4, but use slots fns. + (flet ((print-fresh-setting () + (let ((node (car (clsql:select 'setting + :where [= 3 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) + (format nil "~a ~a ~a" + (slot-value node 'setting-id) + (slot-value node 'title) + (slot-value node 'vars))))) + (values + (print-fresh-setting) + (let ((node (car (clsql:select 'setting + :where [= 3 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) + (setf (slot-value node 'title) "Altered title") + (setf (slot-value node 'vars) "Altered vars") + (clsql-sys:update-record-from-slot node 'title) + (clsql-sys:update-record-from-slot node 'vars) + (print-fresh-setting)) + (let ((node (car (clsql:select 'setting + :where [= 3 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) + (setf (slot-value node 'title) "Setting2") + (setf (slot-value node 'vars) "var 2") + (clsql:update-records-from-instance node) + (clsql-sys:update-record-from-slots node '(vars title)) + (print-fresh-setting)))) + "3 Setting2 var 2" + "3 Altered title Altered vars" + "3 Setting2 var 2") + (deftest :oodml/update-records/5 (flet ((print-fresh-setting () (let ((node (car (clsql:select 'setting - :where [= [slot-value 'setting 'setting-id] - 3] - :flatp t - :caching nil)))) + :where [= 3 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) (format nil "~a ~a ~a" (slot-value node 'setting-id) (slot-value node 'title) @@ -410,19 +433,15 @@ (values (print-fresh-setting) (let ((node (car (clsql:select 'setting - :where [= [slot-value 'setting 'setting-id] - 3] - :flatp t - :caching nil)))) + :where [= 3 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) (setf (slot-value node 'title) "Altered title") (setf (slot-value node 'vars) "Altered vars") (clsql:update-records-from-instance node) (print-fresh-setting)) (let ((node (car (clsql:select 'setting - :where [= [slot-value 'setting 'setting-id] - 3] - :flatp t - :caching nil)))) + :where [= 3 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) (setf (slot-value node 'title) "Setting2") (setf (slot-value node 'vars) "var 2") (clsql:update-records-from-instance node) @@ -431,34 +450,57 @@ "3 Altered title Altered vars" "3 Setting2 var 2") + (deftest :oodml/update-records/5-slots + (flet ((print-fresh-setting () + (let ((node (car (clsql:select 'setting + :where [= 3 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) + (format nil "~a ~a ~a" + (slot-value node 'setting-id) + (slot-value node 'title) + (slot-value node 'vars))))) + (values + (print-fresh-setting) + (let ((node (car (clsql:select 'setting + :where [= 3 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) + (setf (slot-value node 'title) "Altered title") + (setf (slot-value node 'vars) "Altered vars") + (clsql-sys:update-record-from-slot node 'title) + (clsql-sys:update-record-from-slot node 'vars) + (print-fresh-setting)) + (let ((node (car (clsql:select 'setting + :where [= 3 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) + (setf (slot-value node 'title) "Setting2") + (setf (slot-value node 'vars) "var 2") + (clsql-sys:update-record-from-slots node '(title vars)) + (print-fresh-setting)))) + "3 Setting2 var 2" + "3 Altered title Altered vars" + "3 Setting2 var 2") + (deftest :oodml/update-records/6 (flet ((print-fresh-setting () (let ((node (car (clsql:select 'setting - :where [= [slot-value 'setting 'setting-id] - 7] - :flatp t - :caching nil)))) + :where [= 7 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) (format nil "~a ~a ~a" (slot-value node 'setting-id) (slot-value node 'title) - (slot-value node 'vars))) - )) + (slot-value node 'vars))))) (values (print-fresh-setting) (let ((node (car (clsql:select 'setting - :where [= [slot-value 'setting 'setting-id] - 7] - :flatp t - :caching nil)))) + :where [= 7 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) (setf (slot-value node 'title) "Altered title") (setf (slot-value node 'vars) "Altered vars") (clsql:update-records-from-instance node) (print-fresh-setting)) (let ((node (car (clsql:select 'setting - :where [= [slot-value 'setting 'setting-id] - 7] - :flatp t - :caching nil)))) + :where [= 7 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) (setf (slot-value node 'title) "theme-2") (setf (slot-value node 'vars) nil) (clsql:update-records-from-instance node) @@ -471,10 +513,8 @@ (flet ((print-fresh-user () "requery to get what the db has, and print out." (let ((node (car (clsql:select 'user - :where [= [slot-value 'user 'user-id] - 5] - :flatp t - :caching nil)))) + :where [= 5 [slot-value 'user 'user-id]] + :flatp t :caching nil)))) (format nil "~a ~a ~a" (slot-value node 'user-id) (slot-value node 'title) @@ -482,19 +522,15 @@ (values (print-fresh-user) (let ((node (car (clsql:select 'user - :where [= [slot-value 'user 'user-id] - 5] - :flatp t - :caching nil)))) + :where [= 5 [slot-value 'user 'user-id]] + :flatp t :caching nil)))) (setf (slot-value node 'title) "Altered title") (setf (slot-value node 'nick) "Altered nick") (clsql:update-records-from-instance node) (print-fresh-user)) (let ((node (car (clsql:select 'user - :where [= [slot-value 'user 'user-id] - 5] - :flatp t - :caching nil)))) + :where [= 5 [slot-value 'user 'user-id]] + :flatp t :caching nil)))) (setf (slot-value node 'title) "user-2") (setf (slot-value node 'nick) "second user") (clsql:update-records-from-instance node) @@ -506,10 +542,8 @@ (deftest :oodml/update-records/8 (flet ((print-fresh-theme () (let ((node (car (clsql:select 'theme - :where [= [slot-value 'theme 'theme-id] - 6] - :flatp t - :caching nil)))) + :where [= 6 [slot-value 'theme 'theme-id]] + :flatp t :caching nil)))) (format nil "~a ~a ~a ~a ~a ~a" (slot-value node 'node-id) (slot-value node 'setting-id) @@ -520,28 +554,22 @@ (values (print-fresh-theme) (let ((node (car (clsql:select 'setting - :where [= [slot-value 'setting 'setting-id] - 6] - :flatp t - :caching nil)))) + :where [= 6 [slot-value 'setting 'setting-id]] + :flatp t :caching nil)))) (setf (slot-value node 'title) "Altered title") (setf (slot-value node 'vars) nil) (clsql:update-records-from-instance node) (print-fresh-theme)) (let ((node (car (clsql:select 'theme - :where [= [slot-value 'theme 'theme-id] - 6] - :flatp t - :caching nil)))) + :where [= 6 [slot-value 'theme 'theme-id]] + :flatp t :caching nil)))) (setf (slot-value node 'title) "Altered title again") (setf (slot-value node 'doc) "altered doc") (clsql:update-records-from-instance node) (print-fresh-theme)) (let ((node (car (clsql:select 'theme - :where [= [slot-value 'theme 'theme-id] - 6] - :flatp t - :caching nil)))) + :where [= 6 [slot-value 'theme 'theme-id]] + :flatp t :caching nil)))) (setf (slot-value node 'title) "theme-1") (setf (slot-value node 'vars) "empty") (setf (slot-value node 'doc) "first theme") @@ -555,10 +583,8 @@ (deftest :oodml/update-records/9 (flet ((print-fresh-subloc () (let ((sl (car (clsql:select 'subloc - :where [= [slot-value 'subloc 'subloc-id] - 10] - :flatp t - :caching nil)))) + :where [= 10 [slot-value 'subloc 'subloc-id]] + :flatp t :caching nil)))) (format nil "~a ~a ~a" (slot-value sl 'subloc-id) (slot-value sl 'title) @@ -566,19 +592,15 @@ (values (print-fresh-subloc) (let ((sl (car (clsql:select 'subloc - :where [= [slot-value 'subloc 'subloc-id] - 10] - :flatp t - :caching nil)))) + :where [= 10 [slot-value 'subloc 'subloc-id]] + :flatp t :caching nil)))) (setf (slot-value sl 'title) "Altered subloc title") (setf (slot-value sl 'loc) "Altered loc") (clsql:update-records-from-instance sl) (print-fresh-subloc)) (let ((sl (car (clsql:select 'subloc - :where [= [slot-value 'subloc 'subloc-id] - 10] - :flatp t - :caching nil)))) + :where [= 10 [slot-value 'subloc 'subloc-id]] + :flatp t :caching nil)))) (setf (slot-value sl 'title) "subloc-1") (setf (slot-value sl 'loc) "a subloc") (clsql:update-records-from-instance sl) @@ -587,6 +609,37 @@ "10 Altered subloc title Altered loc" "10 subloc-1 a subloc") + (deftest :oodml/update-records/9-slots ;like 9, but use slots fns. + (flet ((print-fresh-subloc () + (let ((sl (car (clsql:select 'subloc + :where [= 10 [slot-value 'subloc 'subloc-id]] + :flatp t :caching nil)))) + (format nil "~a ~a ~a" + (slot-value sl 'subloc-id) + (slot-value sl 'title) + (slot-value sl 'loc))))) + (values + (print-fresh-subloc) + (let ((sl (car (clsql:select 'subloc + :where [= 10 [slot-value 'subloc 'subloc-id]] + :flatp t :caching nil)))) + (setf (slot-value sl 'title) "Altered subloc title") + (setf (slot-value sl 'loc) "Altered loc") + (clsql:update-record-from-slot sl 'title) + (clsql:update-record-from-slot sl 'loc) + (print-fresh-subloc)) + (let ((sl (car (clsql:select 'subloc + :where [= 10 [slot-value 'subloc 'subloc-id]] + :flatp t :caching nil)))) + (setf (slot-value sl 'title) "subloc-1") + (setf (slot-value sl 'loc) "a subloc") + (clsql:update-record-from-slot sl '(title loc)) + (print-fresh-subloc)))) + "10 subloc-1 a subloc" + "10 Altered subloc title Altered loc" + "10 subloc-1 a subloc") + + ;; tests update-instance-from-records (deftest :oodml/update-instance/1 (values @@ -686,64 +739,58 @@ "7 theme-2 NIL second theme") (deftest :oodml/update-instance/4 - (values - (progn - (setf loc2 (car (clsql:select 'location - :where [= [node-id] 9] - :flatp t :caching nil))) - (with-output-to-string (out) - (format out "~a ~a" - (slot-value loc2 'node-id) - (slot-value loc2 'title)))) - (progn - (clsql:update-records [node] :av-pairs '(([title] "Altered title")) - :where [= [node-id] 9]) - (clsql:update-instance-from-records loc2) - (with-output-to-string (out) - (format out "~a ~a" - (slot-value loc2 'node-id) - (slot-value loc2 'title)))) - (progn - (clsql:update-records [node] :av-pairs '(([title] "location-2")) - :where [= [node-id] 9]) - (clsql:update-instance-from-records loc2) - (with-output-to-string (out) - (format out "~a ~a" - (slot-value loc2 'node-id) - (slot-value loc2 'title))))) + (values + (progn + (setf loc2 (car (clsql:select 'location + :where [= [node-id] 9] + :flatp t :caching nil))) + (format nil "~a ~a" + (slot-value loc2 'node-id) + (slot-value loc2 'title))) + (progn + (clsql:update-records [node] :av-pairs '(([title] "Altered title")) + :where [= [node-id] 9]) + (clsql:update-instance-from-records loc2) + (format nil "~a ~a" + (slot-value loc2 'node-id) + (slot-value loc2 'title))) + (progn + (clsql:update-records [node] :av-pairs '(([title] "location-2")) + :where [= [node-id] 9]) + (clsql:update-instance-from-records loc2) + (format nil "~a ~a" + (slot-value loc2 'node-id) + (slot-value loc2 'title)))) "9 location-2" "9 Altered title" "9 location-2") (deftest :oodml/update-instance/5 - (values - (with-output-to-string (out) - (format out "~a ~a ~a" - (slot-value subloc2 'subloc-id) - (slot-value subloc2 'title) - (slot-value subloc2 'loc))) - (progn - (clsql:update-records [node] :av-pairs '(([title] "Altered title")) - :where [= [node-id] 11]) - (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc")) - :where [= [subloc-id] 11]) - (clsql:update-instance-from-records subloc2) - (with-output-to-string (out) - (format out "~a ~a ~a" - (slot-value subloc2 'subloc-id) - (slot-value subloc2 'title) - (slot-value subloc2 'loc)))) - (progn - (clsql:update-records [node] :av-pairs '(([title] "subloc-2")) - :where [= [node-id] 11]) - (clsql:update-records [subloc] :av-pairs '(([loc] "second subloc")) - :where [= [subloc-id] 11]) - (clsql:update-instance-from-records subloc2) - (with-output-to-string (out) - (format out "~a ~a ~a" - (slot-value subloc2 'subloc-id) - (slot-value subloc2 'title) - (slot-value subloc2 'loc))))) + (values + (format nil "~a ~a ~a" + (slot-value subloc2 'subloc-id) + (slot-value subloc2 'title) + (slot-value subloc2 'loc)) + (progn + (clsql:update-records [node] :av-pairs '(([title] "Altered title")) + :where [= [node-id] 11]) + (clsql:update-records [subloc] :av-pairs '(([loc] "Altered loc")) + :where [= [subloc-id] 11]) + (clsql:update-instance-from-records subloc2) + (format nil "~a ~a ~a" + (slot-value subloc2 'subloc-id) + (slot-value subloc2 'title) + (slot-value subloc2 'loc))) + (progn + (clsql:update-records [node] :av-pairs '(([title] "subloc-2")) + :where [= [node-id] 11]) + (clsql:update-records [subloc] :av-pairs '(([loc] "second subloc")) + :where [= [subloc-id] 11]) + (clsql:update-instance-from-records subloc2) + (format nil "~a ~a ~a" + (slot-value subloc2 'subloc-id) + (slot-value subloc2 'title) + (slot-value subloc2 'loc)))) "11 subloc-2 second subloc" "11 Altered title Altered loc" "11 subloc-2 second subloc") @@ -999,50 +1046,48 @@ nil ("test-theme")) (deftest :oodml/db-auto-sync/4 - (values - (let ((inst (make-instance 'theme - :title "test-theme" :vars "test-vars" - :doc "test-doc"))) - (setf (slot-value inst 'title) "alternate-test-theme") - (with-output-to-string (out) - (format out "~a ~a ~a ~a" - (select [title] :from [node] - :where [= [title] "test-theme"] - :flatp t :field-names nil) - (select [vars] :from [setting] - :where [= [vars] "test-vars"] - :flatp t :field-names nil) - (select [doc] :from [theme] - :where [= [doc] "test-doc"] - :flatp t :field-names nil) - (select [title] :from [node] - :where [= [title] "alternate-test-theme"] - :flatp t :field-names nil)))) - (let* ((*db-auto-sync* t) - (inst (make-instance 'theme - :title "test-theme" :vars "test-vars" - :doc "test-doc"))) - (setf (slot-value inst 'title) "alternate-test-theme") - (prog1 - (with-output-to-string (out) - (format out "~a ~a ~a ~a" - (select [title] :from [node] - :where [= [title] "test-theme"] - :flatp t :field-names nil) - (select [vars] :from [setting] - :where [= [vars] "test-vars"] - :flatp t :field-names nil) - (select [doc] :from [theme] - :where [= [doc] "test-doc"] - :flatp t :field-names nil) - (select [title] :from [node] - :where [= [title] "alternate-test-theme"] - :flatp t :field-names nil))) - (delete-records :from [node] :where [= [title] "alternate-test-theme"]) - (delete-records :from [setting] :where [= [vars] "test-vars"]) - (delete-records :from [theme] :where [= [doc] "test-doc"])))) - "NIL NIL NIL NIL" - "NIL (test-vars) (test-doc) (alternate-test-theme)") + (values + (let ((inst (make-instance 'theme + :title "test-theme" :vars "test-vars" + :doc "test-doc"))) + (setf (slot-value inst 'title) "alternate-test-theme") + (format nil "~a ~a ~a ~a" + (select [title] :from [node] + :where [= [title] "test-theme"] + :flatp t :field-names nil) + (select [vars] :from [setting] + :where [= [vars] "test-vars"] + :flatp t :field-names nil) + (select [doc] :from [theme] + :where [= [doc] "test-doc"] + :flatp t :field-names nil) + (select [title] :from [node] + :where [= [title] "alternate-test-theme"] + :flatp t :field-names nil))) + (let* ((*db-auto-sync* t) + (inst (make-instance 'theme + :title "test-theme" :vars "test-vars" + :doc "test-doc"))) + (setf (slot-value inst 'title) "alternate-test-theme") + (prog1 + (format nil "~a ~a ~a ~a" + (select [title] :from [node] + :where [= [title] "test-theme"] + :flatp t :field-names nil) + (select [vars] :from [setting] + :where [= [vars] "test-vars"] + :flatp t :field-names nil) + (select [doc] :from [theme] + :where [= [doc] "test-doc"] + :flatp t :field-names nil) + (select [title] :from [node] + :where [= [title] "alternate-test-theme"] + :flatp t :field-names nil)) + (delete-records :from [node] :where [= [title] "alternate-test-theme"]) + (delete-records :from [setting] :where [= [vars] "test-vars"]) + (delete-records :from [theme] :where [= [doc] "test-doc"])))) + "NIL NIL NIL NIL" + "NIL (test-vars) (test-doc) (alternate-test-theme)") (deftest :oodml/setf-slot-value/1 (let* ((*db-auto-sync* t)