r9336: 12 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
[clsql.git] / tests / test-basic.lisp
index 85874a4d4ed3015ed25b2b035117b5666d0de9cd..6a27fdd7de0d5f1f7883bfbf2d2044235dd184d0 100644 (file)
@@ -3,7 +3,7 @@
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; Name:    test-basic.lisp
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; Name:    test-basic.lisp
-;;;; Purpose: Tests for clsql-base and result types
+;;;; Purpose: Tests for clsql string-based queries and result types
 ;;;; Author:  Kevin M. Rosenberg
 ;;;; Created: Mar 2002
 ;;;;
 ;;;; Author:  Kevin M. Rosenberg
 ;;;; Created: Mar 2002
 ;;;;
       (clsql:execute-command
        (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,~a,'~a')"
               test-int
       (clsql:execute-command
        (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,~a,'~a')"
               test-int
-              (clsql-base:number-to-sql-string test-flt)
+              (clsql-sys:number-to-sql-string test-flt)
               (transform-bigint-1 test-int)
               (transform-bigint-1 test-int)
-              (clsql-base:number-to-sql-string test-flt)
+              (clsql-sys:number-to-sql-string test-flt)
               )))))
 
 (defun test-basic-forms ()
   (append
    (test-basic-forms-untyped)
    '(
               )))))
 
 (defun test-basic-forms ()
   (append
    (test-basic-forms-untyped)
    '(
-     (deftest BASIC/TYPE/1
+     (deftest :BASIC/TYPE/1
        (let ((results '()))
          (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
                    results)
        (let ((results '()))
          (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
                    results)
                          (typep float 'double-float)
                          (if (and (eq :odbc *test-database-type*)
                                   (eq :postgresql *test-database-underlying-type*))
                          (typep float 'double-float)
                          (if (and (eq :odbc *test-database-type*)
                                   (eq :postgresql *test-database-underlying-type*))
-                             ;; ODBC/Postgresql returns bigints as strings
-                             (stringp bigint)
+                             ;; ODBC/Postgresql may return returns bigints as strings or integer
+                             ;; depending upon the platform
+                             t
                            (integerp bigint))
                          (stringp str))
                    results))))
       ((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t)))
                            (integerp bigint))
                          (stringp str))
                    results))))
       ((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t)))
-    
 
 
-     (deftest BASIC/TYPE/2
+     (deftest :BASIC/TYPE/2
         (let ((results '()))
           (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
                     results)
             (destructuring-bind (int float bigint str) row
         (let ((results '()))
           (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
                     results)
             (destructuring-bind (int float bigint str) row
-              (push (list (double-float-equal 
-                           (transform-float-1 int)
-                           float)
-                          (double-float-equal
-                           (parse-double str)
-                           float))
-                    results))))
+              (setq results
+                    (cons (list (double-float-equal 
+                                 (transform-float-1 int)
+                                 float)
+                                (double-float-equal
+                                 (parse-double str)
+                                 float))
+                          results))))
+          results)
        ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
      )))
 
 (defun test-basic-forms-untyped ()
        ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
      )))
 
 (defun test-basic-forms-untyped ()
-  '((deftest BASIC/SELECT/1
+  '((deftest :BASIC/SELECT/1
        (let ((rows (query "select * from TYPE_TABLE" :result-types :auto)))
          (values 
           (length rows)
           (length (car rows))))
       11 4)
     
        (let ((rows (query "select * from TYPE_TABLE" :result-types :auto)))
          (values 
           (length rows)
           (length (car rows))))
       11 4)
     
-    (deftest BASIC/SELECT/2
+    (deftest :BASIC/SELECT/2
        (let ((results '()))
          (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
                    results)
        (let ((results '()))
          (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
                    results)
                    results))))
       ((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t)))
     
                    results))))
       ((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t)))
     
-    (deftest BASIC/SELECT/3
+    (deftest :BASIC/SELECT/3
        (let ((results '()))
          (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
                    results)
            (destructuring-bind (int float bigint str) row
        (let ((results '()))
          (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
                    results)
            (destructuring-bind (int float bigint str) row
+             (declare (ignore bigint))
              (push (list (double-float-equal 
                           (transform-float-1 (parse-integer int))
                           (parse-double float))
              (push (list (double-float-equal 
                           (transform-float-1 (parse-integer int))
                           (parse-double float))
                    results))))
       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 
                    results))))
       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 
-    (deftest BASIC/MAP/1
+    (deftest :BASIC/MAP/1
        (let ((results '())
              (rows (map-query 'vector #'list "select * from TYPE_TABLE" 
                               :result-types nil)))
        (let ((results '())
              (rows (map-query 'vector #'list "select * from TYPE_TABLE" 
                               :result-types nil)))
-         (declare (array rows))
+         (declare (type (simple-array list (*)) rows))
          (dotimes (i (length rows) results)
            (push
             (list
          (dotimes (i (length rows) results)
            (push
             (list
             results)))
       ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
     
             results)))
       ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
     
-    (deftest BASIC/MAP/2
+    (deftest :BASIC/MAP/2
        (let ((results '())
              (rows (map-query 'list #'list "select * from TYPE_TABLE" 
                               :result-types nil)))
        (let ((results '())
              (rows (map-query 'list #'list "select * from TYPE_TABLE" 
                               :result-types nil)))
               (parse-double (second (nth i rows)))))
             results)))
       ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
               (parse-double (second (nth i rows)))))
             results)))
       ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
+    
+    (deftest :BASIC/MAP/3
+           (let ((results '())
+             (rows (map-query 'list #'list "select * from TYPE_TABLE" 
+                              :result-types :auto)))
+             (dotimes (i (length rows) results)
+               (push
+                (list
+                 (listp (nth i rows))
+                 (length (nth i rows))
+                 (eql (- i 5)
+                      (first (nth i rows)))
+                 (double-float-equal
+                  (transform-float-1 (first (nth i rows)))
+                  (second (nth i rows))))
+                results)))
+      ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
+
+    (deftest :BASIC/DO/1
+       (let ((results '()))
+         (do-query ((int float bigint str) "select * from TYPE_TABLE" :result-types nil)
+           (declare (ignore bigint))
+           (let ((int-number (parse-integer int)))
+             (setq results
+                   (cons (list (double-float-equal (transform-float-1
+                                                    int-number)
+                                                   (parse-double float))
+                             (double-float-equal (parse-double str)
+                                                 (parse-double float)))
+                       results))))
+         results)
+      ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 
 
-    (deftest BASIC/DO/1
+    (deftest :BASIC/DO/2
        (let ((results '()))
        (let ((results '()))
-         (do-query ((int float bigint str) "select * from TYPE_TABLE")
-           (push (list (double-float-equal 
-                        (transform-float-1 (parse-integer int))
-                        (parse-double float))
-                       (double-float-equal
-                        (parse-double str)
-                        (parse-double float)))
-                 results))
+         (do-query ((int float bigint str) "select * from TYPE_TABLE" :result-types :auto)
+           (declare (ignore bigint))
+           (setq results
+                 (cons
+                  (list (double-float-equal 
+                         (transform-float-1 int)
+                         float)
+                        (double-float-equal
+                         (parse-double str)
+                         float))
+                  results)))
          results)
       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
     ))
          results)
       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
     ))