;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; ======================================================================
;;;; File: test-oodml.lisp
-;;;; Author: Marcus Pearce <m.t.pearce@city.ac.uk>
;;;; Created: 01/04/2004
;;;;
;;;; Tests for the CLSQL Object Oriented Data Definition Language
(format nil "~a ~a ~a"
(slot-value node 'setting-id)
(slot-value node 'title)
- (slot-value node 'vars)))))
+ (or (slot-value node 'vars) "NIL")))))
(values
(print-fresh-setting)
(let ((node (car (clsql:select 'setting
(with-slots (node-id setting-id theme-id title vars doc) node
(format nil "~a ~a ~a ~a ~a ~a"
node-id setting-id theme-id
- title vars doc)))))
+ title (or vars "NIL") doc)))))
(values
(print-fresh-theme)
(let ((node (car (clsql:select 'setting
: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))
+ (clsql:update-record-from-slots sl '(title loc))
(print-fresh-subloc)))))
"10 subloc-1 a subloc"
"10 Altered subloc title Altered loc"
"10 subloc-1 a subloc")
+;; Verify that we can set a float to nil and then read it back
+;; (was failing in Postgresql at somepoint)
+(deftest :oodml/update-records/10
+ (with-dataset *ds-employees*
+ (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp t))))
+ (setf (height emp) nil)
+ (clsql-sys:update-record-from-slot emp 'height)
+ (values
+ (clsql:select [height] :from [employee] :where [= [emplid] 1])
+ (progn
+ (setf (height emp) 42.0)
+ (clsql-sys:update-record-from-slot emp 'height)
+ (clsql:select [height] :from [employee] :where [= [emplid] 1]))
+ (progn
+ (setf (height emp) 24.13d0)
+ (clsql-sys:update-record-from-slot emp 'height)
+ (clsql:select [height] :from [employee] :where [= [emplid] 1])))))
+ ((nil))
+ ((42.0d0))
+ ((24.13d0)))
+
;; tests update-instance-from-records
(deftest :oodml/update-instance/1
(slot-value employee1 'email))))
"lenin@soviet.org" "lenin-nospam@soviet.org")
-;; tests normalisedp update-instance-from-records
+;; tests normalizedp update-instance-from-records
(deftest :oodml/update-instance/3
(with-dataset *ds-nodes*
(values
(format out "~a ~a ~a ~a"
(slot-value theme2 'theme-id)
(slot-value theme2 'title)
- (slot-value theme2 'vars)
+ (or (slot-value theme2 'vars) "NIL")
(slot-value theme2 'doc)))
(progn
(clsql:update-records [node] :av-pairs '(([title] "Altered title"))
"11 subloc-2 second subloc"
"11 Altered title Altered loc")
-;; tests update-slot-from-record with normalisedp stuff
+;; tests update-slot-from-record with normalizedp stuff
(deftest :oodml/update-instance/6
(with-dataset *ds-nodes*
(values
(print-subloc (sl)
(format nil "~a: ~a"
(slot-value sl 'node-id) (slot-value sl 'loc))))
- (with-dataset *ds-nodes*
- (values
- (print-loc loc2)
- (print-subloc subloc2)
- (progn
- (clsql:update-records [node]
- :av-pairs '(([title] "altered title"))
- :where [= [node-id] 9])
- (clsql:update-slot-from-record loc2 'title)
- (print-loc loc2))
- (progn
- (clsql:update-records [subloc]
- :av-pairs '(([loc] "altered loc"))
- :where [= [subloc-id] 11])
- (clsql:update-slot-from-record subloc2 'loc)
- (print-subloc subloc2)))))
+ (with-dataset *ds-nodes*
+ (values
+ (print-loc loc2)
+ (print-subloc subloc2)
+ (progn
+ (clsql:update-records [node]
+ :av-pairs '(([title] "altered title"))
+ :where [= [node-id] 9])
+ (clsql:update-slot-from-record loc2 'title)
+ (print-loc loc2))
+ (progn
+ (clsql:update-records [subloc]
+ :av-pairs '(([loc] "altered loc"))
+ :where [= [subloc-id] 11])
+ (clsql:update-slot-from-record subloc2 'loc)
+ (print-subloc subloc2)))))
"9: location-2" "11: second subloc"
"9: altered title" "11: altered loc")
(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"
- (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)))
+ (or (select [title] :from [node]
+ :where [= [title] "test-theme"]
+ :flatp t :field-names nil) "NIL")
+ (or (select [vars] :from [setting]
+ :where [= [vars] "test-vars"]
+ :flatp t :field-names nil) "NIL")
+ (or (select [doc] :from [theme]
+ :where [= [doc] "test-doc"]
+ :flatp t :field-names nil) "NIL")
+ (or (select [title] :from [node]
+ :where [= [title] "alternate-test-theme"]
+ :flatp t :field-names nil) "NIL")))
(let* ((*db-auto-sync* t)
(inst (make-instance 'theme
:title "test-theme" :vars "test-vars"
(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))
+ (or (select [title] :from [node]
+ :where [= [title] "test-theme"]
+ :flatp t :field-names nil) "NIL")
+ (or (select [vars] :from [setting]
+ :where [= [vars] "test-vars"]
+ :flatp t :field-names nil) "NIL")
+ (or (select [doc] :from [theme]
+ :where [= [doc] "test-doc"]
+ :flatp t :field-names nil) "NIL")
+ (or (select [title] :from [node]
+ :where [= [title] "alternate-test-theme"]
+ :flatp t :field-names nil) "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"])))))
projects / clsql.git / blobdiff