From d9937e92697e07d701defd1fdcee7100d005fdf6 Mon Sep 17 00:00:00 2001 From: Marcus Pearce Date: Fri, 23 Jul 2004 15:43:34 +0000 Subject: [PATCH] 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. --- ChangeLog | 5 +++ sql/oodml.lisp | 8 +++- tests/test-oodml.lisp | 97 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 108 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 84cf705..a13448e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +23 Jul 2004 Marcus Pearce + * 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 * 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 624cadf..4562be8 100644 --- a/sql/oodml.lisp +++ b/sql/oodml.lisp @@ -473,13 +473,17 @@ (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))) +(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)) diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp index 58de728..e1bb530 100644 --- a/tests/test-oodml.lisp +++ b/tests/test-oodml.lisp @@ -515,6 +515,103 @@ (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) -- 2.34.1