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
 102     (deftest :basic/map/2
 103         (let ((results '())
 104               (rows (map-query 'list #'identity "select * from TYPE_TABLE"
 105                                :result-types nil)))
 106           (dotimes (i (length rows) results)
 107             (push
 108              (list
 109               (listp (nth i rows))
 110               (length (nth i rows))
 111               (eql (- i 5)
 112                    (parse-integer (first (nth i rows))
 113                                   :junk-allowed nil))
 114               (double-float-equal
 115                (transform-float-1 (parse-integer (first (nth i rows))))
 116                (parse-double (second (nth i rows)))))
 117              results)))
 118       ((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)))
 119
 120     (deftest :basic/map/3
 121             (let ((results '())
 122               (rows (map-query 'list #'identity "select * from TYPE_TABLE"
 123                                :result-types :auto)))
 124               (dotimes (i (length rows) results)
 125                 (push
 126                  (list
 127                   (listp (nth i rows))
 128                   (length (nth i rows))
 129                   (eql (- i 5)
 130                        (first (nth i rows)))
 131                   (double-float-equal
 132                    (transform-float-1 (first (nth i rows)))
 133                    (second (nth i rows))))
 134                  results)))
 135       ((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)))
 136
 137     ;; confirm that a query on a single element returns a list of one element
 138     (deftest :basic/map/4
 139         (let ((rows (map-query 'list #'identity "select t_int from TYPE_TABLE"
 140                                :result-types nil)))
 141           (values
 142            (consp (first rows))
 143            (length (first rows))))
 144       t 1)
 145
 146     (deftest :basic/do/1
 147         (let ((results '()))
 148           (do-query ((int float str) "select * from TYPE_TABLE" :result-types nil)
 149             (let ((int-number (parse-integer int)))
 150               (setq results
 151                     (cons (list (double-float-equal (transform-float-1
 152                                                      int-number)
 153                                                     (parse-double float))
 154                               (double-float-equal (parse-double str)
 155                                                   (parse-double float)))
 156                         results))))
 157           results)
 158       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 159
 160     (deftest :basic/do/2
 161         (let ((results '()))
 162           (do-query ((int float str) "select * from TYPE_TABLE" :result-types :auto)
 163             (setq results
 164                   (cons
 165                    (list (double-float-equal
 166                           (transform-float-1 int)
 167                           float)
 168                          (double-float-equal
 169                           (parse-double str)
 170                           float))
 171                    results)))
 172           results)
 173       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 174
 175
 176     (deftest :basic/bigint/1
 177         (let ((results '()))
 178           (dolist (row (query "select * from TYPE_BIGINT" :result-types :auto)
 179                    results)
 180             (destructuring-bind (int bigint) row
 181               (push (list (integerp int)
 182                           (if (and (eq :odbc *test-database-type*)
 183                                    (eq :postgresql *test-database-underlying-type*))
 184                               ;; ODBC/Postgresql may return returns bigints as strings or integer
 185                               ;; depending upon the platform
 186                               t
 187                             (integerp bigint)))
 188                     results))))
 189       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 190
 191     ))
 192
 193
 194 (defun test-basic-initialize ()
 195   (ignore-errors
 196    (clsql:execute-command "DROP TABLE TYPE_TABLE")
 197    (clsql:execute-command "DROP TABLE TYPE_BIGINT"))
 198
 199   (clsql:execute-command
 200    "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_str VARCHAR(30))")
 201
 202   (if (clsql-sys:db-type-has-bigint? *test-database-type*)
 203     (clsql:execute-command "CREATE TABLE TYPE_BIGINT (t_int integer, t_bigint BIGINT)")
 204     (clsql:execute-command "CREATE TABLE TYPE_BIGINT (t_int integer)"))
 205
 206   (dotimes (i 11)
 207     (let* ((test-int (- i 5))
 208            (test-flt (transform-float-1 test-int)))
 209       (clsql:execute-command
 210        (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,'~a')"
 211                test-int
 212                (clsql-sys:number-to-sql-string test-flt)
 213                (clsql-sys:number-to-sql-string test-flt)
 214                ))
 215       (when (clsql-sys:db-type-has-bigint? *test-database-type*)
 216         (clsql:execute-command
 217          (format nil "INSERT INTO TYPE_BIGINT VALUES (~a,~a)"
 218                  test-int
 219                  (transform-bigint-1 test-int)
 220                  ))))))
 221
 222 ;;;; Testing functions
 223
 224 (defun transform-float-1 (i)
 225   (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
 226
 227 (defun transform-bigint-1 (i)
 228   (* i (expt 10 (* 3 (abs i)))))
 229
 230 (defun parse-double (num-str)
 231   (let ((*read-default-float-format* 'double-float))
 232     (coerce (read-from-string num-str) 'double-float)))
 233
 234 (defun double-float-equal (a b)
 235   (if (zerop a)
 236       (if (zerop b)
 237           t
 238           nil)
 239       (let ((diff (abs (/ (- a b) a))))
 240         (if (> diff (* 10 double-float-epsilon))
 241             nil
 242             t))))