r2787: *** empty log message ***

[clsql.git] / test-suite / tester-clsql.cl

diff --git a/test-suite/tester-clsql.cl b/test-suite/tester-clsql.cl
index 1e3fd7838364566d47cde65b1f1ff572e3cd1dd9..2cd2b029efa2057558a40048f0435f81e2dfe4de 100644 (file)
--- a/test-suite/tester-clsql.cl
+++ b/test-suite/tester-clsql.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: tester-clsql.cl,v 1.6 2002/04/23 18:28:02 kevin Exp $
+;;;; $Id: tester-clsql.cl,v 1.8 2002/06/12 17:47:13 kevin Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -119,8 +119,8 @@
        (dotimes (i 10)
          (clsql-mysql::database-execute-command
           (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')"
-                  i (number-to-sql-string (sqrt i))
-                  (number-to-sql-string (sqrt i)))
+                  i (clsql:number-to-sql-string (sqrt i))
+                  (clsql:number-to-sql-string (sqrt i)))
           db))
        (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil)))
          (test (mysql:mysql-num-rows
@@ -205,13 +205,23 @@
          :test #'eql
          :fail-info 
          (format nil "Wrong float value ~A for int ~A (row ~S)" float int row))
-    (test (parse-double str)
-         float
-         :test #'eql
-         :fail-info (format nil "Wrong string value ~A for double ~A (row ~S)"
-                            float str row))))
-
-
+    (test float
+         (parse-double str)
+         :test #'double-float-equal
+         :fail-info (format nil "Wrong string value ~A for double ~A~%Row: ~S"
+                            str float row))))
+
+
+(defun double-float-equal (a b)
+  (if (zerop a)
+      (if (zerop b)
+         t
+         nil)
+      (let ((diff (abs (/ (- a b) a))))
+       (if (> diff (* 10 double-float-epsilon))
+           nil
+           t))))
+        
 (defun drop-test-table (db)
   (clsql:execute-command "DROP TABLE test_clsql"))