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 (setq *rt-basic*
  22   '(
  23     (deftest :basic/type/1
  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          (let ((results '()))
  36            (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
  37                      results)
  38              (destructuring-bind (int float str) row
  39                (setq results
  40                      (cons (list (double-float-equal
  41                                   (transform-float-1 int)
  42                                   float)
  43                                  (double-float-equal
  44                                   (parse-double str)
  45                                   float))
  46                            results))))
  47            results)
  48        ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
  49
  50   (deftest :basic/select/1
  51         (let ((rows (query "select * from TYPE_TABLE" :result-types :auto)))
  52           (values
  53            (length rows)
  54            (length (car rows))))
  55       11 3)
  56
  57     (deftest :BASIC/SELECT/2
  58         (let ((results '()))
  59           (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
  60                     results)
  61             (destructuring-bind (int float str) row
  62               (push (list (stringp int)
  63                           (stringp float)
  64                           (stringp str))
  65                     results))))
  66       ((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)))
  67
  68     (deftest :basic/select/3
  69         (let ((results '()))
  70           (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
  71                     results)
  72             (destructuring-bind (int float str) row
  73               (push (list (double-float-equal
  74                            (transform-float-1 (parse-integer int))
  75                            (parse-double float))
  76                           (double-float-equal
  77                            (parse-double str)
  78                            (parse-double float)))
  79                     results))))
  80       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
  81
  82     (deftest :basic/map/1
  83         (let ((results '())
  84               (rows (map-query 'vector #'identity "select * from TYPE_TABLE"
  85                                :result-types nil)))
  86           (declare (type (simple-array list (*)) rows))
  87           (dotimes (i (length rows) results)
  88             (push
  89              (list
  90               (listp (aref rows i))
  91               (length (aref rows i))
  92               (eql (- i 5)
  93                    (parse-integer (first (aref rows i))
  94                                   :junk-allowed nil))
  95               (double-float-equal
  96                (transform-float-1 (parse-integer (first (aref rows i))))
  97                (parse-double (second (aref rows i)))))
  98              results)))
  99       ((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)))
 100
 101     (deftest :basic/map/2
 102         (let ((results '())
 103               (rows (map-query 'list #'identity "select * from TYPE_TABLE"
 104                                :result-types nil)))
 105           (dotimes (i (length rows) results)
 106             (push
 107              (list
 108               (listp (nth i rows))
 109               (length (nth i rows))
 110               (eql (- i 5)
 111                    (parse-integer (first (nth i rows))
 112                                   :junk-allowed nil))
 113               (double-float-equal
 114                (transform-float-1 (parse-integer (first (nth i rows))))
 115                (parse-double (second (nth i rows)))))
 116              results)))
 117       ((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)))
 118
 119     (deftest :basic/map/3
 120             (let ((results '())
 121               (rows (map-query 'list #'identity "select * from TYPE_TABLE"
 122                                :result-types :auto)))
 123               (dotimes (i (length rows) results)
 124                 (push
 125                  (list
 126                   (listp (nth i rows))
 127                   (length (nth i rows))
 128                   (eql (- i 5)
 129                        (first (nth i rows)))
 130                   (double-float-equal
 131                    (transform-float-1 (first (nth i rows)))
 132                    (second (nth i rows))))
 133                  results)))
 134       ((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)))
 135
 136     (deftest :basic/do/1
 137         (let ((results '()))
 138           (do-query ((int float str) "select * from TYPE_TABLE" :result-types nil)
 139             (let ((int-number (parse-integer int)))
 140               (setq results
 141                     (cons (list (double-float-equal (transform-float-1
 142                                                      int-number)
 143                                                     (parse-double float))
 144                               (double-float-equal (parse-double str)
 145                                                   (parse-double float)))
 146                         results))))
 147           results)
 148       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 149
 150     (deftest :basic/do/2
 151         (let ((results '()))
 152           (do-query ((int float str) "select * from TYPE_TABLE" :result-types :auto)
 153             (setq results
 154                   (cons
 155                    (list (double-float-equal
 156                           (transform-float-1 int)
 157                           float)
 158                          (double-float-equal
 159                           (parse-double str)
 160                           float))
 161                    results)))
 162           results)
 163       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 164
 165
 166     (deftest :basic/bigint/1
 167         (let ((results '()))
 168           (dolist (row (query "select * from TYPE_BIGINT" :result-types :auto)
 169                    results)
 170             (destructuring-bind (int bigint) row
 171               (push (list (integerp int)
 172                           (if (and (eq :odbc *test-database-type*)
 173                                    (eq :postgresql *test-database-underlying-type*))
 174                               ;; ODBC/Postgresql may return returns bigints as strings or integer
 175                               ;; depending upon the platform
 176                               t
 177                             (integerp bigint)))
 178                     results))))
 179       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 180
 181     ))
 182
 183
 184 (defun test-basic-initialize ()
 185   (ignore-errors
 186    (clsql:execute-command "DROP TABLE TYPE_TABLE")
 187    (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
 188
 189   (clsql:execute-command
 190    "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_str VARCHAR(30))")
 191
 192   (if (clsql-sys:db-type-has-bigint? *test-database-type*)
 193     (clsql:execute-command "CREATE TABLE TYPE_BIGINT (t_int integer, t_bigint BIGINT)")
 194     (clsql:execute-command "CREATE TABLE TYPE_BIGINT (t_int integer)"))
 195
 196   (dotimes (i 11)
 197     (let* ((test-int (- i 5))
 198            (test-flt (transform-float-1 test-int)))
 199       (clsql:execute-command
 200        (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,'~a')"
 201                test-int
 202                (clsql-sys:number-to-sql-string test-flt)
 203                (clsql-sys:number-to-sql-string test-flt)
 204                ))
 205       (when (clsql-sys:db-type-has-bigint? *test-database-type*)
 206         (clsql:execute-command
 207          (format nil "INSERT INTO TYPE_BIGINT VALUES (~a,~a)"
 208                  test-int
 209                  (transform-bigint-1 test-int)
 210                  ))))))
 211
 212 ;;;; Testing functions
 213
 214 (defun transform-float-1 (i)
 215   (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
 216
 217 (defun transform-bigint-1 (i)
 218   (* i (expt 10 (* 3 (abs i)))))
 219
 220 (defun parse-double (num-str)
 221   (let ((*read-default-float-format* 'double-float))
 222     (coerce (read-from-string num-str) 'double-float)))
 223
 224 (defun double-float-equal (a b)
 225   (if (zerop a)
 226       (if (zerop b)
 227           t
 228           nil)
 229       (let ((diff (abs (/ (- a b) a))))
 230         (if (> diff (* 10 double-float-epsilon))
 231             nil
 232             t))))