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