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 (member *test-database-type* '(:odbc :aodbc))
  49                               t
  50                             (integerp bigint))
  51                           (stringp str))
  52                     results))))
  53       ((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)))
  54
  55
  56      (deftest BASIC/TYPE/2
  57          (let ((results '()))
  58            (dolist (row (query "select * from TYPE_TABLE" :result-types :auto)
  59                      results)
  60              (destructuring-bind (int float bigint str) row
  61                (push (list (double-float-equal
  62                             (transform-float-1 int)
  63                             float)
  64                            (double-float-equal
  65                             (parse-double str)
  66                             float))
  67                      results))))
  68        ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
  69      )))
  70
  71 (defun test-basic-forms-untyped ()
  72   '((deftest BASIC/SELECT/1
  73         (let ((rows (query "select * from TYPE_TABLE" :result-types :auto)))
  74           (values
  75            (length rows)
  76            (length (car rows))))
  77       11 4)
  78
  79     (deftest BASIC/SELECT/2
  80         (let ((results '()))
  81           (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
  82                     results)
  83             (destructuring-bind (int float bigint str) row
  84               (push (list (stringp int)
  85                           (stringp float)
  86                           (stringp bigint)
  87                           (stringp str))
  88                     results))))
  89       ((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)))
  90
  91     (deftest BASIC/SELECT/3
  92         (let ((results '()))
  93           (dolist (row (query "select * from TYPE_TABLE" :result-types nil)
  94                     results)
  95             (destructuring-bind (int float bigint str) row
  96               (push (list (double-float-equal
  97                            (transform-float-1 (parse-integer int))
  98                            (parse-double float))
  99                           (double-float-equal
 100                            (parse-double str)
 101                            (parse-double float)))
 102                     results))))
 103       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 104
 105     (deftest BASIC/MAP/1
 106         (let ((results '())
 107               (rows (map-query 'vector #'list "select * from TYPE_TABLE"
 108                                :result-types nil)))
 109           (dotimes (i (length rows) results)
 110             (push
 111              (list
 112               (listp (aref rows i))
 113               (length (aref rows i))
 114               (eql (- i 5)
 115                    (parse-integer (first (aref rows i))
 116                                   :junk-allowed nil))
 117               (double-float-equal
 118                (transform-float-1 (parse-integer (first (aref rows i))))
 119                (parse-double (second (aref rows i)))))
 120              results)))
 121       ((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)))
 122
 123     (deftest BASIC/MAP/2
 124         (let ((results '())
 125               (rows (map-query 'list #'list "select * from TYPE_TABLE"
 126                                :result-types nil)))
 127           (dotimes (i (length rows) results)
 128             (push
 129              (list
 130               (listp (nth i rows))
 131               (length (nth i rows))
 132               (eql (- i 5)
 133                    (parse-integer (first (nth i rows))
 134                                   :junk-allowed nil))
 135               (double-float-equal
 136                (transform-float-1 (parse-integer (first (nth i rows))))
 137                (parse-double (second (nth i rows)))))
 138              results)))
 139       ((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)))
 140
 141     (deftest BASIC/DO/1
 142         (let ((results '()))
 143           (do-query ((int float bigint str) "select * from TYPE_TABLE")
 144             (push (list (double-float-equal
 145                          (transform-float-1 (parse-integer int))
 146                          (parse-double float))
 147                         (double-float-equal
 148                          (parse-double str)
 149                          (parse-double float)))
 150                   results))
 151           results)
 152       ((t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t) (t t)))
 153     ))
 154
 155
 156 ;;;; Testing functions
 157
 158 (defun transform-float-1 (i)
 159   (coerce (* i (abs (/ i 2)) (expt 10 (* 2 i))) 'double-float))
 160
 161 (defun transform-bigint-1 (i)
 162   (* i (expt 10 (* 3 (abs i)))))
 163
 164 (defun parse-double (num-str)
 165   (let ((*read-default-float-format* 'double-float))
 166     (coerce (read-from-string num-str) 'double-float)))
 167
 168 (defun double-float-equal (a b)
 169   (if (zerop a)
 170       (if (zerop b)
 171           t
 172           nil)
 173       (let ((diff (abs (/ (- a b) a))))
 174         (if (> diff (* 10 double-float-epsilon))
 175             nil
 176             t))))