tests/test-basic.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:    test-basic.lisp
   6 ;;;; Purpose: Tests for clsql string-based queries and result types
   7 ;;;; Author:  Kevin M. Rosenberg
   8 ;;;; Created: Mar 2002
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
  13 ;;;;
  14 ;;;; CLSQL users are granted the rights to distribute and use this software
  15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
  16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
  17 ;;;; *************************************************************************
  18
  19 (in-package #:clsql-tests)
  20
  21
  22 (setq *rt-basic*
  23   '(
  24     (deftest :basic/type/1
  25         (with-dataset *ds-basic*
  26           (let ((results '()))
  27             (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
  28                      results)
  29               (destructuring-bind (int float str) row
  30                 (push (list (integerp int)
  31                             (typep float 'double-float)
  32                             (stringp str))
  33                       results)))))
  34       ((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)))
  35
  36     (deftest :basic/type/2
  37         (with-dataset *ds-basic*
  38           (let ((results '()))
  39             (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
  40                      results)
  41               (destructuring-bind (int float str) row
  42                 (setq results
  43                       (cons (list (double-float-equal
  44                                    (transform-float-1 int)
  45                                    float)
  46                                   (double-float-equal
  47                                    (parse-double str)
  48                                    float))
  49                             results))))
  50             results))
  51       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
  52
  53     (deftest :basic/select/1
  54         (with-dataset *ds-basic*
  55           (let ((rows (query "select * from TYPE_TABLE" :result-types :auto)))
  56             (values
  57               (length rows)
  58               (length (car rows)))))
  59       11 3)
  60
  61     (deftest :BASIC/SELECT/2
  62         (with-dataset *ds-basic*
  63           (let ((results '()))
  64             (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
  65                      results)
  66               (destructuring-bind (int float str) row
  67                 (push (list (stringp int)
  68                             (stringp float)
  69                             (stringp str))
  70                       results)))))
  71       ((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)))
  72
  73     (deftest :basic/select/3
  74         (with-dataset *ds-basic*
  75           (let ((results '()))
  76             (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
  77                      results)
  78               (destructuring-bind (int float str) row
  79                 (push (list (double-float-equal
  80                              (transform-float-1 (parse-integer int))
  81                              (parse-double float))
  82                             (double-float-equal
  83                              (parse-double str)
  84                              (parse-double float)))
  85                       results)))))
  86       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
  87
  88     (deftest :basic/map/1
  89         (with-dataset *ds-basic*
  90           (let ((results '())
  91                 (rows (map-query 'vector #'identity "select * from TYPE_TABLE"
  92                                  :result-types nil)))
  93             (declare (type (simple-array list (*)) rows))
  94             (dotimes (i (length rows) results)
  95               (push
  96                (list
  97                 (listp (aref rows i))
  98                 (length (aref rows i))
  99                 (eql (- i 5)
 100                      (parse-integer (first (aref rows i))
 101                                     :junk-allowed nil))
 102                 (double-float-equal
 103                  (transform-float-1 (parse-integer (first (aref rows i))))
 104                  (parse-double (second (aref rows i)))))
 105                results))))
 106       ((t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t)))
 107
 108
 109     (deftest :basic/map/2
 110         (with-dataset *ds-basic*
 111           (let ((results '())
 112                 (rows (map-query 'list #'identity "select * from TYPE_TABLE"
 113                                  :result-types nil)))
 114             (dotimes (i (length rows) results)
 115               (push
 116                (list
 117                 (listp (nth i rows))
 118                 (length (nth i rows))
 119                 (eql (- i 5)
 120                      (parse-integer (first (nth i rows))
 121                                     :junk-allowed nil))
 122                 (double-float-equal
 123                  (transform-float-1 (parse-integer (first (nth i rows))))
 124                  (parse-double (second (nth i rows)))))
 125                results))))
 126       ((t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t)))
 127
 128     (deftest :basic/map/3
 129         (with-dataset *ds-basic*
 130           (let ((results '())
 131                 (rows (map-query 'list #'identity "select * from TYPE_TABLE"
 132                                  :result-types :auto)))
 133             (dotimes (i (length rows) results)
 134               (push
 135                (list
 136                 (listp (nth i rows))
 137                 (length (nth i rows))
 138                 (eql (- i 5)
 139                      (first (nth i rows)))
 140                 (double-float-equal
 141                  (transform-float-1 (first (nth i rows)))
 142                  (second (nth i rows))))
 143                results))))
 144       ((t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t) (t 3 t t)))
 145
 146     ;; confirm that a query on a single element returns a list of one element
 147     (deftest :basic/map/4
 148         (with-dataset *ds-basic*
 149           (let ((rows (map-query 'list #'identity "select t_int from TYPE_TABLE"
 150                                  :result-types nil)))
 151             (values
 152               (consp (first rows))
 153               (length (first rows)))))
 154       t 1)
 155
 156     (deftest :basic/do/1
 157         (with-dataset *ds-basic*
 158           (let ((results '()))
 159             (do-query ((int float str) "select * from TYPE_TABLE" :result-types nil)
 160               (let ((int-number (parse-integer int)))
 161                 (setq results
 162                       (cons (list (double-float-equal (transform-float-1
 163                                                        int-number)
 164                                                       (parse-double float))
 165                                   (double-float-equal (parse-double str)
 166                                                       (parse-double float)))
 167                             results))))
 168             results))
 169       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 170
 171     (deftest :basic/do/2
 172         (with-dataset *ds-basic*
 173           (let ((results '()))
 174             (do-query ((int float str) "select * from TYPE_TABLE" :result-types :auto)
 175               (setq results
 176                     (cons
 177                      (list (double-float-equal
 178                             (transform-float-1 int)
 179                             float)
 180                            (double-float-equal
 181                             (parse-double str)
 182                             float))
 183                      results)))
 184             results))
 185       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 186
 187
 188     (deftest :basic/bigint/1
 189         (with-dataset *ds-bigint*
 190           (let ((results '()))
 191             (dolist (row (query "select * from TYPE_BIGINT" :result-types :auto)
 192                      results)
 193               (destructuring-bind (int bigint) row
 194                 (push (list (integerp int)
 195                             (if (and (eq :odbc *test-database-type*)
 196                                      (eq :postgresql *test-database-underlying-type*))
 197                                 ;; ODBC/Postgresql may return returns bigints as strings or integer
 198                                 ;; depending upon the platform
 199                                 t
 200                                 (integerp bigint)))
 201                       results)))))
 202       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 203
 204
 205     (deftest :basic/bigtext/1
 206         (with-dataset *ds-bigtext*
 207           (let* ((len 7499)
 208                  (str (make-string len :initial-element #\a))
 209                  (cmd (format nil "INSERT INTO testbigtext (a) VALUES ('~a')" str)))
 210             (execute-command cmd)
 211             (let ((a (first (query "SELECT a from testbigtext"
 212                                    :flatp t :field-names nil))))
 213               (assert (string= str a) (str a)
 214                       "mismatch on a. inserted: ~a returned: ~a" len (length a)))
 215             ))
 216       nil)
 217     (deftest :basic/bigtext/2
 218         (dotimes (n 10)
 219           (with-dataset *ds-bigtext*
 220             (let* ((len (random 7500))
 221                    (str (make-string len :initial-element #\a))
 222                    (cmd (format nil "INSERT INTO testbigtext (a) VALUES ('~a')" str)))
 223               (execute-command cmd)
 224               (let ((a (first (query "SELECT a from testbigtext"
 225                                      :flatp t :field-names nil))))
 226                 (assert (string= str a) (str a)
 227                         "mismatch on a. inserted: ~a returned: ~a" len (length a)))
 228               )))
 229       nil)
 230     ))
 231
 232
 233 (def-dataset *ds-basic*
 234   (:setup (lambda ()
 235             (ignore-errors
 236               (clsql:execute-command "DROP TABLE TYPE_TABLE")
 237               (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
 238
 239             (clsql:execute-command
 240              "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_str VARCHAR(30))")
 241
 242             (dotimes (i 11)
 243               (let* ((test-int (- i 5))
 244                      (test-flt (transform-float-1 test-int)))
 245                 (clsql:execute-command
 246                  (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,'~a')"
 247                          test-int
 248                          (clsql-sys:number-to-sql-string test-flt)
 249                          (clsql-sys:number-to-sql-string test-flt)
 250                          ))))))
 251   (:cleanup "DROP TABLE TYPE_TABLE"))
 252
 253 (def-dataset *ds-bigint*
 254   (:setup (lambda ()
 255             (ignore-errors (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
 256             (clsql:execute-command "CREATE TABLE TYPE_BIGINT (T_INT integer, T_BIGINT BIGINT)")
 257             (dotimes (i 11)
 258               (clsql:execute-command
 259                (format nil "INSERT INTO TYPE_BIGINT VALUES (~a,~a)"
 260                        (- i 5)
 261                        (transform-bigint-1 (- i 5)))))))
 262   (:cleanup "DROP TABLE TYPE_BIGINT"))
 263
 264 ;;;; Testing functions
 265
 266 (defun transform-float-1 (i)
 267   (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
 268
 269 (defun transform-bigint-1 (i)
 270   (* i (expt 10 (* 3 (abs i)))))
 271
 272 (defun parse-double (num-str)
 273   (let ((*read-default-float-format* 'double-float))
 274     (coerce (read-from-string num-str) 'double-float)))
 275
 276 (defun double-float-equal (a b)
 277   (if (zerop a)
 278       (if (zerop b)
 279           t
 280           nil)
 281       (let ((diff (abs (/ (- a b) a))))
 282         (if (> diff (* 10 double-float-epsilon))
 283             nil
 284             t))))
 285
 286 (def-dataset *ds-bigtext*
 287   (:setup "CREATE TABLE testbigtext(a varchar(7500))")
 288   (:cleanup "DROP TABLE testbigtext"))