(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))))
"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)
(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)
"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)
(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)
(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)
(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)
(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")
(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)
(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)
"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
"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")
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)
projects / clsql.git / blobdiff