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: 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-sys:number-to-sql-string test-flt)
  33                (transform-bigint-1 test-int)
  34                (clsql-sys: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 may return returns bigints as strings or integer
  51                               ;; depending upon the platform
  52                               t
  53                             (integerp bigint))
  54                           (stringp str))
  55                     results))))
  56       ((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)))
  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                (setq results
  64                      (cons (list (double-float-equal
  65                                   (transform-float-1 int)
  66                                   float)
  67                                  (double-float-equal
  68                                   (parse-double str)
  69                                   float))
  70                            results))))
  71            results)
  72        ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
  73      )))
  74
  75 (defun test-basic-forms-untyped ()
  76   '((deftest :BASIC/SELECT/1
  77         (let ((rows (query "select * from TYPE_TABLE" :result-types :auto)))
  78           (values
  79            (length rows)
  80            (length (car rows))))
  81       11 4)
  82
  83     (deftest :BASIC/SELECT/2
  84         (let ((results '()))
  85           (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
  86                     results)
  87             (destructuring-bind (int float bigint str) row
  88               (push (list (stringp int)
  89                           (stringp float)
  90                           (stringp bigint)
  91                           (stringp str))
  92                     results))))
  93       ((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)))
  94
  95     (deftest :BASIC/SELECT/3
  96         (let ((results '()))
  97           (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
  98                     results)
  99             (destructuring-bind (int float bigint str) row
 100               (declare (ignore bigint))
 101               (push (list (double-float-equal
 102                            (transform-float-1 (parse-integer int))
 103                            (parse-double float))
 104                           (double-float-equal
 105                            (parse-double str)
 106                            (parse-double float)))
 107                     results))))
 108       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 109
 110     (deftest :BASIC/MAP/1
 111         (let ((results '())
 112               (rows (map-query 'vector #'list "select * from TYPE_TABLE"
 113                                :result-types nil)))
 114           (declare (type (simple-array list (*)) rows))
 115           (dotimes (i (length rows) results)
 116             (push
 117              (list
 118               (listp (aref rows i))
 119               (length (aref rows i))
 120               (eql (- i 5)
 121                    (parse-integer (first (aref rows i))
 122                                   :junk-allowed nil))
 123               (double-float-equal
 124                (transform-float-1 (parse-integer (first (aref rows i))))
 125                (parse-double (second (aref rows i)))))
 126              results)))
 127       ((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)))
 128
 129     (deftest :BASIC/MAP/2
 130         (let ((results '())
 131               (rows (map-query 'list #'list "select * from TYPE_TABLE"
 132                                :result-types nil)))
 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                    (parse-integer (first (nth i rows))
 140                                   :junk-allowed nil))
 141               (double-float-equal
 142                (transform-float-1 (parse-integer (first (nth i rows))))
 143                (parse-double (second (nth i rows)))))
 144              results)))
 145       ((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)))
 146
 147     (deftest :BASIC/MAP/3
 148             (let ((results '())
 149               (rows (map-query 'list #'list "select * from TYPE_TABLE"
 150                                :result-types :auto)))
 151               (dotimes (i (length rows) results)
 152                 (push
 153                  (list
 154                   (listp (nth i rows))
 155                   (length (nth i rows))
 156                   (eql (- i 5)
 157                        (first (nth i rows)))
 158                   (double-float-equal
 159                    (transform-float-1 (first (nth i rows)))
 160                    (second (nth i rows))))
 161                  results)))
 162       ((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)))
 163
 164     (deftest :BASIC/DO/1
 165         (let ((results '()))
 166           (do-query ((int float bigint str) "select * from TYPE_TABLE" :result-types nil)
 167             (declare (ignore bigint))
 168             (let ((int-number (parse-integer int)))
 169               (setq results
 170                     (cons (list (double-float-equal (transform-float-1
 171                                                      int-number)
 172                                                     (parse-double float))
 173                               (double-float-equal (parse-double str)
 174                                                   (parse-double float)))
 175                         results))))
 176           results)
 177       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 178
 179     (deftest :BASIC/DO/2
 180         (let ((results '()))
 181           (do-query ((int float bigint str) "select * from TYPE_TABLE" :result-types :auto)
 182             (declare (ignore bigint))
 183             (setq results
 184                   (cons
 185                    (list (double-float-equal
 186                           (transform-float-1 int)
 187                           float)
 188                          (double-float-equal
 189                           (parse-double str)
 190                           float))
 191                    results)))
 192           results)
 193       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 194     ))
 195
 196
 197 ;;;; Testing functions
 198
 199 (defun transform-float-1 (i)
 200   (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
 201
 202 (defun transform-bigint-1 (i)
 203   (* i (expt 10 (* 3 (abs i)))))
 204
 205 (defun parse-double (num-str)
 206   (let ((*read-default-float-format* 'double-float))
 207     (coerce (read-from-string num-str) 'double-float)))
 208
 209 (defun double-float-equal (a b)
 210   (if (zerop a)
 211       (if (zerop b)
 212           t
 213           nil)
 214       (let ((diff (abs (/ (- a b) a))))
 215         (if (> diff (* 10 double-float-epsilon))
 216             nil
 217             t))))