X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=test-suite%2Ftester-clsql.cl;h=ad121e4cba2596068f3388352c944decf3c34c2a;hp=bcc7f6d539f79c0e6fff4f7c9cf7664cb36aa5df;hb=998937376fa6f9ce29bd3c7954fb0ebca91c37d7;hpb=b47db1f5366da9da4bee4a62381e3a5bc8f3c52d

diff --git a/test-suite/tester-clsql.cl b/test-suite/tester-clsql.cl
index bcc7f6d..ad121e4 100644
--- 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.3 2002/04/08 03:50:00 kevin Exp $
+;;;; $Id: tester-clsql.cl,v 1.9 2002/09/30 01:57:32 kevin Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -16,6 +16,17 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
+;;; This test suite looks for a configuration file named "test.config"
+;;; This file contains a single a-list that specifies the connection
+;;; specs for each database type to be tested. For example, to test all
+;;; platforms, a sample "test.config" may look like:
+;;;
+;;; ((:mysql ("localhost" "a-mysql-db" "user1" "secret"))
+;;;  (:aodbc ("my-dsn" "a-user" "pass"))
+;;;  (:postgresql ("localhost" "another-db" "user2" "dont-tell"))
+;;;  (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password")))
+
+
 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
 (in-package :cl-user)
 
@@ -108,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
@@ -126,7 +137,7 @@
 ;;;; Testing functions
 
 (defun transform-float-1 (i)
-  (* i (abs (/ i 2)) (expt 10 (* 2 i))))
+  (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
 
 (defun transform-bigint-1 (i)
   (* i (expt 10 (* 3 (abs i)))))
@@ -191,28 +202,38 @@
 	      (format nil "Invalid types field (~S) passed to test-table-row" types))))
     (test (transform-float-1 int)
 	  float
-	  :test #'=
+	  :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" str))))
-
-
+    (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"))
-
-
+  (clsql:execute-command "DROP TABLE test_clsql" :database db))
 
 (defun do-test ()
     (let ((specs (read-specs)))
-      (mysql-low-level specs)
-      (mysql-table-test specs)
-      (pgsql-table-test specs)
-      (pgsql-socket-table-test specs)
-      (aodbc-table-test specs)
-      ))
+      (with-tests (:name "CLSQL")
+	(mysql-low-level specs)
+	(mysql-table-test specs)
+	(pgsql-table-test specs)
+	(pgsql-socket-table-test specs)
+	(aodbc-table-test specs)
+      )))
 
 
 (do-test)