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