X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Ftest-oodml.lisp;h=6dd7617ee1e1339e206331deff509d5fbd92e629;hp=a5fefe02e1ef057de740f7cb49488c251c019f97;hb=a244caf265fff60cc9d00083e15951762dd7f1ca;hpb=c81a9fe27ee259429b89ef680788abb8f8e1b26a diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp index a5fefe0..6dd7617 100644 --- a/tests/test-oodml.lisp +++ b/tests/test-oodml.lisp @@ -3,7 +3,6 @@ ;;;; File: test-oodml.lisp ;;;; Author: Marcus Pearce ;;;; Created: 01/04/2004 -;;;; Updated: $Id$ ;;;; ;;;; Tests for the CLSQL Object Oriented Data Definition Language ;;;; (OODML). @@ -115,6 +114,82 @@ (1 2 3 4 5 6 7 8 9 10) (10 9 8 7 6 5 4 3 2 1)) + ;; test retrieval of node, derived nodes etc + (deftest :oodml/select/12 + (length (clsql:select 'node :where [node-id] :flatp t :caching nil)) + 11) + + (deftest :oodml/select/13 + (let ((a (car (clsql:select 'node :where [= 1 [node-id]] :flatp t :caching nil)))) + (values + (slot-value a 'node-id) + (slot-value a 'title))) + 1 "Bare node") + + (deftest :oodml/select/14 + (length (clsql:select 'setting :where [setting-id] :flatp t :caching nil)) + 4) + + (deftest :oodml/select/15 + (let ((a (car (clsql:select 'setting :where [= 3 [setting-id]] :flatp t :caching nil)))) + (values + (slot-value a 'node-id) + (slot-value a 'setting-id) + (slot-value a 'title) + (slot-value a 'vars))) + 3 3 "Setting2" "var 2") + + (deftest :oodml/select/16 + (length (clsql:select 'user :where [user-id] :flatp t :caching nil)) + 2) + + (deftest :oodml/select/17 + (let ((a (car (clsql:select 'user :where [= 4 [user-id]] :flatp t :caching nil)))) + (values + (slot-value a 'node-id) + (slot-value a 'user-id) + (slot-value a 'title) + (slot-value a 'nick))) + 4 4 "user-1" "first user") + + (deftest :oodml/select/18 + (length (clsql:select 'theme :where [theme-id] :flatp t :caching nil)) + 2) + + (deftest :oodml/select/19 + (let ((a (car (clsql:select 'theme :where [= 6 [theme-id]] :flatp t :caching nil)))) + (slot-value a 'theme-id)) + 6) + + (deftest :oodml/select/20 + (let ((a (car (clsql:select 'theme :where [= 7 [theme-id]] :flatp t :caching nil)))) + (values + (slot-value a 'node-id) + (slot-value a 'theme-id) + (slot-value a 'title) + (slot-value a 'vars) + (slot-value a 'doc) + )) + 7 7 "theme-2" + nil "second theme") + + ;; Some tests to check weird subclassed nodes (node without own table, or subclassed of same) + (deftest :oodml/select/21 + (let ((a (car (clsql:select 'location :where [= [title] "location-1"] :flatp t :caching nil)))) + (values + (slot-value a 'node-id) + (slot-value a 'title))) + 8 "location-1") + + (deftest :oodml/select/22 + (let ((a (car (clsql:select 'subloc :where [subloc-id] :flatp t :caching nil)))) + (values + (slot-value a 'node-id) + (slot-value a 'subloc-id) + (slot-value a 'title) + (slot-value a 'loc))) + 10 10 "subloc-1" "a subloc") + ;; test retrieval is deferred (deftest :oodm/retrieval/1 (every #'(lambda (e) (not (slot-boundp e 'company))) @@ -289,6 +364,296 @@ "Dimitriy Ivanovich: ivanovich@soviet.org" "Vladimir Lenin: lenin@soviet.org") + (deftest :oodml/update-records/4 + (values + (progn + (let ((base (car (clsql:select 'node + :where [= [slot-value 'node 'node-id] + 1] + :flatp t + :caching nil)))) + (with-output-to-string (out) + (format out "~a ~a" + (slot-value base 'node-id) + (slot-value base 'title))))) + (progn + (let ((base (car (clsql:select 'node + :where [= [slot-value 'node 'node-id] + 1] + :flatp t + :caching nil)))) + (setf (slot-value base 'title) "Altered title") + (clsql:update-records-from-instance base) + (with-output-to-string (out) + (format out "~a ~a" + (slot-value base 'node-id) + (slot-value base 'title))))) + (progn + (let ((base (car (clsql:select 'node + :where [= [slot-value 'node 'node-id] + 1] + :flatp t + :caching nil)))) + (setf (slot-value base 'title) "Bare node") + (clsql:update-records-from-instance base) + (with-output-to-string (out) + (format out "~a ~a" + (slot-value base 'node-id) + (slot-value base 'title)))))) + "1 Bare node" + "1 Altered title" + "1 Bare node") + + (deftest :oodml/update-records/5 + (values + (progn + (let ((node (car (clsql:select 'setting + :where [= [slot-value 'setting 'setting-id] + 3] + :flatp t + :caching nil)))) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value node 'setting-id) + (slot-value node 'title) + (slot-value node 'vars))))) + (progn + (let ((node (car (clsql:select 'setting + :where [= [slot-value 'setting 'setting-id] + 3] + :flatp t + :caching nil)))) + (setf (slot-value node 'title) "Altered title") + (setf (slot-value node 'vars) "Altered vars") + (clsql:update-records-from-instance node) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value node 'setting-id) + (slot-value node 'title) + (slot-value node 'vars))))) + (progn + (let ((node (car (clsql:select 'setting + :where [= [slot-value 'setting 'setting-id] + 3] + :flatp t + :caching nil)))) + (setf (slot-value node 'title) "Setting2") + (setf (slot-value node 'vars) "var 2") + (clsql:update-records-from-instance node) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value node 'setting-id) + (slot-value node 'title) + (slot-value node 'vars)))))) + "3 Setting2 var 2" + "3 Altered title Altered vars" + "3 Setting2 var 2") + + (deftest :oodml/update-records/6 + (values + (progn + (let ((node (car (clsql:select 'setting + :where [= [slot-value 'setting 'setting-id] + 7] + :flatp t + :caching nil)))) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value node 'setting-id) + (slot-value node 'title) + (slot-value node 'vars))))) + (progn + (let ((node (car (clsql:select 'setting + :where [= [slot-value 'setting 'setting-id] + 7] + :flatp t + :caching nil)))) + (setf (slot-value node 'title) "Altered title") + (setf (slot-value node 'vars) "Altered vars") + (clsql:update-records-from-instance node) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value node 'setting-id) + (slot-value node 'title) + (slot-value node 'vars))))) + (progn + (let ((node (car (clsql:select 'setting + :where [= [slot-value 'setting 'setting-id] + 7] + :flatp t + :caching nil)))) + (setf (slot-value node 'title) "theme-2") + (setf (slot-value node 'vars) nil) + (clsql:update-records-from-instance node) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value node 'setting-id) + (slot-value node 'title) + (slot-value node 'vars)))))) + "7 theme-2 NIL" + "7 Altered title Altered vars" + "7 theme-2 NIL") + + (deftest :oodml/update-records/7 + (values + (progn + (let ((node (car (clsql:select 'user + :where [= [slot-value 'user 'user-id] + 5] + :flatp t + :caching nil)))) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value node 'user-id) + (slot-value node 'title) + (slot-value node 'nick))))) + (progn + (let ((node (car (clsql:select 'user + :where [= [slot-value 'user 'user-id] + 5] + :flatp t + :caching nil)))) + (setf (slot-value node 'title) "Altered title") + (setf (slot-value node 'nick) "Altered nick") + (clsql:update-records-from-instance node) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value node 'user-id) + (slot-value node 'title) + (slot-value node 'nick))))) + (progn + (let ((node (car (clsql:select 'user + :where [= [slot-value 'user 'user-id] + 5] + :flatp t + :caching nil)))) + (setf (slot-value node 'title) "user-2") + (setf (slot-value node 'nick) "second user") + (clsql:update-records-from-instance node) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value node 'user-id) + (slot-value node 'title) + (slot-value node 'nick)))))) + "5 user-2 second user" + "5 Altered title Altered nick" + "5 user-2 second user") + + (deftest :oodml/update-records/8 + (values + (progn + (let ((node (car (clsql:select 'theme + :where [= [slot-value 'theme 'theme-id] + 6] + :flatp t + :caching nil)))) + (with-output-to-string (out) + (format out "~a ~a ~a ~a ~a ~a" + (slot-value node 'node-id) + (slot-value node 'setting-id) + (slot-value node 'theme-id) + (slot-value node 'title) + (slot-value node 'vars) + (slot-value node 'doc))))) + (progn + (let ((node (car (clsql:select 'setting + :where [= [slot-value 'setting 'setting-id] + 6] + :flatp t + :caching nil)))) + (setf (slot-value node 'title) "Altered title") + (setf (slot-value node 'vars) nil) + (clsql:update-records-from-instance node) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value node 'setting-id) + (slot-value node 'title) + (slot-value node 'vars))))) + (progn + (let ((node (car (clsql:select 'theme + :where [= [slot-value 'theme 'theme-id] + 6] + :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) + (with-output-to-string (out) + (format out "~a ~a ~a ~a ~a ~a" + (slot-value node 'node-id) + (slot-value node 'setting-id) + (slot-value node 'theme-id) + (slot-value node 'title) + (slot-value node 'vars) + (slot-value node 'doc))))) + (progn + (let ((node (car (clsql:select 'theme + :where [= [slot-value 'theme 'theme-id] + 6] + :flatp t + :caching nil)))) + (setf (slot-value node 'title) "theme-1") + (setf (slot-value node 'vars) "empty") + (setf (slot-value node 'doc) "first theme") + (clsql:update-records-from-instance node) + (with-output-to-string (out) + (format out "~a ~a ~a ~a ~a ~a" + (slot-value node 'node-id) + (slot-value node 'setting-id) + (slot-value node 'theme-id) + (slot-value node 'title) + (slot-value node 'vars) + (slot-value node 'doc)))))) + "6 6 6 theme-1 empty first theme" + "6 Altered title NIL" + "6 6 6 Altered title again NIL altered doc" + "6 6 6 theme-1 empty first theme") + + (deftest :oodml/update-records/9 + (values + (progn + (let ((sl (car (clsql:select 'subloc + :where [= [slot-value 'subloc 'subloc-id] + 10] + :flatp t + :caching nil)))) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value sl 'subloc-id) + (slot-value sl 'title) + (slot-value sl 'loc))))) + (progn + (let ((sl (car (clsql:select 'subloc + :where [= [slot-value 'subloc 'subloc-id] + 10] + :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) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value sl 'subloc-id) + (slot-value sl 'title) + (slot-value sl 'loc))))) + (progn + (let ((sl (car (clsql:select 'subloc + :where [= [slot-value 'subloc 'subloc-id] + 10] + :flatp t + :caching nil)))) + (setf (slot-value sl 'title) "subloc-1") + (setf (slot-value sl 'loc) "a subloc") + (clsql:update-records-from-instance sl) + (with-output-to-string (out) + (format out "~a ~a ~a" + (slot-value sl 'subloc-id) + (slot-value sl 'title) + (slot-value sl 'loc)))))) + "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 @@ -346,6 +711,174 @@ (slot-value employee1 'email))) "lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org") + ;; tests normalisedp update-instance-from-records + (deftest :oodml/update-instance/3 + (values + (with-output-to-string (out) + (format out "~a ~a ~a ~a" + (slot-value theme2 'theme-id) + (slot-value theme2 'title) + (slot-value theme2 'vars) + (slot-value theme2 'doc))) + (progn + (clsql:update-records [node] :av-pairs '(([title] "Altered title")) + :where [= [node-id] 7]) + (clsql:update-records [setting] :av-pairs '(([vars] "Altered vars")) + :where [= [setting-id] 7]) + (clsql:update-records [theme] :av-pairs '(([doc] "Altered doc")) + :where [= [theme-id] 7]) + (clsql:update-instance-from-records theme2) + (with-output-to-string (out) + (format out "~a ~a ~a ~a" + (slot-value theme2 'theme-id) + (slot-value theme2 'title) + (slot-value theme2 'vars) + (slot-value theme2 'doc)))) + (progn + (clsql:update-records [node] :av-pairs '(([title] "theme-2")) + :where [= [node-id] 7]) + (clsql:update-records [setting] :av-pairs '(([vars] nil)) + :where [= [setting-id] 7]) + (clsql:update-records [theme] :av-pairs '(([doc] "second theme")) + :where [= [theme-id] 7]) + (clsql:update-instance-from-records theme2) + (with-output-to-string (out) + (format out "~a ~a ~a ~a" + (slot-value theme2 'theme-id) + (slot-value theme2 'title) + (slot-value theme2 'vars) + (slot-value theme2 'doc))))) + "7 theme-2 NIL second theme" + "7 Altered title Altered vars Altered doc" + "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))))) + "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))))) + "11 subloc-2 second subloc" + "11 Altered title Altered loc" + "11 subloc-2 second subloc") + + ;; tests update-slot-from-record with normalisedp stuff + (deftest :oodml/update-instance/6 + (values + (slot-value theme1 'doc) + (slot-value theme1 'vars) + (progn + (clsql:update-records [theme] + :av-pairs '(([doc] "altered doc")) + :where [= [theme-id] 6]) + (clsql:update-slot-from-record theme1 'doc) + (slot-value theme1 'doc)) + (progn + (clsql:update-records [setting] + :av-pairs '(([vars] "altered vars")) + :where [= [setting-id] 6]) + (clsql:update-slot-from-record theme1 'vars) + (slot-value theme1 'vars)) + (progn + (clsql:update-records [theme] + :av-pairs '(([doc] "first theme")) + :where [= [theme-id] 6]) + (clsql:update-slot-from-record theme1 'doc) + (slot-value theme1 'doc)) + (progn + (clsql:update-records [setting] + :av-pairs '(([vars] "empty")) + :where [= [setting-id] 6]) + (clsql:update-slot-from-record theme1 'vars) + (slot-value theme1 'vars))) + "first theme" "empty" + "altered doc" "altered vars" + "first theme" "empty") + + (deftest :oodml/update-instance/7 + (values + (slot-value loc2 'title) + (slot-value subloc2 'loc) + (progn + (clsql:update-records [node] + :av-pairs '(([title] "altered title")) + :where [= [node-id] 9]) + (clsql:update-slot-from-record loc2 'title) + (slot-value loc2 'title)) + (progn + (clsql:update-records [subloc] + :av-pairs '(([loc] "altered loc")) + :where [= [subloc-id] 11]) + (clsql:update-slot-from-record subloc2 'loc) + (slot-value subloc2 'loc)) + (progn + (clsql:update-records [node] + :av-pairs '(([title] "location-2")) + :where [= [node-id] 9]) + (clsql:update-slot-from-record loc2 'title) + (slot-value loc2 'title)) + (progn + (clsql:update-records [subloc] + :av-pairs '(([loc] "second subloc")) + :where [= [subloc-id] 11]) + (clsql:update-slot-from-record subloc2 'loc) + (slot-value subloc2 'loc))) + "location-2" "second subloc" + "altered title" "altered loc" + "location-2" "second subloc") (deftest :oodml/do-query/1 (let ((result '())) @@ -515,6 +1048,69 @@ (delete-records :from [employee] :where [= [emplid] 20])))) nil ("Bulgakov")) + (deftest :oodml/db-auto-sync/3 + (values + (progn + (make-instance 'theme :title "test-theme" :vars "test-vars" + :doc "test-doc") + (select [node-id] :from [node] :where [= [title] "test-theme"] + :flatp t :field-names nil)) + (let ((*db-auto-sync* t)) + (make-instance 'theme :title "test-theme" :vars "test-vars" + :doc "test-doc") + (prog1 (select [title] :from [node] :where [= [title] "test-theme"] + :flatp t :field-names nil) + (delete-records :from [node] :where [= [title] "test-theme"]) + (delete-records :from [setting] :where [= [vars] "test-vars"]) + (delete-records :from [theme] :where [= [doc] "test-doc"])))) + 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)") + (deftest :oodml/setf-slot-value/1 (let* ((*db-auto-sync* t) (instance (make-instance 'employee :emplid 20 :groupid 1))) @@ -623,9 +1219,7 @@ 1)) (setf (slot-value emp1 'height) height) (clsql:update-record-from-slot emp1 'height))) - t) - - )) + t)))