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