r9811: * sql/oodml.lisp: add DATABASE-OUTPUT-SQL-AS-TYPE method specialisation

	to print floats with the exponent markers removed.
	* sql/test-oodml.lisp: add tests for updating records with floats.

diff --git a/ChangeLog b/ChangeLog
index 84cf70594d88bde780ca6bacd22bd8f292366385..a13448ea7cf28e03719953d388414222361628e7 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+23 Jul 2004 Marcus Pearce <m.t.pearce@city.ac.uk> 
+       * sql/oodml.lisp: add DATABASE-OUTPUT-SQL-AS-TYPE method specialisation
+       to print floats with the exponent markers removed. 
+       * sql/test-oodml.lisp: add tests for updating records with floats. 
+

 22 Jul 2004 Marcus Pearce <m.t.pearce@city.ac.uk> 
        * db-oracle/oracle-sql.lisp: enable :OWNER :ALL in DATABASE-LIST-* for 
        CommonSQL compatibility. 
 22 Jul 2004 Marcus Pearce <m.t.pearce@city.ac.uk> 
        * db-oracle/oracle-sql.lisp: enable :OWNER :ALL in DATABASE-LIST-* for 
        CommonSQL compatibility. 

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 624cadf059a1871fe4dc37c043a79aae6f75a71c..4562be8558eb43b0b79e2be50f58b2881052bfda 100644 (file)
--- a/sql/oodml.lisp
+++ b/sql/oodml.lisp
@@ -473,13 +473,17 @@
   (declare (ignore database db-type))
   val)
 
   (declare (ignore database db-type))
   val)
 

-(defmethod database-output-sql-as-type ((type (eql 'char))
-                                       val database db-type)
+(defmethod database-output-sql-as-type ((type (eql 'char)) val database db-type)

   (declare (ignore database db-type))
   (etypecase val
     (character (write-to-string val))
     (string val)))
 
   (declare (ignore database db-type))
   (etypecase val
     (character (write-to-string val))
     (string val)))
 

+(defmethod database-output-sql-as-type ((type (eql 'float)) val database db-type)
+  (declare (ignore database db-type))
+  (let ((*read-default-float-format* (type-of val)))
+    (format nil "~F" val)))
+

 (defmethod read-sql-value (val type database db-type)
   (declare (ignore type database db-type))
   (read-from-string val))
 (defmethod read-sql-value (val type database db-type)
   (declare (ignore type database db-type))
   (read-from-string val))

diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp
index 58de7289d77b8600b230e56b1275b1da6acca9f6..e1bb530c079b87d76930f44f4d0a59a7ca59af9a 100644 (file)
--- a/tests/test-oodml.lisp
+++ b/tests/test-oodml.lisp
@@ -515,6 +515,103 @@
                 (delete-records :from [employee] :where [= [emplid] 20])))
           "Bulgakov")
 
                 (delete-records :from [employee] :where [= [emplid] 20])))
           "Bulgakov")
 

+        (deftest :oodml/float/1 
+            (let* ((emp1 (car (select 'employee 
+                                      :where [= [slot-value 'employee 'emplid] 
+                                                1]
+                                      :flatp t 
+                                      :caching nil)))
+                   (height (slot-value emp1 'height)))
+              (prog1 
+                  (progn 
+                    (setf (slot-value emp1 'height) 1.0E0)
+                    (clsql:update-record-from-slot emp1 'height)
+                    (car (clsql:select [height] :from [employee] 
+                                       :where [= [emplid] 1] 
+                                       :flatp t 
+                                       :field-names nil)))
+                (setf (slot-value emp1 'height) height)
+                (clsql:update-record-from-slot emp1 'height)))
+          1.0d0)
+
+        (deftest :oodml/float/2
+            (let* ((emp1 (car (select 'employee 
+                                     :where [= [slot-value 'employee 'emplid] 
+                                               1]
+                                     :flatp t  
+                                     :caching nil)))
+                   (height (slot-value emp1 'height)))
+              (prog1 
+                  (progn 
+                    (setf (slot-value emp1 'height) 1.0S0)
+                    (clsql:update-record-from-slot emp1 'height)
+                    (car (clsql:select [height] :from [employee] 
+                                       :where [= [emplid] 1] 
+                                       :flatp t 
+                                       :field-names nil)))
+                (setf (slot-value emp1 'height) height)
+                (clsql:update-record-from-slot emp1 'height)))
+          1.0d0)
+
+        (deftest :oodml/float/3
+            (let* ((emp1 (car (select 'employee 
+                                     :where [= [slot-value 'employee 'emplid] 
+                                               1]
+                                     :flatp t 
+                                     :caching nil)))
+                   (height (slot-value emp1 'height)))
+              (prog1 
+                  (progn 
+                    (setf (slot-value emp1 'height) 1.0F0)
+                    (clsql:update-record-from-slot emp1 'height)
+                    (car (clsql:select [height] :from [employee] 
+                                       :where [= [emplid] 1] 
+                                       :flatp t 
+                                       :field-names nil)))
+                (setf (slot-value emp1 'height) height)
+                (clsql:update-record-from-slot emp1 'height)))
+          1.0d0)
+
+        (deftest :oodml/float/4
+            (let* ((emp1 (car (select 'employee 
+                                     :where [= [slot-value 'employee 'emplid] 
+                                               1]
+                                     :flatp t 
+                                     :caching nil)))
+                   (height (slot-value emp1 'height)))
+              (prog1 
+                  (progn 
+                    (setf (slot-value emp1 'height) 1.0D0)
+                    (clsql:update-record-from-slot emp1 'height)
+                    (car (clsql:select [height] :from [employee] 
+                                       :where [= [emplid] 1] 
+                                       :flatp t  
+                                       :field-names nil)))
+                (setf (slot-value emp1 'height) height)
+                (clsql:update-record-from-slot emp1 'height)))
+          1.0d0)
+
+        (deftest :oodml/float/5
+            (let* ((emp1 (car (select 'employee 
+                                      :where [= [slot-value 'employee 'emplid] 
+                                                1]
+                                      :flatp t 
+                                      :caching nil)))
+                   (height (slot-value emp1 'height)))
+              (prog1 
+                  (progn 
+                    (setf (slot-value emp1 'height) 1.0L0)
+                    (clsql:update-record-from-slot emp1 'height)
+                    (car (clsql:select [height] :from [employee] 
+                                       :where [= [emplid] 1] 
+                                       :flatp t 
+                                       :field-names nil)))
+                (setf (slot-value emp1 'height) height)
+                (clsql:update-record-from-slot emp1 'height)))
+          1.0d0)
+

        ))
 
        ))
 

+
+

 #.(clsql:restore-sql-reader-syntax-state)
 #.(clsql:restore-sql-reader-syntax-state)