X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Ftest-oodml.lisp;h=dadbfcbe6d542d753d7b20c80c21f562b5d22a30;hb=0ad64f85ff6cd99a78cc9ae6716ebbdb5627eaef;hp=06e246005487bb8bc1526988d774b7fb49f9b4b1;hpb=90ce2284fab5f1daedb8aa6aba3008a5c3651e30;p=clsql.git

diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp
index 06e2460..dadbfcb 100644
--- a/tests/test-oodml.lisp
+++ b/tests/test-oodml.lisp
@@ -1,7 +1,6 @@
 ;;;; -*- 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
@@ -458,7 +457,7 @@
 		 (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
@@ -511,7 +510,7 @@
 		 (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
@@ -594,6 +593,27 @@
   "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
@@ -638,7 +658,7 @@
 	  (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"))
@@ -950,21 +970,22 @@
       (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"
@@ -972,18 +993,18 @@
 	  (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"])))))