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/DO/1
 145         (let ((results '()))
 146           (do-query ((int float bigint str) "select * from TYPE_TABLE")
 147             (push (list (double-float-equal
 148                          (transform-float-1 (parse-integer int))
 149                          (parse-double float))
 150                         (double-float-equal
 151                          (parse-double str)
 152                          (parse-double float)))
 153                   results))
 154           results)
 155       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 156     ))
 157
 158
 159 ;;;; Testing functions
 160
 161 (defun transform-float-1 (i)
 162   (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
 163
 164 (defun transform-bigint-1 (i)
 165   (* i (expt 10 (* 3 (abs i)))))
 166
 167 (defun parse-double (num-str)
 168   (let ((*read-default-float-format* 'double-float))
 169     (coerce (read-from-string num-str) 'double-float)))
 170
 171 (defun double-float-equal (a b)
 172   (if (zerop a)
 173       (if (zerop b)
 174           t
 175           nil)
 176       (let ((diff (abs (/ (- a b) a))))
 177         (if (> diff (* 10 double-float-epsilon))
 178             nil
 179             t))))