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-base and result types
   7 ;;;; Author:  Kevin M. Rosenberg
   8 ;;;; Created: Mar 2002
   9 ;;;;
  10 ;;;; $Id: tests.lisp 8926 2004-04-10 21:12:52Z kevin $
  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 (defun test-basic-initialize ()
  22   (ignore-errors
  23    (clsql:execute-command "DROP TABLE TYPE_TABLE"))
  24   (clsql:execute-command
  25    "CREATE TABLE TYPE_TABLE (t_int integer, t_float double precision, t_bigint BIGINT, t_str VARCHAR(30))")
  26   (dotimes (i 11)
  27     (let* ((test-int (- i 5))
  28            (test-flt (transform-float-1 test-int)))
  29       (clsql:execute-command
  30        (format nil "INSERT INTO TYPE_TABLE VALUES (~a,~a,~a,'~a')"
  31                test-int
  32                (clsql-base:number-to-sql-string test-flt)
  33                (transform-bigint-1 test-int)
  34                (clsql-base:number-to-sql-string test-flt)
  35                )))))
  36
  37 (defun test-basic-forms ()
  38   (append
  39    (test-basic-forms-untyped)
  40    '(
  41      (deftest :BASIC/TYPE/1
  42         (let ((results '()))
  43           (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
  44                     results)
  45             (destructuring-bind (int float bigint str) row
  46               (push (list (integerp int)
  47                           (typep float 'double-float)
  48                           (if (and (eq :odbc *test-database-type*)
  49                                    (eq :postgresql *test-database-underlying-type*))
  50                               ;; ODBC/Postgresql returns bigints as strings
  51                               (stringp bigint)
  52                             (integerp bigint))
  53                           (stringp str))
  54                     results))))
  55       ((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 t t t) (t t t t) (t t t t)))
  56
  57
  58      (deftest :BASIC/TYPE/2
  59          (let ((results '()))
  60            (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
  61                      results)
  62              (destructuring-bind (int float bigint str) row
  63                (push (list (double-float-equal
  64                             (transform-float-1 int)
  65                             float)
  66                            (double-float-equal
  67                             (parse-double str)
  68                             float))
  69                      results))))
  70        ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
  71      )))
  72
  73 (defun test-basic-forms-untyped ()
  74   '((deftest :BASIC/SELECT/1
  75         (let ((rows (query "select * from TYPE_TABLE" :result-types :auto)))
  76           (values
  77            (length rows)
  78            (length (car rows))))
  79       11 4)
  80
  81     (deftest :BASIC/SELECT/2
  82         (let ((results '()))
  83           (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
  84                     results)
  85             (destructuring-bind (int float bigint str) row
  86               (push (list (stringp int)
  87                           (stringp float)
  88                           (stringp bigint)
  89                           (stringp str))
  90                     results))))
  91       ((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 t t t) (t t t t) (t t t t)))
  92
  93     (deftest :BASIC/SELECT/3
  94         (let ((results '()))
  95           (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
  96                     results)
  97             (destructuring-bind (int float bigint str) row
  98               (push (list (double-float-equal
  99                            (transform-float-1 (parse-integer int))
 100                            (parse-double float))
 101                           (double-float-equal
 102                            (parse-double str)
 103                            (parse-double float)))
 104                     results))))
 105       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 106
 107     (deftest :BASIC/MAP/1
 108         (let ((results '())
 109               (rows (map-query 'vector #'list "select * from TYPE_TABLE"
 110                                :result-types nil)))
 111           (declare (array rows))
 112           (dotimes (i (length rows) results)
 113             (push
 114              (list
 115               (listp (aref rows i))
 116               (length (aref rows i))
 117               (eql (- i 5)
 118                    (parse-integer (first (aref rows i))
 119                                   :junk-allowed nil))
 120               (double-float-equal
 121                (transform-float-1 (parse-integer (first (aref rows i))))
 122                (parse-double (second (aref rows i)))))
 123              results)))
 124       ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
 125
 126     (deftest :BASIC/MAP/2
 127         (let ((results '())
 128               (rows (map-query 'list #'list "select * from TYPE_TABLE"
 129                                :result-types nil)))
 130           (dotimes (i (length rows) results)
 131             (push
 132              (list
 133               (listp (nth i rows))
 134               (length (nth i rows))
 135               (eql (- i 5)
 136                    (parse-integer (first (nth i rows))
 137                                   :junk-allowed nil))
 138               (double-float-equal
 139                (transform-float-1 (parse-integer (first (nth i rows))))
 140                (parse-double (second (nth i rows)))))
 141              results)))
 142       ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
 143
 144     (deftest :BASIC/MAP/3
 145             (let ((results '())
 146               (rows (map-query 'list #'list "select * from TYPE_TABLE"
 147                                :result-types :auto)))
 148               (dotimes (i (length rows) results)
 149                 (push
 150                  (list
 151                   (listp (nth i rows))
 152                   (length (nth i rows))
 153                   (eql (- i 5)
 154                        (first (nth i rows)))
 155                   (double-float-equal
 156                    (transform-float-1 (first (nth i rows)))
 157                    (second (nth i rows))))
 158                  results)))
 159       ((t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t) (t 4 t t)))
 160
 161     (deftest :BASIC/DO/1
 162         (let ((results '()))
 163           (do-query ((int float bigint str) "select * from TYPE_TABLE" :result-types nil)
 164             (push (list (double-float-equal
 165                          (transform-float-1 (parse-integer int))
 166                          (parse-double float))
 167                         (double-float-equal
 168                          (parse-double str)
 169                          (parse-double float)))
 170                   results))
 171           results)
 172       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 173
 174     (deftest :BASIC/DO/2
 175         (let ((results '()))
 176           (do-query ((int float bigint str) "select * from TYPE_TABLE" :result-types :auto)
 177             (push (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
 189 ;;;; Testing functions
 190
 191 (defun transform-float-1 (i)
 192   (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
 193
 194 (defun transform-bigint-1 (i)
 195   (* i (expt 10 (* 3 (abs i)))))
 196
 197 (defun parse-double (num-str)
 198   (let ((*read-default-float-format* 'double-float))
 199     (coerce (read-from-string num-str) 'double-float)))
 200
 201 (defun double-float-equal (a b)
 202   (if (zerop a)
 203       (if (zerop b)
 204           t
 205           nil)
 206       (let ((diff (abs (/ (- a b) a))))
 207         (if (> diff (* 10 double-float-epsilon))
 208             nil
 209             t))))