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
 206
 207 (def-dataset *ds-basic*
 208   (:setup (lambda ()
 209             (ignore-errors
 210               (clsql:execute-command "DROP TABLE TYPE_TABLE")
 211               (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
 212
 213             (clsql:execute-command
 214              "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_str VARCHAR(30))")
 215
 216             (dotimes (i 11)
 217               (let* ((test-int (- i 5))
 218                      (test-flt (transform-float-1 test-int)))
 219                 (clsql:execute-command
 220                  (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,'~a')"
 221                          test-int
 222                          (clsql-sys:number-to-sql-string test-flt)
 223                          (clsql-sys:number-to-sql-string test-flt)
 224                          ))))))
 225   (:cleanup "DROP TABLE TYPE_TABLE"))
 226
 227 (def-dataset *ds-bigint*
 228   (:setup (lambda ()
 229             (ignore-errors (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
 230             (clsql:execute-command "CREATE TABLE TYPE_BIGINT (T_INT integer, T_BIGINT BIGINT)")
 231             (dotimes (i 11)
 232               (clsql:execute-command
 233                (format nil "INSERT INTO TYPE_BIGINT VALUES (~a,~a)"
 234                        (- i 5)
 235                        (transform-bigint-1 (- i 5)))))))
 236   (:cleanup "DROP TABLE TYPE_BIGINT"))
 237
 238 ;;;; Testing functions
 239
 240 (defun transform-float-1 (i)
 241   (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
 242
 243 (defun transform-bigint-1 (i)
 244   (* i (expt 10 (* 3 (abs i)))))
 245
 246 (defun parse-double (num-str)
 247   (let ((*read-default-float-format* 'double-float))
 248     (coerce (read-from-string num-str) 'double-float)))
 249
 250 (defun double-float-equal (a b)
 251   (if (zerop a)
 252       (if (zerop b)
 253           t
 254           nil)
 255       (let ((diff (abs (/ (- a b) a))))
 256         (if (> diff (* 10 double-float-epsilon))
 257             nil
 258             t))))