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     (deftest :basic/i18n/1
 232         (first (query "SELECT 'Iñtërnâtiônàlizætiøn'"
 233                       :flatp t :field-names nil))
 234       "Iñtërnâtiônàlizætiøn")
 235
 236     (deftest :basic/i18n/2
 237         (first (query "SELECT 'Iñtërnâtiônàližætiøn'"
 238                       :flatp t :field-names nil))
 239       "Iñtërnâtiônàližætiøn")
 240     ))
 241
 242
 243 (def-dataset *ds-basic*
 244   (:setup (lambda ()
 245             (ignore-errors
 246               (clsql:execute-command "DROP TABLE TYPE_TABLE")
 247               (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
 248
 249             (clsql:execute-command
 250              "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_str VARCHAR(30))")
 251
 252             (dotimes (i 11)
 253               (let* ((test-int (- i 5))
 254                      (test-flt (transform-float-1 test-int)))
 255                 (clsql:execute-command
 256                  (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,'~a')"
 257                          test-int
 258                          (clsql-sys:number-to-sql-string test-flt)
 259                          (clsql-sys:number-to-sql-string test-flt)
 260                          ))))))
 261   (:cleanup "DROP TABLE TYPE_TABLE"))
 262
 263 (def-dataset *ds-bigint*
 264   (:setup (lambda ()
 265             (ignore-errors (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
 266             (clsql:execute-command "CREATE TABLE TYPE_BIGINT (T_INT integer, T_BIGINT BIGINT)")
 267             (dotimes (i 11)
 268               (clsql:execute-command
 269                (format nil "INSERT INTO TYPE_BIGINT VALUES (~a,~a)"
 270                        (- i 5)
 271                        (transform-bigint-1 (- i 5)))))))
 272   (:cleanup "DROP TABLE TYPE_BIGINT"))
 273
 274 ;;;; Testing functions
 275
 276 (defun transform-float-1 (i)
 277   (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
 278
 279 (defun transform-bigint-1 (i)
 280   (* i (expt 10 (* 3 (abs i)))))
 281
 282 (defun parse-double (num-str)
 283   (let ((*read-default-float-format* 'double-float))
 284     (coerce (read-from-string num-str) 'double-float)))
 285
 286 (defun double-float-equal (a b)
 287   (if (zerop a)
 288       (if (zerop b)
 289           t
 290           nil)
 291       (let ((diff (abs (/ (- a b) a))))
 292         (if (> diff (* 10 double-float-epsilon))
 293             nil
 294             t))))
 295
 296 (def-dataset *ds-bigtext*
 297   (:setup "CREATE TABLE testbigtext(a varchar(7500))")
 298   (:cleanup "DROP TABLE testbigtext"))