X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Foodml.lisp;h=dc4f7bb3b2512246e96163a7aeb325e848e2b6e6;hp=624cadf059a1871fe4dc37c043a79aae6f75a71c;hb=f97c6c182c9746cd6adbdacf8cdfebbaadef3c37;hpb=d0695ffb828519fade3aa5166236812e6144975b

diff --git a/sql/oodml.lisp b/sql/oodml.lisp
index 624cadf..dc4f7bb 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))
@@ -847,15 +851,15 @@ maximum of MAX-LEN instances updated in each query."
   View Classes VIEW-CLASSES are passed as arguments to SELECT."
   (declare (ignore all set-operation group-by having offset limit inner-join on)
            (optimize (debug 3) (speed 1)))
-  (labels ((ref-equal (ref1 ref2)
-	     (equal (sql ref1)
-		    (sql ref2)))
-	   (table-sql-expr (table)
-	     (sql-expression :table (view-table table)))
-	   (tables-equal (table-a table-b)
-	     (when (and table-a table-b)
-	       (string= (string (slot-value table-a 'name))
-			(string (slot-value table-b 'name))))))
+  (flet ((ref-equal (ref1 ref2)
+           (string= (sql-output ref1 database)
+                    (sql-output ref2 database)))
+         (table-sql-expr (table)
+           (sql-expression :table (view-table table)))
+         (tables-equal (table-a table-b)
+           (when (and table-a table-b)
+             (string= (string (slot-value table-a 'name))
+                      (string (slot-value table-b 'name))))))
     (remf args :from)
     (remf args :where)
     (remf args :flatp)